summaryrefslogtreecommitdiffstats
path: root/tk8.6/generic
diff options
context:
space:
mode:
authorWilliam Joye <wjoye@cfa.harvard.edu>2016-10-18 17:31:55 (GMT)
committerWilliam Joye <wjoye@cfa.harvard.edu>2016-10-18 17:31:55 (GMT)
commit39e34335fb6eb6eaf2b7ee51ccf172006dd46fbb (patch)
tree8e5374666c7f0b3017176ec9d6e6b6eae0dcabac /tk8.6/generic
parent066971b1e6e77991d9161bb0216a63ba94ea04f9 (diff)
parent6b095f3c8521ca7215e6ff5dcbada52b197ef7d0 (diff)
downloadblt-39e34335fb6eb6eaf2b7ee51ccf172006dd46fbb.zip
blt-39e34335fb6eb6eaf2b7ee51ccf172006dd46fbb.tar.gz
blt-39e34335fb6eb6eaf2b7ee51ccf172006dd46fbb.tar.bz2
Merge commit '6b095f3c8521ca7215e6ff5dcbada52b197ef7d0' as 'tk8.6'
Diffstat (limited to 'tk8.6/generic')
-rw-r--r--tk8.6/generic/README3
-rw-r--r--tk8.6/generic/default.h27
-rw-r--r--tk8.6/generic/ks_names.h922
-rw-r--r--tk8.6/generic/tk.decls1154
-rw-r--r--tk8.6/generic/tk.h1619
-rw-r--r--tk8.6/generic/tk3d.c1398
-rw-r--r--tk8.6/generic/tk3d.h85
-rw-r--r--tk8.6/generic/tkArgv.c417
-rw-r--r--tk8.6/generic/tkAtom.c215
-rw-r--r--tk8.6/generic/tkBind.c4298
-rw-r--r--tk8.6/generic/tkBitmap.c1205
-rw-r--r--tk8.6/generic/tkBusy.c932
-rw-r--r--tk8.6/generic/tkBusy.h41
-rw-r--r--tk8.6/generic/tkButton.c1878
-rw-r--r--tk8.6/generic/tkButton.h322
-rw-r--r--tk8.6/generic/tkCanvArc.c2119
-rw-r--r--tk8.6/generic/tkCanvBmap.c1010
-rw-r--r--tk8.6/generic/tkCanvImg.c883
-rw-r--r--tk8.6/generic/tkCanvLine.c2518
-rw-r--r--tk8.6/generic/tkCanvPoly.c1999
-rw-r--r--tk8.6/generic/tkCanvPs.c1782
-rw-r--r--tk8.6/generic/tkCanvText.c1660
-rw-r--r--tk8.6/generic/tkCanvUtil.c1869
-rw-r--r--tk8.6/generic/tkCanvWind.c1095
-rw-r--r--tk8.6/generic/tkCanvas.c5979
-rw-r--r--tk8.6/generic/tkCanvas.h312
-rw-r--r--tk8.6/generic/tkClipboard.c721
-rw-r--r--tk8.6/generic/tkCmds.c2163
-rw-r--r--tk8.6/generic/tkColor.c947
-rw-r--r--tk8.6/generic/tkColor.h75
-rw-r--r--tk8.6/generic/tkConfig.c2117
-rw-r--r--tk8.6/generic/tkConsole.c964
-rw-r--r--tk8.6/generic/tkCursor.c882
-rw-r--r--tk8.6/generic/tkDecls.h1733
-rw-r--r--tk8.6/generic/tkEntry.c4491
-rw-r--r--tk8.6/generic/tkEntry.h298
-rw-r--r--tk8.6/generic/tkError.c291
-rw-r--r--tk8.6/generic/tkEvent.c2147
-rw-r--r--tk8.6/generic/tkFileFilter.c473
-rw-r--r--tk8.6/generic/tkFileFilter.h78
-rw-r--r--tk8.6/generic/tkFocus.c1201
-rw-r--r--tk8.6/generic/tkFont.c4255
-rw-r--r--tk8.6/generic/tkFont.h224
-rw-r--r--tk8.6/generic/tkFrame.c2039
-rw-r--r--tk8.6/generic/tkGC.c404
-rw-r--r--tk8.6/generic/tkGeometry.c784
-rw-r--r--tk8.6/generic/tkGet.c752
-rw-r--r--tk8.6/generic/tkGrab.c1595
-rw-r--r--tk8.6/generic/tkGrid.c3666
-rw-r--r--tk8.6/generic/tkImage.c1142
-rw-r--r--tk8.6/generic/tkImgBmap.c1323
-rw-r--r--tk8.6/generic/tkImgGIF.c2239
-rw-r--r--tk8.6/generic/tkImgPNG.c3563
-rw-r--r--tk8.6/generic/tkImgPPM.c854
-rw-r--r--tk8.6/generic/tkImgPhInstance.c1987
-rw-r--r--tk8.6/generic/tkImgPhoto.c4073
-rw-r--r--tk8.6/generic/tkImgPhoto.h262
-rw-r--r--tk8.6/generic/tkImgUtil.c83
-rw-r--r--tk8.6/generic/tkInt.decls1774
-rw-r--r--tk8.6/generic/tkInt.h1264
-rw-r--r--tk8.6/generic/tkIntDecls.h1179
-rw-r--r--tk8.6/generic/tkIntPlatDecls.h669
-rw-r--r--tk8.6/generic/tkIntXlibDecls.h1279
-rw-r--r--tk8.6/generic/tkListbox.c3646
-rw-r--r--tk8.6/generic/tkMacWinMenu.c146
-rw-r--r--tk8.6/generic/tkMain.c549
-rw-r--r--tk8.6/generic/tkMenu.c3611
-rw-r--r--tk8.6/generic/tkMenu.h549
-rw-r--r--tk8.6/generic/tkMenuDraw.c1051
-rw-r--r--tk8.6/generic/tkMenubutton.c964
-rw-r--r--tk8.6/generic/tkMenubutton.h216
-rw-r--r--tk8.6/generic/tkMessage.c883
-rw-r--r--tk8.6/generic/tkObj.c1142
-rw-r--r--tk8.6/generic/tkOldConfig.c1184
-rw-r--r--tk8.6/generic/tkOldTest.c410
-rw-r--r--tk8.6/generic/tkOption.c1599
-rw-r--r--tk8.6/generic/tkPack.c1859
-rw-r--r--tk8.6/generic/tkPanedWindow.c3144
-rw-r--r--tk8.6/generic/tkPlace.c1245
-rw-r--r--tk8.6/generic/tkPlatDecls.h176
-rw-r--r--tk8.6/generic/tkPointer.c647
-rw-r--r--tk8.6/generic/tkPort.h31
-rw-r--r--tk8.6/generic/tkRectOval.c1436
-rw-r--r--tk8.6/generic/tkScale.c1434
-rw-r--r--tk8.6/generic/tkScale.h232
-rw-r--r--tk8.6/generic/tkScrollbar.c703
-rw-r--r--tk8.6/generic/tkScrollbar.h183
-rw-r--r--tk8.6/generic/tkSelect.c1602
-rw-r--r--tk8.6/generic/tkSelect.h167
-rw-r--r--tk8.6/generic/tkSquare.c623
-rw-r--r--tk8.6/generic/tkStubInit.c1110
-rw-r--r--tk8.6/generic/tkStubLib.c146
-rw-r--r--tk8.6/generic/tkStyle.c1554
-rw-r--r--tk8.6/generic/tkTest.c2076
-rw-r--r--tk8.6/generic/tkText.c6912
-rw-r--r--tk8.6/generic/tkText.h1171
-rw-r--r--tk8.6/generic/tkTextBTree.c4890
-rw-r--r--tk8.6/generic/tkTextDisp.c8990
-rw-r--r--tk8.6/generic/tkTextImage.c855
-rw-r--r--tk8.6/generic/tkTextIndex.c2402
-rw-r--r--tk8.6/generic/tkTextMark.c1027
-rw-r--r--tk8.6/generic/tkTextTag.c1802
-rw-r--r--tk8.6/generic/tkTextWind.c1409
-rw-r--r--tk8.6/generic/tkTrig.c1753
-rw-r--r--tk8.6/generic/tkUndo.c736
-rw-r--r--tk8.6/generic/tkUndo.h115
-rw-r--r--tk8.6/generic/tkUtil.c1201
-rw-r--r--tk8.6/generic/tkVisual.c549
-rw-r--r--tk8.6/generic/tkWindow.c3395
-rw-r--r--tk8.6/generic/ttk/ttk.decls150
-rw-r--r--tk8.6/generic/ttk/ttkBlink.c166
-rw-r--r--tk8.6/generic/ttk/ttkButton.c853
-rw-r--r--tk8.6/generic/ttk/ttkCache.c350
-rw-r--r--tk8.6/generic/ttk/ttkClamTheme.c971
-rw-r--r--tk8.6/generic/ttk/ttkClassicTheme.c513
-rw-r--r--tk8.6/generic/ttk/ttkDecls.h274
-rw-r--r--tk8.6/generic/ttk/ttkDefaultTheme.c1130
-rw-r--r--tk8.6/generic/ttk/ttkElements.c1281
-rw-r--r--tk8.6/generic/ttk/ttkEntry.c2058
-rw-r--r--tk8.6/generic/ttk/ttkFrame.c653
-rw-r--r--tk8.6/generic/ttk/ttkGenStubs.tcl963
-rw-r--r--tk8.6/generic/ttk/ttkImage.c422
-rw-r--r--tk8.6/generic/ttk/ttkInit.c283
-rw-r--r--tk8.6/generic/ttk/ttkLabel.c698
-rw-r--r--tk8.6/generic/ttk/ttkLayout.c1257
-rw-r--r--tk8.6/generic/ttk/ttkManager.c549
-rw-r--r--tk8.6/generic/ttk/ttkManager.h92
-rw-r--r--tk8.6/generic/ttk/ttkNotebook.c1412
-rw-r--r--tk8.6/generic/ttk/ttkPanedwindow.c976
-rw-r--r--tk8.6/generic/ttk/ttkProgress.c545
-rw-r--r--tk8.6/generic/ttk/ttkScale.c515
-rw-r--r--tk8.6/generic/ttk/ttkScroll.c258
-rw-r--r--tk8.6/generic/ttk/ttkScrollbar.c345
-rw-r--r--tk8.6/generic/ttk/ttkSeparator.c136
-rw-r--r--tk8.6/generic/ttk/ttkSquare.c301
-rw-r--r--tk8.6/generic/ttk/ttkState.c275
-rw-r--r--tk8.6/generic/ttk/ttkStubInit.c61
-rw-r--r--tk8.6/generic/ttk/ttkStubLib.c74
-rw-r--r--tk8.6/generic/ttk/ttkTagSet.c306
-rw-r--r--tk8.6/generic/ttk/ttkTheme.c1750
-rw-r--r--tk8.6/generic/ttk/ttkTheme.h444
-rw-r--r--tk8.6/generic/ttk/ttkThemeInt.h42
-rw-r--r--tk8.6/generic/ttk/ttkTrace.c190
-rw-r--r--tk8.6/generic/ttk/ttkTrack.c183
-rw-r--r--tk8.6/generic/ttk/ttkTreeview.c3448
-rw-r--r--tk8.6/generic/ttk/ttkWidget.c791
-rw-r--r--tk8.6/generic/ttk/ttkWidget.h273
147 files changed, 186246 insertions, 0 deletions
diff --git a/tk8.6/generic/README b/tk8.6/generic/README
new file mode 100644
index 0000000..6ac6bb4
--- /dev/null
+++ b/tk8.6/generic/README
@@ -0,0 +1,3 @@
+This directory contains Tk source files that work on all the platforms
+where Tk runs (e.g. UNIX, PCs, and MacOSX). Platform-specific
+sources are in the directories ../unix, ../win, and ../macosx.
diff --git a/tk8.6/generic/default.h b/tk8.6/generic/default.h
new file mode 100644
index 0000000..e6ef132
--- /dev/null
+++ b/tk8.6/generic/default.h
@@ -0,0 +1,27 @@
+/*
+ * default.h --
+ *
+ * This file defines the defaults for all options for all of
+ * the Tk widgets.
+ *
+ * Copyright (c) 1991-1994 The Regents of the University of California.
+ * Copyright (c) 1994 Sun Microsystems, Inc.
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ */
+
+#ifndef _DEFAULT
+#define _DEFAULT
+
+#ifdef _WIN32
+# include "tkWinDefault.h"
+#else
+# if defined(MAC_OSX_TK)
+# include "tkMacOSXDefault.h"
+# else
+# include "tkUnixDefault.h"
+# endif
+#endif
+
+#endif /* _DEFAULT */
diff --git a/tk8.6/generic/ks_names.h b/tk8.6/generic/ks_names.h
new file mode 100644
index 0000000..22d9fc5
--- /dev/null
+++ b/tk8.6/generic/ks_names.h
@@ -0,0 +1,922 @@
+/*
+ * This file is generated from $(INCLUDESRC)/keysymdef.h. Do not edit.
+ */
+{ "BackSpace", 0xFF08 },
+{ "Tab", 0xFF09 },
+{ "Linefeed", 0xFF0A },
+{ "Clear", 0xFF0B },
+{ "Return", 0xFF0D },
+{ "Pause", 0xFF13 },
+{ "Scroll_Lock", 0xFF14 },
+{ "Sys_Req", 0xFF15 },
+{ "Escape", 0xFF1B },
+{ "Delete", 0xFFFF },
+{ "Multi_key", 0xFF20 },
+{ "Kanji", 0xFF21 },
+{ "Home", 0xFF50 },
+{ "Left", 0xFF51 },
+{ "Up", 0xFF52 },
+{ "Right", 0xFF53 },
+{ "Down", 0xFF54 },
+{ "Prior", 0xFF55 },
+{ "Next", 0xFF56 },
+{ "End", 0xFF57 },
+{ "Begin", 0xFF58 },
+{ "Win_L", 0xFF5B },
+{ "Win_R", 0xFF5C },
+{ "App", 0xFF5D },
+{ "Select", 0xFF60 },
+{ "Print", 0xFF61 },
+{ "Execute", 0xFF62 },
+{ "Insert", 0xFF63 },
+{ "Undo", 0xFF65 },
+{ "Redo", 0xFF66 },
+{ "Menu", 0xFF67 },
+{ "Find", 0xFF68 },
+{ "Cancel", 0xFF69 },
+{ "Help", 0xFF6A },
+{ "Break", 0xFF6B },
+{ "Mode_switch", 0xFF7E },
+{ "script_switch", 0xFF7E },
+{ "Num_Lock", 0xFF7F },
+{ "KP_Space", 0xFF80 },
+{ "KP_Tab", 0xFF89 },
+{ "KP_Enter", 0xFF8D },
+{ "KP_F1", 0xFF91 },
+{ "KP_F2", 0xFF92 },
+{ "KP_F3", 0xFF93 },
+{ "KP_F4", 0xFF94 },
+{ "KP_Equal", 0xFFBD },
+{ "KP_Multiply", 0xFFAA },
+{ "KP_Add", 0xFFAB },
+{ "KP_Separator", 0xFFAC },
+{ "KP_Subtract", 0xFFAD },
+{ "KP_Decimal", 0xFFAE },
+{ "KP_Divide", 0xFFAF },
+{ "KP_0", 0xFFB0 },
+{ "KP_1", 0xFFB1 },
+{ "KP_2", 0xFFB2 },
+{ "KP_3", 0xFFB3 },
+{ "KP_4", 0xFFB4 },
+{ "KP_5", 0xFFB5 },
+{ "KP_6", 0xFFB6 },
+{ "KP_7", 0xFFB7 },
+{ "KP_8", 0xFFB8 },
+{ "KP_9", 0xFFB9 },
+{ "F1", 0xFFBE },
+{ "F2", 0xFFBF },
+{ "F3", 0xFFC0 },
+{ "F4", 0xFFC1 },
+{ "F5", 0xFFC2 },
+{ "F6", 0xFFC3 },
+{ "F7", 0xFFC4 },
+{ "F8", 0xFFC5 },
+{ "F9", 0xFFC6 },
+{ "F10", 0xFFC7 },
+{ "F11", 0xFFC8 },
+{ "L1", 0xFFC8 },
+{ "F12", 0xFFC9 },
+{ "L2", 0xFFC9 },
+{ "F13", 0xFFCA },
+{ "L3", 0xFFCA },
+{ "F14", 0xFFCB },
+{ "L4", 0xFFCB },
+{ "F15", 0xFFCC },
+{ "L5", 0xFFCC },
+{ "F16", 0xFFCD },
+{ "L6", 0xFFCD },
+{ "F17", 0xFFCE },
+{ "L7", 0xFFCE },
+{ "F18", 0xFFCF },
+{ "L8", 0xFFCF },
+{ "F19", 0xFFD0 },
+{ "L9", 0xFFD0 },
+{ "F20", 0xFFD1 },
+{ "L10", 0xFFD1 },
+{ "F21", 0xFFD2 },
+{ "R1", 0xFFD2 },
+{ "F22", 0xFFD3 },
+{ "R2", 0xFFD3 },
+{ "F23", 0xFFD4 },
+{ "R3", 0xFFD4 },
+{ "F24", 0xFFD5 },
+{ "R4", 0xFFD5 },
+{ "F25", 0xFFD6 },
+{ "R5", 0xFFD6 },
+{ "F26", 0xFFD7 },
+{ "R6", 0xFFD7 },
+{ "F27", 0xFFD8 },
+{ "R7", 0xFFD8 },
+{ "F28", 0xFFD9 },
+{ "R8", 0xFFD9 },
+{ "F29", 0xFFDA },
+{ "R9", 0xFFDA },
+{ "F30", 0xFFDB },
+{ "R10", 0xFFDB },
+{ "F31", 0xFFDC },
+{ "R11", 0xFFDC },
+{ "F32", 0xFFDD },
+{ "R12", 0xFFDD },
+{ "F33", 0xFFDE },
+{ "R13", 0xFFDE },
+{ "F34", 0xFFDF },
+{ "R14", 0xFFDF },
+{ "F35", 0xFFE0 },
+{ "R15", 0xFFE0 },
+{ "Shift_L", 0xFFE1 },
+{ "Shift_R", 0xFFE2 },
+{ "Control_L", 0xFFE3 },
+{ "Control_R", 0xFFE4 },
+{ "Caps_Lock", 0xFFE5 },
+{ "Shift_Lock", 0xFFE6 },
+{ "Meta_L", 0xFFE7 },
+{ "Meta_R", 0xFFE8 },
+{ "Alt_L", 0xFFE9 },
+{ "Alt_R", 0xFFEA },
+{ "Super_L", 0xFFEB },
+{ "Super_R", 0xFFEC },
+{ "Hyper_L", 0xFFED },
+{ "Hyper_R", 0xFFEE },
+{ "space", 0x020 },
+{ "exclam", 0x021 },
+{ "quotedbl", 0x022 },
+{ "numbersign", 0x023 },
+{ "dollar", 0x024 },
+{ "percent", 0x025 },
+{ "ampersand", 0x026 },
+{ "quoteright", 0x027 },
+{ "parenleft", 0x028 },
+{ "parenright", 0x029 },
+{ "asterisk", 0x02a },
+{ "plus", 0x02b },
+{ "comma", 0x02c },
+{ "minus", 0x02d },
+{ "period", 0x02e },
+{ "slash", 0x02f },
+{ "0", 0x030 },
+{ "1", 0x031 },
+{ "2", 0x032 },
+{ "3", 0x033 },
+{ "4", 0x034 },
+{ "5", 0x035 },
+{ "6", 0x036 },
+{ "7", 0x037 },
+{ "8", 0x038 },
+{ "9", 0x039 },
+{ "colon", 0x03a },
+{ "semicolon", 0x03b },
+{ "less", 0x03c },
+{ "equal", 0x03d },
+{ "greater", 0x03e },
+{ "question", 0x03f },
+{ "at", 0x040 },
+{ "A", 0x041 },
+{ "B", 0x042 },
+{ "C", 0x043 },
+{ "D", 0x044 },
+{ "E", 0x045 },
+{ "F", 0x046 },
+{ "G", 0x047 },
+{ "H", 0x048 },
+{ "I", 0x049 },
+{ "J", 0x04a },
+{ "K", 0x04b },
+{ "L", 0x04c },
+{ "M", 0x04d },
+{ "N", 0x04e },
+{ "O", 0x04f },
+{ "P", 0x050 },
+{ "Q", 0x051 },
+{ "R", 0x052 },
+{ "S", 0x053 },
+{ "T", 0x054 },
+{ "U", 0x055 },
+{ "V", 0x056 },
+{ "W", 0x057 },
+{ "X", 0x058 },
+{ "Y", 0x059 },
+{ "Z", 0x05a },
+{ "bracketleft", 0x05b },
+{ "backslash", 0x05c },
+{ "bracketright", 0x05d },
+{ "asciicircum", 0x05e },
+{ "underscore", 0x05f },
+{ "quoteleft", 0x060 },
+{ "a", 0x061 },
+{ "b", 0x062 },
+{ "c", 0x063 },
+{ "d", 0x064 },
+{ "e", 0x065 },
+{ "f", 0x066 },
+{ "g", 0x067 },
+{ "h", 0x068 },
+{ "i", 0x069 },
+{ "j", 0x06a },
+{ "k", 0x06b },
+{ "l", 0x06c },
+{ "m", 0x06d },
+{ "n", 0x06e },
+{ "o", 0x06f },
+{ "p", 0x070 },
+{ "q", 0x071 },
+{ "r", 0x072 },
+{ "s", 0x073 },
+{ "t", 0x074 },
+{ "u", 0x075 },
+{ "v", 0x076 },
+{ "w", 0x077 },
+{ "x", 0x078 },
+{ "y", 0x079 },
+{ "z", 0x07a },
+{ "braceleft", 0x07b },
+{ "bar", 0x07c },
+{ "braceright", 0x07d },
+{ "asciitilde", 0x07e },
+{ "nobreakspace", 0x0a0 },
+{ "exclamdown", 0x0a1 },
+{ "cent", 0x0a2 },
+{ "sterling", 0x0a3 },
+{ "currency", 0x0a4 },
+{ "yen", 0x0a5 },
+{ "brokenbar", 0x0a6 },
+{ "section", 0x0a7 },
+{ "diaeresis", 0x0a8 },
+{ "copyright", 0x0a9 },
+{ "ordfeminine", 0x0aa },
+{ "guillemotleft", 0x0ab },
+{ "notsign", 0x0ac },
+{ "hyphen", 0x0ad },
+{ "registered", 0x0ae },
+{ "macron", 0x0af },
+{ "degree", 0x0b0 },
+{ "plusminus", 0x0b1 },
+{ "twosuperior", 0x0b2 },
+{ "threesuperior", 0x0b3 },
+{ "acute", 0x0b4 },
+{ "mu", 0x0b5 },
+{ "paragraph", 0x0b6 },
+{ "periodcentered", 0x0b7 },
+{ "cedilla", 0x0b8 },
+{ "onesuperior", 0x0b9 },
+{ "masculine", 0x0ba },
+{ "guillemotright", 0x0bb },
+{ "onequarter", 0x0bc },
+{ "onehalf", 0x0bd },
+{ "threequarters", 0x0be },
+{ "questiondown", 0x0bf },
+{ "Agrave", 0x0c0 },
+{ "Aacute", 0x0c1 },
+{ "Acircumflex", 0x0c2 },
+{ "Atilde", 0x0c3 },
+{ "Adiaeresis", 0x0c4 },
+{ "Aring", 0x0c5 },
+{ "AE", 0x0c6 },
+{ "Ccedilla", 0x0c7 },
+{ "Egrave", 0x0c8 },
+{ "Eacute", 0x0c9 },
+{ "Ecircumflex", 0x0ca },
+{ "Ediaeresis", 0x0cb },
+{ "Igrave", 0x0cc },
+{ "Iacute", 0x0cd },
+{ "Icircumflex", 0x0ce },
+{ "Idiaeresis", 0x0cf },
+{ "Eth", 0x0d0 },
+{ "Ntilde", 0x0d1 },
+{ "Ograve", 0x0d2 },
+{ "Oacute", 0x0d3 },
+{ "Ocircumflex", 0x0d4 },
+{ "Otilde", 0x0d5 },
+{ "Odiaeresis", 0x0d6 },
+{ "multiply", 0x0d7 },
+{ "Ooblique", 0x0d8 },
+{ "Ugrave", 0x0d9 },
+{ "Uacute", 0x0da },
+{ "Ucircumflex", 0x0db },
+{ "Udiaeresis", 0x0dc },
+{ "Yacute", 0x0dd },
+{ "Thorn", 0x0de },
+{ "ssharp", 0x0df },
+{ "agrave", 0x0e0 },
+{ "aacute", 0x0e1 },
+{ "acircumflex", 0x0e2 },
+{ "atilde", 0x0e3 },
+{ "adiaeresis", 0x0e4 },
+{ "aring", 0x0e5 },
+{ "ae", 0x0e6 },
+{ "ccedilla", 0x0e7 },
+{ "egrave", 0x0e8 },
+{ "eacute", 0x0e9 },
+{ "ecircumflex", 0x0ea },
+{ "ediaeresis", 0x0eb },
+{ "igrave", 0x0ec },
+{ "iacute", 0x0ed },
+{ "icircumflex", 0x0ee },
+{ "idiaeresis", 0x0ef },
+{ "eth", 0x0f0 },
+{ "ntilde", 0x0f1 },
+{ "ograve", 0x0f2 },
+{ "oacute", 0x0f3 },
+{ "ocircumflex", 0x0f4 },
+{ "otilde", 0x0f5 },
+{ "odiaeresis", 0x0f6 },
+{ "division", 0x0f7 },
+{ "oslash", 0x0f8 },
+{ "ugrave", 0x0f9 },
+{ "uacute", 0x0fa },
+{ "ucircumflex", 0x0fb },
+{ "udiaeresis", 0x0fc },
+{ "yacute", 0x0fd },
+{ "thorn", 0x0fe },
+{ "ydiaeresis", 0x0ff },
+{ "Aogonek", 0x1a1 },
+{ "breve", 0x1a2 },
+{ "Lstroke", 0x1a3 },
+{ "Lcaron", 0x1a5 },
+{ "Sacute", 0x1a6 },
+{ "Scaron", 0x1a9 },
+{ "Scedilla", 0x1aa },
+{ "Tcaron", 0x1ab },
+{ "Zacute", 0x1ac },
+{ "Zcaron", 0x1ae },
+{ "Zabovedot", 0x1af },
+{ "aogonek", 0x1b1 },
+{ "ogonek", 0x1b2 },
+{ "lstroke", 0x1b3 },
+{ "lcaron", 0x1b5 },
+{ "sacute", 0x1b6 },
+{ "caron", 0x1b7 },
+{ "scaron", 0x1b9 },
+{ "scedilla", 0x1ba },
+{ "tcaron", 0x1bb },
+{ "zacute", 0x1bc },
+{ "doubleacute", 0x1bd },
+{ "zcaron", 0x1be },
+{ "zabovedot", 0x1bf },
+{ "Racute", 0x1c0 },
+{ "Abreve", 0x1c3 },
+{ "Cacute", 0x1c6 },
+{ "Ccaron", 0x1c8 },
+{ "Eogonek", 0x1ca },
+{ "Ecaron", 0x1cc },
+{ "Dcaron", 0x1cf },
+{ "Nacute", 0x1d1 },
+{ "Ncaron", 0x1d2 },
+{ "Odoubleacute", 0x1d5 },
+{ "Rcaron", 0x1d8 },
+{ "Uring", 0x1d9 },
+{ "Udoubleacute", 0x1db },
+{ "Tcedilla", 0x1de },
+{ "racute", 0x1e0 },
+{ "abreve", 0x1e3 },
+{ "cacute", 0x1e6 },
+{ "ccaron", 0x1e8 },
+{ "eogonek", 0x1ea },
+{ "ecaron", 0x1ec },
+{ "dcaron", 0x1ef },
+{ "nacute", 0x1f1 },
+{ "ncaron", 0x1f2 },
+{ "odoubleacute", 0x1f5 },
+{ "udoubleacute", 0x1fb },
+{ "rcaron", 0x1f8 },
+{ "uring", 0x1f9 },
+{ "tcedilla", 0x1fe },
+{ "abovedot", 0x1ff },
+{ "Hstroke", 0x2a1 },
+{ "Hcircumflex", 0x2a6 },
+{ "Iabovedot", 0x2a9 },
+{ "Gbreve", 0x2ab },
+{ "Jcircumflex", 0x2ac },
+{ "hstroke", 0x2b1 },
+{ "hcircumflex", 0x2b6 },
+{ "idotless", 0x2b9 },
+{ "gbreve", 0x2bb },
+{ "jcircumflex", 0x2bc },
+{ "Cabovedot", 0x2c5 },
+{ "Ccircumflex", 0x2c6 },
+{ "Gabovedot", 0x2d5 },
+{ "Gcircumflex", 0x2d8 },
+{ "Ubreve", 0x2dd },
+{ "Scircumflex", 0x2de },
+{ "cabovedot", 0x2e5 },
+{ "ccircumflex", 0x2e6 },
+{ "gabovedot", 0x2f5 },
+{ "gcircumflex", 0x2f8 },
+{ "ubreve", 0x2fd },
+{ "scircumflex", 0x2fe },
+{ "kappa", 0x3a2 },
+{ "Rcedilla", 0x3a3 },
+{ "Itilde", 0x3a5 },
+{ "Lcedilla", 0x3a6 },
+{ "Emacron", 0x3aa },
+{ "Gcedilla", 0x3ab },
+{ "Tslash", 0x3ac },
+{ "rcedilla", 0x3b3 },
+{ "itilde", 0x3b5 },
+{ "lcedilla", 0x3b6 },
+{ "emacron", 0x3ba },
+{ "gacute", 0x3bb },
+{ "tslash", 0x3bc },
+{ "ENG", 0x3bd },
+{ "eng", 0x3bf },
+{ "Amacron", 0x3c0 },
+{ "Iogonek", 0x3c7 },
+{ "Eabovedot", 0x3cc },
+{ "Imacron", 0x3cf },
+{ "Ncedilla", 0x3d1 },
+{ "Omacron", 0x3d2 },
+{ "Kcedilla", 0x3d3 },
+{ "Uogonek", 0x3d9 },
+{ "Utilde", 0x3dd },
+{ "Umacron", 0x3de },
+{ "amacron", 0x3e0 },
+{ "iogonek", 0x3e7 },
+{ "eabovedot", 0x3ec },
+{ "imacron", 0x3ef },
+{ "ncedilla", 0x3f1 },
+{ "omacron", 0x3f2 },
+{ "kcedilla", 0x3f3 },
+{ "uogonek", 0x3f9 },
+{ "utilde", 0x3fd },
+{ "umacron", 0x3fe },
+{ "overline", 0x47e },
+{ "kana_fullstop", 0x4a1 },
+{ "kana_openingbracket", 0x4a2 },
+{ "kana_closingbracket", 0x4a3 },
+{ "kana_comma", 0x4a4 },
+{ "kana_middledot", 0x4a5 },
+{ "kana_WO", 0x4a6 },
+{ "kana_a", 0x4a7 },
+{ "kana_i", 0x4a8 },
+{ "kana_u", 0x4a9 },
+{ "kana_e", 0x4aa },
+{ "kana_o", 0x4ab },
+{ "kana_ya", 0x4ac },
+{ "kana_yu", 0x4ad },
+{ "kana_yo", 0x4ae },
+{ "kana_tu", 0x4af },
+{ "prolongedsound", 0x4b0 },
+{ "kana_A", 0x4b1 },
+{ "kana_I", 0x4b2 },
+{ "kana_U", 0x4b3 },
+{ "kana_E", 0x4b4 },
+{ "kana_O", 0x4b5 },
+{ "kana_KA", 0x4b6 },
+{ "kana_KI", 0x4b7 },
+{ "kana_KU", 0x4b8 },
+{ "kana_KE", 0x4b9 },
+{ "kana_KO", 0x4ba },
+{ "kana_SA", 0x4bb },
+{ "kana_SHI", 0x4bc },
+{ "kana_SU", 0x4bd },
+{ "kana_SE", 0x4be },
+{ "kana_SO", 0x4bf },
+{ "kana_TA", 0x4c0 },
+{ "kana_TI", 0x4c1 },
+{ "kana_TU", 0x4c2 },
+{ "kana_TE", 0x4c3 },
+{ "kana_TO", 0x4c4 },
+{ "kana_NA", 0x4c5 },
+{ "kana_NI", 0x4c6 },
+{ "kana_NU", 0x4c7 },
+{ "kana_NE", 0x4c8 },
+{ "kana_NO", 0x4c9 },
+{ "kana_HA", 0x4ca },
+{ "kana_HI", 0x4cb },
+{ "kana_HU", 0x4cc },
+{ "kana_HE", 0x4cd },
+{ "kana_HO", 0x4ce },
+{ "kana_MA", 0x4cf },
+{ "kana_MI", 0x4d0 },
+{ "kana_MU", 0x4d1 },
+{ "kana_ME", 0x4d2 },
+{ "kana_MO", 0x4d3 },
+{ "kana_YA", 0x4d4 },
+{ "kana_YU", 0x4d5 },
+{ "kana_YO", 0x4d6 },
+{ "kana_RA", 0x4d7 },
+{ "kana_RI", 0x4d8 },
+{ "kana_RU", 0x4d9 },
+{ "kana_RE", 0x4da },
+{ "kana_RO", 0x4db },
+{ "kana_WA", 0x4dc },
+{ "kana_N", 0x4dd },
+{ "voicedsound", 0x4de },
+{ "semivoicedsound", 0x4df },
+{ "kana_switch", 0xFF7E },
+{ "Arabic_comma", 0x5ac },
+{ "Arabic_semicolon", 0x5bb },
+{ "Arabic_question_mark", 0x5bf },
+{ "Arabic_hamza", 0x5c1 },
+{ "Arabic_maddaonalef", 0x5c2 },
+{ "Arabic_hamzaonalef", 0x5c3 },
+{ "Arabic_hamzaonwaw", 0x5c4 },
+{ "Arabic_hamzaunderalef", 0x5c5 },
+{ "Arabic_hamzaonyeh", 0x5c6 },
+{ "Arabic_alef", 0x5c7 },
+{ "Arabic_beh", 0x5c8 },
+{ "Arabic_tehmarbuta", 0x5c9 },
+{ "Arabic_teh", 0x5ca },
+{ "Arabic_theh", 0x5cb },
+{ "Arabic_jeem", 0x5cc },
+{ "Arabic_hah", 0x5cd },
+{ "Arabic_khah", 0x5ce },
+{ "Arabic_dal", 0x5cf },
+{ "Arabic_thal", 0x5d0 },
+{ "Arabic_ra", 0x5d1 },
+{ "Arabic_zain", 0x5d2 },
+{ "Arabic_seen", 0x5d3 },
+{ "Arabic_sheen", 0x5d4 },
+{ "Arabic_sad", 0x5d5 },
+{ "Arabic_dad", 0x5d6 },
+{ "Arabic_tah", 0x5d7 },
+{ "Arabic_zah", 0x5d8 },
+{ "Arabic_ain", 0x5d9 },
+{ "Arabic_ghain", 0x5da },
+{ "Arabic_tatweel", 0x5e0 },
+{ "Arabic_feh", 0x5e1 },
+{ "Arabic_qaf", 0x5e2 },
+{ "Arabic_kaf", 0x5e3 },
+{ "Arabic_lam", 0x5e4 },
+{ "Arabic_meem", 0x5e5 },
+{ "Arabic_noon", 0x5e6 },
+{ "Arabic_heh", 0x5e7 },
+{ "Arabic_waw", 0x5e8 },
+{ "Arabic_alefmaksura", 0x5e9 },
+{ "Arabic_yeh", 0x5ea },
+{ "Arabic_fathatan", 0x5eb },
+{ "Arabic_dammatan", 0x5ec },
+{ "Arabic_kasratan", 0x5ed },
+{ "Arabic_fatha", 0x5ee },
+{ "Arabic_damma", 0x5ef },
+{ "Arabic_kasra", 0x5f0 },
+{ "Arabic_shadda", 0x5f1 },
+{ "Arabic_sukun", 0x5f2 },
+{ "Arabic_switch", 0xFF7E },
+{ "Serbian_dje", 0x6a1 },
+{ "Macedonia_gje", 0x6a2 },
+{ "Cyrillic_io", 0x6a3 },
+{ "Ukranian_je", 0x6a4 },
+{ "Macedonia_dse", 0x6a5 },
+{ "Ukranian_i", 0x6a6 },
+{ "Ukranian_yi", 0x6a7 },
+{ "Serbian_je", 0x6a8 },
+{ "Serbian_lje", 0x6a9 },
+{ "Serbian_nje", 0x6aa },
+{ "Serbian_tshe", 0x6ab },
+{ "Macedonia_kje", 0x6ac },
+{ "Byelorussian_shortu", 0x6ae },
+{ "Serbian_dze", 0x6af },
+{ "numerosign", 0x6b0 },
+{ "Serbian_DJE", 0x6b1 },
+{ "Macedonia_GJE", 0x6b2 },
+{ "Cyrillic_IO", 0x6b3 },
+{ "Ukranian_JE", 0x6b4 },
+{ "Macedonia_DSE", 0x6b5 },
+{ "Ukranian_I", 0x6b6 },
+{ "Ukranian_YI", 0x6b7 },
+{ "Serbian_JE", 0x6b8 },
+{ "Serbian_LJE", 0x6b9 },
+{ "Serbian_NJE", 0x6ba },
+{ "Serbian_TSHE", 0x6bb },
+{ "Macedonia_KJE", 0x6bc },
+{ "Byelorussian_SHORTU", 0x6be },
+{ "Serbian_DZE", 0x6bf },
+{ "Cyrillic_yu", 0x6c0 },
+{ "Cyrillic_a", 0x6c1 },
+{ "Cyrillic_be", 0x6c2 },
+{ "Cyrillic_tse", 0x6c3 },
+{ "Cyrillic_de", 0x6c4 },
+{ "Cyrillic_ie", 0x6c5 },
+{ "Cyrillic_ef", 0x6c6 },
+{ "Cyrillic_ghe", 0x6c7 },
+{ "Cyrillic_ha", 0x6c8 },
+{ "Cyrillic_i", 0x6c9 },
+{ "Cyrillic_shorti", 0x6ca },
+{ "Cyrillic_ka", 0x6cb },
+{ "Cyrillic_el", 0x6cc },
+{ "Cyrillic_em", 0x6cd },
+{ "Cyrillic_en", 0x6ce },
+{ "Cyrillic_o", 0x6cf },
+{ "Cyrillic_pe", 0x6d0 },
+{ "Cyrillic_ya", 0x6d1 },
+{ "Cyrillic_er", 0x6d2 },
+{ "Cyrillic_es", 0x6d3 },
+{ "Cyrillic_te", 0x6d4 },
+{ "Cyrillic_u", 0x6d5 },
+{ "Cyrillic_zhe", 0x6d6 },
+{ "Cyrillic_ve", 0x6d7 },
+{ "Cyrillic_softsign", 0x6d8 },
+{ "Cyrillic_yeru", 0x6d9 },
+{ "Cyrillic_ze", 0x6da },
+{ "Cyrillic_sha", 0x6db },
+{ "Cyrillic_e", 0x6dc },
+{ "Cyrillic_shcha", 0x6dd },
+{ "Cyrillic_che", 0x6de },
+{ "Cyrillic_hardsign", 0x6df },
+{ "Cyrillic_YU", 0x6e0 },
+{ "Cyrillic_A", 0x6e1 },
+{ "Cyrillic_BE", 0x6e2 },
+{ "Cyrillic_TSE", 0x6e3 },
+{ "Cyrillic_DE", 0x6e4 },
+{ "Cyrillic_IE", 0x6e5 },
+{ "Cyrillic_EF", 0x6e6 },
+{ "Cyrillic_GHE", 0x6e7 },
+{ "Cyrillic_HA", 0x6e8 },
+{ "Cyrillic_I", 0x6e9 },
+{ "Cyrillic_SHORTI", 0x6ea },
+{ "Cyrillic_KA", 0x6eb },
+{ "Cyrillic_EL", 0x6ec },
+{ "Cyrillic_EM", 0x6ed },
+{ "Cyrillic_EN", 0x6ee },
+{ "Cyrillic_O", 0x6ef },
+{ "Cyrillic_PE", 0x6f0 },
+{ "Cyrillic_YA", 0x6f1 },
+{ "Cyrillic_ER", 0x6f2 },
+{ "Cyrillic_ES", 0x6f3 },
+{ "Cyrillic_TE", 0x6f4 },
+{ "Cyrillic_U", 0x6f5 },
+{ "Cyrillic_ZHE", 0x6f6 },
+{ "Cyrillic_VE", 0x6f7 },
+{ "Cyrillic_SOFTSIGN", 0x6f8 },
+{ "Cyrillic_YERU", 0x6f9 },
+{ "Cyrillic_ZE", 0x6fa },
+{ "Cyrillic_SHA", 0x6fb },
+{ "Cyrillic_E", 0x6fc },
+{ "Cyrillic_SHCHA", 0x6fd },
+{ "Cyrillic_CHE", 0x6fe },
+{ "Cyrillic_HARDSIGN", 0x6ff },
+{ "Greek_ALPHAaccent", 0x7a1 },
+{ "Greek_EPSILONaccent", 0x7a2 },
+{ "Greek_ETAaccent", 0x7a3 },
+{ "Greek_IOTAaccent", 0x7a4 },
+{ "Greek_IOTAdiaeresis", 0x7a5 },
+{ "Greek_IOTAaccentdiaeresis", 0x7a6 },
+{ "Greek_OMICRONaccent", 0x7a7 },
+{ "Greek_UPSILONaccent", 0x7a8 },
+{ "Greek_UPSILONdieresis", 0x7a9 },
+{ "Greek_UPSILONaccentdieresis", 0x7aa },
+{ "Greek_OMEGAaccent", 0x7ab },
+{ "Greek_alphaaccent", 0x7b1 },
+{ "Greek_epsilonaccent", 0x7b2 },
+{ "Greek_etaaccent", 0x7b3 },
+{ "Greek_iotaaccent", 0x7b4 },
+{ "Greek_iotadieresis", 0x7b5 },
+{ "Greek_iotaaccentdieresis", 0x7b6 },
+{ "Greek_omicronaccent", 0x7b7 },
+{ "Greek_upsilonaccent", 0x7b8 },
+{ "Greek_upsilondieresis", 0x7b9 },
+{ "Greek_upsilonaccentdieresis", 0x7ba },
+{ "Greek_omegaaccent", 0x7bb },
+{ "Greek_ALPHA", 0x7c1 },
+{ "Greek_BETA", 0x7c2 },
+{ "Greek_GAMMA", 0x7c3 },
+{ "Greek_DELTA", 0x7c4 },
+{ "Greek_EPSILON", 0x7c5 },
+{ "Greek_ZETA", 0x7c6 },
+{ "Greek_ETA", 0x7c7 },
+{ "Greek_THETA", 0x7c8 },
+{ "Greek_IOTA", 0x7c9 },
+{ "Greek_KAPPA", 0x7ca },
+{ "Greek_LAMBDA", 0x7cb },
+{ "Greek_MU", 0x7cc },
+{ "Greek_NU", 0x7cd },
+{ "Greek_XI", 0x7ce },
+{ "Greek_OMICRON", 0x7cf },
+{ "Greek_PI", 0x7d0 },
+{ "Greek_RHO", 0x7d1 },
+{ "Greek_SIGMA", 0x7d2 },
+{ "Greek_TAU", 0x7d4 },
+{ "Greek_UPSILON", 0x7d5 },
+{ "Greek_PHI", 0x7d6 },
+{ "Greek_CHI", 0x7d7 },
+{ "Greek_PSI", 0x7d8 },
+{ "Greek_OMEGA", 0x7d9 },
+{ "Greek_alpha", 0x7e1 },
+{ "Greek_beta", 0x7e2 },
+{ "Greek_gamma", 0x7e3 },
+{ "Greek_delta", 0x7e4 },
+{ "Greek_epsilon", 0x7e5 },
+{ "Greek_zeta", 0x7e6 },
+{ "Greek_eta", 0x7e7 },
+{ "Greek_theta", 0x7e8 },
+{ "Greek_iota", 0x7e9 },
+{ "Greek_kappa", 0x7ea },
+{ "Greek_lambda", 0x7eb },
+{ "Greek_mu", 0x7ec },
+{ "Greek_nu", 0x7ed },
+{ "Greek_xi", 0x7ee },
+{ "Greek_omicron", 0x7ef },
+{ "Greek_pi", 0x7f0 },
+{ "Greek_rho", 0x7f1 },
+{ "Greek_sigma", 0x7f2 },
+{ "Greek_finalsmallsigma", 0x7f3 },
+{ "Greek_tau", 0x7f4 },
+{ "Greek_upsilon", 0x7f5 },
+{ "Greek_phi", 0x7f6 },
+{ "Greek_chi", 0x7f7 },
+{ "Greek_psi", 0x7f8 },
+{ "Greek_omega", 0x7f9 },
+{ "Greek_switch", 0xFF7E },
+{ "leftradical", 0x8a1 },
+{ "topleftradical", 0x8a2 },
+{ "horizconnector", 0x8a3 },
+{ "topintegral", 0x8a4 },
+{ "botintegral", 0x8a5 },
+{ "vertconnector", 0x8a6 },
+{ "topleftsqbracket", 0x8a7 },
+{ "botleftsqbracket", 0x8a8 },
+{ "toprightsqbracket", 0x8a9 },
+{ "botrightsqbracket", 0x8aa },
+{ "topleftparens", 0x8ab },
+{ "botleftparens", 0x8ac },
+{ "toprightparens", 0x8ad },
+{ "botrightparens", 0x8ae },
+{ "leftmiddlecurlybrace", 0x8af },
+{ "rightmiddlecurlybrace", 0x8b0 },
+{ "topleftsummation", 0x8b1 },
+{ "botleftsummation", 0x8b2 },
+{ "topvertsummationconnector", 0x8b3 },
+{ "botvertsummationconnector", 0x8b4 },
+{ "toprightsummation", 0x8b5 },
+{ "botrightsummation", 0x8b6 },
+{ "rightmiddlesummation", 0x8b7 },
+{ "lessthanequal", 0x8bc },
+{ "notequal", 0x8bd },
+{ "greaterthanequal", 0x8be },
+{ "integral", 0x8bf },
+{ "therefore", 0x8c0 },
+{ "variation", 0x8c1 },
+{ "infinity", 0x8c2 },
+{ "nabla", 0x8c5 },
+{ "approximate", 0x8c8 },
+{ "similarequal", 0x8c9 },
+{ "ifonlyif", 0x8cd },
+{ "implies", 0x8ce },
+{ "identical", 0x8cf },
+{ "radical", 0x8d6 },
+{ "includedin", 0x8da },
+{ "includes", 0x8db },
+{ "intersection", 0x8dc },
+{ "union", 0x8dd },
+{ "logicaland", 0x8de },
+{ "logicalor", 0x8df },
+{ "partialderivative", 0x8ef },
+{ "function", 0x8f6 },
+{ "leftarrow", 0x8fb },
+{ "uparrow", 0x8fc },
+{ "rightarrow", 0x8fd },
+{ "downarrow", 0x8fe },
+{ "blank", 0x9df },
+{ "soliddiamond", 0x9e0 },
+{ "checkerboard", 0x9e1 },
+{ "ht", 0x9e2 },
+{ "ff", 0x9e3 },
+{ "cr", 0x9e4 },
+{ "lf", 0x9e5 },
+{ "nl", 0x9e8 },
+{ "vt", 0x9e9 },
+{ "lowrightcorner", 0x9ea },
+{ "uprightcorner", 0x9eb },
+{ "upleftcorner", 0x9ec },
+{ "lowleftcorner", 0x9ed },
+{ "crossinglines", 0x9ee },
+{ "horizlinescan1", 0x9ef },
+{ "horizlinescan3", 0x9f0 },
+{ "horizlinescan5", 0x9f1 },
+{ "horizlinescan7", 0x9f2 },
+{ "horizlinescan9", 0x9f3 },
+{ "leftt", 0x9f4 },
+{ "rightt", 0x9f5 },
+{ "bott", 0x9f6 },
+{ "topt", 0x9f7 },
+{ "vertbar", 0x9f8 },
+{ "emspace", 0xaa1 },
+{ "enspace", 0xaa2 },
+{ "em3space", 0xaa3 },
+{ "em4space", 0xaa4 },
+{ "digitspace", 0xaa5 },
+{ "punctspace", 0xaa6 },
+{ "thinspace", 0xaa7 },
+{ "hairspace", 0xaa8 },
+{ "emdash", 0xaa9 },
+{ "endash", 0xaaa },
+{ "signifblank", 0xaac },
+{ "ellipsis", 0xaae },
+{ "doubbaselinedot", 0xaaf },
+{ "onethird", 0xab0 },
+{ "twothirds", 0xab1 },
+{ "onefifth", 0xab2 },
+{ "twofifths", 0xab3 },
+{ "threefifths", 0xab4 },
+{ "fourfifths", 0xab5 },
+{ "onesixth", 0xab6 },
+{ "fivesixths", 0xab7 },
+{ "careof", 0xab8 },
+{ "figdash", 0xabb },
+{ "leftanglebracket", 0xabc },
+{ "decimalpoint", 0xabd },
+{ "rightanglebracket", 0xabe },
+{ "marker", 0xabf },
+{ "oneeighth", 0xac3 },
+{ "threeeighths", 0xac4 },
+{ "fiveeighths", 0xac5 },
+{ "seveneighths", 0xac6 },
+{ "trademark", 0xac9 },
+{ "signaturemark", 0xaca },
+{ "trademarkincircle", 0xacb },
+{ "leftopentriangle", 0xacc },
+{ "rightopentriangle", 0xacd },
+{ "emopencircle", 0xace },
+{ "emopenrectangle", 0xacf },
+{ "leftsinglequotemark", 0xad0 },
+{ "rightsinglequotemark", 0xad1 },
+{ "leftdoublequotemark", 0xad2 },
+{ "rightdoublequotemark", 0xad3 },
+{ "prescription", 0xad4 },
+{ "minutes", 0xad6 },
+{ "seconds", 0xad7 },
+{ "latincross", 0xad9 },
+{ "hexagram", 0xada },
+{ "filledrectbullet", 0xadb },
+{ "filledlefttribullet", 0xadc },
+{ "filledrighttribullet", 0xadd },
+{ "emfilledcircle", 0xade },
+{ "emfilledrect", 0xadf },
+{ "enopencircbullet", 0xae0 },
+{ "enopensquarebullet", 0xae1 },
+{ "openrectbullet", 0xae2 },
+{ "opentribulletup", 0xae3 },
+{ "opentribulletdown", 0xae4 },
+{ "openstar", 0xae5 },
+{ "enfilledcircbullet", 0xae6 },
+{ "enfilledsqbullet", 0xae7 },
+{ "filledtribulletup", 0xae8 },
+{ "filledtribulletdown", 0xae9 },
+{ "leftpointer", 0xaea },
+{ "rightpointer", 0xaeb },
+{ "club", 0xaec },
+{ "diamond", 0xaed },
+{ "heart", 0xaee },
+{ "maltesecross", 0xaf0 },
+{ "dagger", 0xaf1 },
+{ "doubledagger", 0xaf2 },
+{ "checkmark", 0xaf3 },
+{ "ballotcross", 0xaf4 },
+{ "musicalsharp", 0xaf5 },
+{ "musicalflat", 0xaf6 },
+{ "malesymbol", 0xaf7 },
+{ "femalesymbol", 0xaf8 },
+{ "telephone", 0xaf9 },
+{ "telephonerecorder", 0xafa },
+{ "phonographcopyright", 0xafb },
+{ "caret", 0xafc },
+{ "singlelowquotemark", 0xafd },
+{ "doublelowquotemark", 0xafe },
+{ "cursor", 0xaff },
+{ "leftcaret", 0xba3 },
+{ "rightcaret", 0xba6 },
+{ "downcaret", 0xba8 },
+{ "upcaret", 0xba9 },
+{ "overbar", 0xbc0 },
+{ "downtack", 0xbc2 },
+{ "upshoe", 0xbc3 },
+{ "downstile", 0xbc4 },
+{ "underbar", 0xbc6 },
+{ "jot", 0xbca },
+{ "quad", 0xbcc },
+{ "uptack", 0xbce },
+{ "circle", 0xbcf },
+{ "upstile", 0xbd3 },
+{ "downshoe", 0xbd6 },
+{ "rightshoe", 0xbd8 },
+{ "leftshoe", 0xbda },
+{ "lefttack", 0xbdc },
+{ "righttack", 0xbfc },
+{ "hebrew_aleph", 0xce0 },
+{ "hebrew_beth", 0xce1 },
+{ "hebrew_gimmel", 0xce2 },
+{ "hebrew_daleth", 0xce3 },
+{ "hebrew_he", 0xce4 },
+{ "hebrew_waw", 0xce5 },
+{ "hebrew_zayin", 0xce6 },
+{ "hebrew_het", 0xce7 },
+{ "hebrew_teth", 0xce8 },
+{ "hebrew_yod", 0xce9 },
+{ "hebrew_finalkaph", 0xcea },
+{ "hebrew_kaph", 0xceb },
+{ "hebrew_lamed", 0xcec },
+{ "hebrew_finalmem", 0xced },
+{ "hebrew_mem", 0xcee },
+{ "hebrew_finalnun", 0xcef },
+{ "hebrew_nun", 0xcf0 },
+{ "hebrew_samekh", 0xcf1 },
+{ "hebrew_ayin", 0xcf2 },
+{ "hebrew_finalpe", 0xcf3 },
+{ "hebrew_pe", 0xcf4 },
+{ "hebrew_finalzadi", 0xcf5 },
+{ "hebrew_zadi", 0xcf6 },
+{ "hebrew_kuf", 0xcf7 },
+{ "hebrew_resh", 0xcf8 },
+{ "hebrew_shin", 0xcf9 },
+{ "hebrew_taf", 0xcfa },
+{ "Hebrew_switch", 0xFF7E },
diff --git a/tk8.6/generic/tk.decls b/tk8.6/generic/tk.decls
new file mode 100644
index 0000000..9ceb3af
--- /dev/null
+++ b/tk8.6/generic/tk.decls
@@ -0,0 +1,1154 @@
+# tk.decls --
+#
+# This file contains the declarations for all supported public
+# functions that are exported by the Tk library via the stubs table.
+# This file is used to generate the tkDecls.h, tkPlatDecls.h,
+# tkStub.c, and tkPlatStub.c files.
+#
+# Copyright (c) 1998-2000 Ajuba Solutions.
+# Copyright (c) 2007 Daniel A. Steffen <das@users.sourceforge.net>
+#
+# See the file "license.terms" for information on usage and redistribution
+# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+
+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}
+scspec EXTERN
+
+# 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 {
+ void Tk_MainLoop(void)
+}
+declare 1 {
+ XColor *Tk_3DBorderColor(Tk_3DBorder border)
+}
+declare 2 {
+ GC Tk_3DBorderGC(Tk_Window tkwin, Tk_3DBorder border,
+ int which)
+}
+declare 3 {
+ 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 {
+ 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 {
+ void Tk_AddOption(Tk_Window tkwin, const char *name,
+ const char *value, int priority)
+}
+declare 6 {
+ void Tk_BindEvent(Tk_BindingTable bindingTable,
+ XEvent *eventPtr, Tk_Window tkwin, int numObjects,
+ ClientData *objectPtr)
+}
+declare 7 {
+ void Tk_CanvasDrawableCoords(Tk_Canvas canvas,
+ double x, double y, short *drawableXPtr,
+ short *drawableYPtr)
+}
+declare 8 {
+ void Tk_CanvasEventuallyRedraw(Tk_Canvas canvas, int x1, int y1,
+ int x2, int y2)
+}
+declare 9 {
+ int Tk_CanvasGetCoord(Tcl_Interp *interp,
+ Tk_Canvas canvas, const char *str, double *doublePtr)
+}
+declare 10 {
+ Tk_CanvasTextInfo *Tk_CanvasGetTextInfo(Tk_Canvas canvas)
+}
+declare 11 {
+ int Tk_CanvasPsBitmap(Tcl_Interp *interp,
+ Tk_Canvas canvas, Pixmap bitmap, int x, int y,
+ int width, int height)
+}
+declare 12 {
+ int Tk_CanvasPsColor(Tcl_Interp *interp,
+ Tk_Canvas canvas, XColor *colorPtr)
+}
+declare 13 {
+ int Tk_CanvasPsFont(Tcl_Interp *interp,
+ Tk_Canvas canvas, Tk_Font font)
+}
+declare 14 {
+ void Tk_CanvasPsPath(Tcl_Interp *interp,
+ Tk_Canvas canvas, double *coordPtr, int numPoints)
+}
+declare 15 {
+ int Tk_CanvasPsStipple(Tcl_Interp *interp,
+ Tk_Canvas canvas, Pixmap bitmap)
+}
+declare 16 {
+ double Tk_CanvasPsY(Tk_Canvas canvas, double y)
+}
+declare 17 {
+ void Tk_CanvasSetStippleOrigin(Tk_Canvas canvas, GC gc)
+}
+declare 18 {
+ int Tk_CanvasTagsParseProc(ClientData clientData, Tcl_Interp *interp,
+ Tk_Window tkwin, const char *value, char *widgRec, int offset)
+}
+declare 19 {
+ CONST86 char *Tk_CanvasTagsPrintProc(ClientData clientData, Tk_Window tkwin,
+ char *widgRec, int offset, Tcl_FreeProc **freeProcPtr)
+}
+declare 20 {
+ Tk_Window Tk_CanvasTkwin(Tk_Canvas canvas)
+}
+declare 21 {
+ void Tk_CanvasWindowCoords(Tk_Canvas canvas, double x, double y,
+ short *screenXPtr, short *screenYPtr)
+}
+declare 22 {
+ void Tk_ChangeWindowAttributes(Tk_Window tkwin, unsigned long valueMask,
+ XSetWindowAttributes *attsPtr)
+}
+declare 23 {
+ int Tk_CharBbox(Tk_TextLayout layout, int index, int *xPtr,
+ int *yPtr, int *widthPtr, int *heightPtr)
+}
+declare 24 {
+ void Tk_ClearSelection(Tk_Window tkwin, Atom selection)
+}
+declare 25 {
+ int Tk_ClipboardAppend(Tcl_Interp *interp, Tk_Window tkwin,
+ Atom target, Atom format, const char *buffer)
+}
+declare 26 {
+ int Tk_ClipboardClear(Tcl_Interp *interp, Tk_Window tkwin)
+}
+declare 27 {
+ int Tk_ConfigureInfo(Tcl_Interp *interp,
+ Tk_Window tkwin, const Tk_ConfigSpec *specs,
+ char *widgRec, const char *argvName, int flags)
+}
+declare 28 {
+ int Tk_ConfigureValue(Tcl_Interp *interp,
+ Tk_Window tkwin, const Tk_ConfigSpec *specs,
+ char *widgRec, const char *argvName, int flags)
+}
+declare 29 {
+ int Tk_ConfigureWidget(Tcl_Interp *interp,
+ Tk_Window tkwin, const Tk_ConfigSpec *specs,
+ int argc, CONST84 char **argv, char *widgRec,
+ int flags)
+}
+declare 30 {
+ void Tk_ConfigureWindow(Tk_Window tkwin,
+ unsigned int valueMask, XWindowChanges *valuePtr)
+}
+declare 31 {
+ 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 {
+ Tk_Window Tk_CoordsToWindow(int rootX, int rootY, Tk_Window tkwin)
+}
+declare 33 {
+ unsigned long Tk_CreateBinding(Tcl_Interp *interp,
+ Tk_BindingTable bindingTable, ClientData object,
+ const char *eventStr, const char *script, int append)
+}
+declare 34 {
+ Tk_BindingTable Tk_CreateBindingTable(Tcl_Interp *interp)
+}
+declare 35 {
+ Tk_ErrorHandler Tk_CreateErrorHandler(Display *display,
+ int errNum, int request, int minorCode,
+ Tk_ErrorProc *errorProc, ClientData clientData)
+}
+declare 36 {
+ void Tk_CreateEventHandler(Tk_Window token,
+ unsigned long mask, Tk_EventProc *proc,
+ ClientData clientData)
+}
+declare 37 {
+ void Tk_CreateGenericHandler(Tk_GenericProc *proc, ClientData clientData)
+}
+declare 38 {
+ void Tk_CreateImageType(const Tk_ImageType *typePtr)
+}
+declare 39 {
+ void Tk_CreateItemType(Tk_ItemType *typePtr)
+}
+declare 40 {
+ void Tk_CreatePhotoImageFormat(const Tk_PhotoImageFormat *formatPtr)
+}
+declare 41 {
+ void Tk_CreateSelHandler(Tk_Window tkwin,
+ Atom selection, Atom target,
+ Tk_SelectionProc *proc, ClientData clientData,
+ Atom format)
+}
+declare 42 {
+ Tk_Window Tk_CreateWindow(Tcl_Interp *interp,
+ Tk_Window parent, const char *name, const char *screenName)
+}
+declare 43 {
+ Tk_Window Tk_CreateWindowFromPath(Tcl_Interp *interp, Tk_Window tkwin,
+ const char *pathName, const char *screenName)
+}
+declare 44 {
+ int Tk_DefineBitmap(Tcl_Interp *interp, const char *name,
+ const void *source, int width, int height)
+}
+declare 45 {
+ void Tk_DefineCursor(Tk_Window window, Tk_Cursor cursor)
+}
+declare 46 {
+ void Tk_DeleteAllBindings(Tk_BindingTable bindingTable, ClientData object)
+}
+declare 47 {
+ int Tk_DeleteBinding(Tcl_Interp *interp,
+ Tk_BindingTable bindingTable, ClientData object,
+ const char *eventStr)
+}
+declare 48 {
+ void Tk_DeleteBindingTable(Tk_BindingTable bindingTable)
+}
+declare 49 {
+ void Tk_DeleteErrorHandler(Tk_ErrorHandler handler)
+}
+declare 50 {
+ void Tk_DeleteEventHandler(Tk_Window token,
+ unsigned long mask, Tk_EventProc *proc,
+ ClientData clientData)
+}
+declare 51 {
+ void Tk_DeleteGenericHandler(Tk_GenericProc *proc, ClientData clientData)
+}
+declare 52 {
+ void Tk_DeleteImage(Tcl_Interp *interp, const char *name)
+}
+declare 53 {
+ void Tk_DeleteSelHandler(Tk_Window tkwin, Atom selection, Atom target)
+}
+declare 54 {
+ void Tk_DestroyWindow(Tk_Window tkwin)
+}
+declare 55 {
+ CONST84_RETURN char *Tk_DisplayName(Tk_Window tkwin)
+}
+declare 56 {
+ int Tk_DistanceToTextLayout(Tk_TextLayout layout, int x, int y)
+}
+declare 57 {
+ void Tk_Draw3DPolygon(Tk_Window tkwin,
+ Drawable drawable, Tk_3DBorder border,
+ XPoint *pointPtr, int numPoints, int borderWidth,
+ int leftRelief)
+}
+declare 58 {
+ 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 {
+ void Tk_DrawChars(Display *display, Drawable drawable, GC gc,
+ Tk_Font tkfont, const char *source, int numBytes, int x, int y)
+}
+declare 60 {
+ void Tk_DrawFocusHighlight(Tk_Window tkwin, GC gc, int width,
+ Drawable drawable)
+}
+declare 61 {
+ void Tk_DrawTextLayout(Display *display,
+ Drawable drawable, GC gc, Tk_TextLayout layout,
+ int x, int y, int firstChar, int lastChar)
+}
+declare 62 {
+ void Tk_Fill3DPolygon(Tk_Window tkwin,
+ Drawable drawable, Tk_3DBorder border,
+ XPoint *pointPtr, int numPoints, int borderWidth,
+ int leftRelief)
+}
+declare 63 {
+ 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 {
+ Tk_PhotoHandle Tk_FindPhoto(Tcl_Interp *interp, const char *imageName)
+}
+declare 65 {
+ Font Tk_FontId(Tk_Font font)
+}
+declare 66 {
+ void Tk_Free3DBorder(Tk_3DBorder border)
+}
+declare 67 {
+ void Tk_FreeBitmap(Display *display, Pixmap bitmap)
+}
+declare 68 {
+ void Tk_FreeColor(XColor *colorPtr)
+}
+declare 69 {
+ void Tk_FreeColormap(Display *display, Colormap colormap)
+}
+declare 70 {
+ void Tk_FreeCursor(Display *display, Tk_Cursor cursor)
+}
+declare 71 {
+ void Tk_FreeFont(Tk_Font f)
+}
+declare 72 {
+ void Tk_FreeGC(Display *display, GC gc)
+}
+declare 73 {
+ void Tk_FreeImage(Tk_Image image)
+}
+declare 74 {
+ void Tk_FreeOptions(const Tk_ConfigSpec *specs,
+ char *widgRec, Display *display, int needFlags)
+}
+declare 75 {
+ void Tk_FreePixmap(Display *display, Pixmap pixmap)
+}
+declare 76 {
+ void Tk_FreeTextLayout(Tk_TextLayout textLayout)
+}
+declare 77 {
+ void Tk_FreeXId(Display *display, XID xid)
+}
+declare 78 {
+ GC Tk_GCForColor(XColor *colorPtr, Drawable drawable)
+}
+declare 79 {
+ void Tk_GeometryRequest(Tk_Window tkwin, int reqWidth, int reqHeight)
+}
+declare 80 {
+ Tk_3DBorder Tk_Get3DBorder(Tcl_Interp *interp, Tk_Window tkwin,
+ Tk_Uid colorName)
+}
+declare 81 {
+ void Tk_GetAllBindings(Tcl_Interp *interp,
+ Tk_BindingTable bindingTable, ClientData object)
+}
+declare 82 {
+ int Tk_GetAnchor(Tcl_Interp *interp,
+ const char *str, Tk_Anchor *anchorPtr)
+}
+declare 83 {
+ CONST84_RETURN char *Tk_GetAtomName(Tk_Window tkwin, Atom atom)
+}
+declare 84 {
+ CONST84_RETURN char *Tk_GetBinding(Tcl_Interp *interp,
+ Tk_BindingTable bindingTable, ClientData object,
+ const char *eventStr)
+}
+declare 85 {
+ Pixmap Tk_GetBitmap(Tcl_Interp *interp, Tk_Window tkwin, const char *str)
+}
+declare 86 {
+ Pixmap Tk_GetBitmapFromData(Tcl_Interp *interp,
+ Tk_Window tkwin, const void *source, int width, int height)
+}
+declare 87 {
+ int Tk_GetCapStyle(Tcl_Interp *interp, const char *str, int *capPtr)
+}
+declare 88 {
+ XColor *Tk_GetColor(Tcl_Interp *interp, Tk_Window tkwin, Tk_Uid name)
+}
+declare 89 {
+ XColor *Tk_GetColorByValue(Tk_Window tkwin, XColor *colorPtr)
+}
+declare 90 {
+ Colormap Tk_GetColormap(Tcl_Interp *interp, Tk_Window tkwin,
+ const char *str)
+}
+declare 91 {
+ Tk_Cursor Tk_GetCursor(Tcl_Interp *interp, Tk_Window tkwin,
+ Tk_Uid str)
+}
+declare 92 {
+ Tk_Cursor Tk_GetCursorFromData(Tcl_Interp *interp,
+ Tk_Window tkwin, const char *source, const char *mask,
+ int width, int height, int xHot, int yHot,
+ Tk_Uid fg, Tk_Uid bg)
+}
+declare 93 {
+ Tk_Font Tk_GetFont(Tcl_Interp *interp,
+ Tk_Window tkwin, const char *str)
+}
+declare 94 {
+ Tk_Font Tk_GetFontFromObj(Tk_Window tkwin, Tcl_Obj *objPtr)
+}
+declare 95 {
+ void Tk_GetFontMetrics(Tk_Font font, Tk_FontMetrics *fmPtr)
+}
+declare 96 {
+ GC Tk_GetGC(Tk_Window tkwin, unsigned long valueMask, XGCValues *valuePtr)
+}
+declare 97 {
+ Tk_Image Tk_GetImage(Tcl_Interp *interp, Tk_Window tkwin, const char *name,
+ Tk_ImageChangedProc *changeProc, ClientData clientData)
+}
+declare 98 {
+ ClientData Tk_GetImageMasterData(Tcl_Interp *interp,
+ const char *name, CONST86 Tk_ImageType **typePtrPtr)
+}
+declare 99 {
+ Tk_ItemType *Tk_GetItemTypes(void)
+}
+declare 100 {
+ int Tk_GetJoinStyle(Tcl_Interp *interp, const char *str, int *joinPtr)
+}
+declare 101 {
+ int Tk_GetJustify(Tcl_Interp *interp,
+ const char *str, Tk_Justify *justifyPtr)
+}
+declare 102 {
+ int Tk_GetNumMainWindows(void)
+}
+declare 103 {
+ Tk_Uid Tk_GetOption(Tk_Window tkwin, const char *name,
+ const char *className)
+}
+declare 104 {
+ int Tk_GetPixels(Tcl_Interp *interp,
+ Tk_Window tkwin, const char *str, int *intPtr)
+}
+declare 105 {
+ Pixmap Tk_GetPixmap(Display *display, Drawable d,
+ int width, int height, int depth)
+}
+declare 106 {
+ int Tk_GetRelief(Tcl_Interp *interp, const char *name, int *reliefPtr)
+}
+declare 107 {
+ void Tk_GetRootCoords(Tk_Window tkwin, int *xPtr, int *yPtr)
+}
+declare 108 {
+ int Tk_GetScrollInfo(Tcl_Interp *interp,
+ int argc, CONST84 char **argv, double *dblPtr, int *intPtr)
+}
+declare 109 {
+ int Tk_GetScreenMM(Tcl_Interp *interp,
+ Tk_Window tkwin, const char *str, double *doublePtr)
+}
+declare 110 {
+ int Tk_GetSelection(Tcl_Interp *interp,
+ Tk_Window tkwin, Atom selection, Atom target,
+ Tk_GetSelProc *proc, ClientData clientData)
+}
+declare 111 {
+ Tk_Uid Tk_GetUid(const char *str)
+}
+declare 112 {
+ Visual *Tk_GetVisual(Tcl_Interp *interp,
+ Tk_Window tkwin, const char *str, int *depthPtr,
+ Colormap *colormapPtr)
+}
+declare 113 {
+ void Tk_GetVRootGeometry(Tk_Window tkwin,
+ int *xPtr, int *yPtr, int *widthPtr, int *heightPtr)
+}
+declare 114 {
+ int Tk_Grab(Tcl_Interp *interp, Tk_Window tkwin, int grabGlobal)
+}
+declare 115 {
+ void Tk_HandleEvent(XEvent *eventPtr)
+}
+declare 116 {
+ Tk_Window Tk_IdToWindow(Display *display, Window window)
+}
+declare 117 {
+ void Tk_ImageChanged(Tk_ImageMaster master, int x, int y,
+ int width, int height, int imageWidth, int imageHeight)
+}
+declare 118 {
+ int Tk_Init(Tcl_Interp *interp)
+}
+declare 119 {
+ Atom Tk_InternAtom(Tk_Window tkwin, const char *name)
+}
+declare 120 {
+ int Tk_IntersectTextLayout(Tk_TextLayout layout, int x, int y,
+ int width, int height)
+}
+declare 121 {
+ void Tk_MaintainGeometry(Tk_Window slave,
+ Tk_Window master, int x, int y, int width, int height)
+}
+declare 122 {
+ Tk_Window Tk_MainWindow(Tcl_Interp *interp)
+}
+declare 123 {
+ void Tk_MakeWindowExist(Tk_Window tkwin)
+}
+declare 124 {
+ void Tk_ManageGeometry(Tk_Window tkwin,
+ const Tk_GeomMgr *mgrPtr, ClientData clientData)
+}
+declare 125 {
+ void Tk_MapWindow(Tk_Window tkwin)
+}
+declare 126 {
+ int Tk_MeasureChars(Tk_Font tkfont,
+ const char *source, int numBytes, int maxPixels,
+ int flags, int *lengthPtr)
+}
+declare 127 {
+ void Tk_MoveResizeWindow(Tk_Window tkwin,
+ int x, int y, int width, int height)
+}
+declare 128 {
+ void Tk_MoveWindow(Tk_Window tkwin, int x, int y)
+}
+declare 129 {
+ void Tk_MoveToplevelWindow(Tk_Window tkwin, int x, int y)
+}
+declare 130 {
+ CONST84_RETURN char *Tk_NameOf3DBorder(Tk_3DBorder border)
+}
+declare 131 {
+ CONST84_RETURN char *Tk_NameOfAnchor(Tk_Anchor anchor)
+}
+declare 132 {
+ CONST84_RETURN char *Tk_NameOfBitmap(Display *display, Pixmap bitmap)
+}
+declare 133 {
+ CONST84_RETURN char *Tk_NameOfCapStyle(int cap)
+}
+declare 134 {
+ CONST84_RETURN char *Tk_NameOfColor(XColor *colorPtr)
+}
+declare 135 {
+ CONST84_RETURN char *Tk_NameOfCursor(Display *display, Tk_Cursor cursor)
+}
+declare 136 {
+ CONST84_RETURN char *Tk_NameOfFont(Tk_Font font)
+}
+declare 137 {
+ CONST84_RETURN char *Tk_NameOfImage(Tk_ImageMaster imageMaster)
+}
+declare 138 {
+ CONST84_RETURN char *Tk_NameOfJoinStyle(int join)
+}
+declare 139 {
+ CONST84_RETURN char *Tk_NameOfJustify(Tk_Justify justify)
+}
+declare 140 {
+ CONST84_RETURN char *Tk_NameOfRelief(int relief)
+}
+declare 141 {
+ Tk_Window Tk_NameToWindow(Tcl_Interp *interp,
+ const char *pathName, Tk_Window tkwin)
+}
+declare 142 {
+ void Tk_OwnSelection(Tk_Window tkwin,
+ Atom selection, Tk_LostSelProc *proc,
+ ClientData clientData)
+}
+declare 143 {
+ int Tk_ParseArgv(Tcl_Interp *interp,
+ Tk_Window tkwin, int *argcPtr, CONST84 char **argv,
+ const Tk_ArgvInfo *argTable, int flags)
+}
+declare 144 {
+ void Tk_PhotoPutBlock_NoComposite(Tk_PhotoHandle handle,
+ Tk_PhotoImageBlock *blockPtr, int x, int y,
+ int width, int height)
+}
+declare 145 {
+ void Tk_PhotoPutZoomedBlock_NoComposite(Tk_PhotoHandle handle,
+ Tk_PhotoImageBlock *blockPtr, int x, int y,
+ int width, int height, int zoomX, int zoomY,
+ int subsampleX, int subsampleY)
+}
+declare 146 {
+ int Tk_PhotoGetImage(Tk_PhotoHandle handle, Tk_PhotoImageBlock *blockPtr)
+}
+declare 147 {
+ void Tk_PhotoBlank(Tk_PhotoHandle handle)
+}
+declare 148 {
+ void Tk_PhotoExpand_Panic(Tk_PhotoHandle handle, int width, int height )
+}
+declare 149 {
+ void Tk_PhotoGetSize(Tk_PhotoHandle handle, int *widthPtr, int *heightPtr)
+}
+declare 150 {
+ void Tk_PhotoSetSize_Panic(Tk_PhotoHandle handle, int width, int height)
+}
+declare 151 {
+ int Tk_PointToChar(Tk_TextLayout layout, int x, int y)
+}
+declare 152 {
+ int Tk_PostscriptFontName(Tk_Font tkfont, Tcl_DString *dsPtr)
+}
+declare 153 {
+ void Tk_PreserveColormap(Display *display, Colormap colormap)
+}
+declare 154 {
+ void Tk_QueueWindowEvent(XEvent *eventPtr, Tcl_QueuePosition position)
+}
+declare 155 {
+ void Tk_RedrawImage(Tk_Image image, int imageX,
+ int imageY, int width, int height,
+ Drawable drawable, int drawableX, int drawableY)
+}
+declare 156 {
+ void Tk_ResizeWindow(Tk_Window tkwin, int width, int height)
+}
+declare 157 {
+ int Tk_RestackWindow(Tk_Window tkwin, int aboveBelow, Tk_Window other)
+}
+declare 158 {
+ Tk_RestrictProc *Tk_RestrictEvents(Tk_RestrictProc *proc,
+ ClientData arg, ClientData *prevArgPtr)
+}
+declare 159 {
+ int Tk_SafeInit(Tcl_Interp *interp)
+}
+declare 160 {
+ const char *Tk_SetAppName(Tk_Window tkwin, const char *name)
+}
+declare 161 {
+ void Tk_SetBackgroundFromBorder(Tk_Window tkwin, Tk_3DBorder border)
+}
+declare 162 {
+ void Tk_SetClass(Tk_Window tkwin, const char *className)
+}
+declare 163 {
+ void Tk_SetGrid(Tk_Window tkwin, int reqWidth, int reqHeight,
+ int gridWidth, int gridHeight)
+}
+declare 164 {
+ void Tk_SetInternalBorder(Tk_Window tkwin, int width)
+}
+declare 165 {
+ void Tk_SetWindowBackground(Tk_Window tkwin, unsigned long pixel)
+}
+declare 166 {
+ void Tk_SetWindowBackgroundPixmap(Tk_Window tkwin, Pixmap pixmap)
+}
+declare 167 {
+ void Tk_SetWindowBorder(Tk_Window tkwin, unsigned long pixel)
+}
+declare 168 {
+ void Tk_SetWindowBorderWidth(Tk_Window tkwin, int width)
+}
+declare 169 {
+ void Tk_SetWindowBorderPixmap(Tk_Window tkwin, Pixmap pixmap)
+}
+declare 170 {
+ void Tk_SetWindowColormap(Tk_Window tkwin, Colormap colormap)
+}
+declare 171 {
+ int Tk_SetWindowVisual(Tk_Window tkwin, Visual *visual, int depth,
+ Colormap colormap)
+}
+declare 172 {
+ void Tk_SizeOfBitmap(Display *display, Pixmap bitmap, int *widthPtr,
+ int *heightPtr)
+}
+declare 173 {
+ void Tk_SizeOfImage(Tk_Image image, int *widthPtr, int *heightPtr)
+}
+declare 174 {
+ int Tk_StrictMotif(Tk_Window tkwin)
+}
+declare 175 {
+ void Tk_TextLayoutToPostscript(Tcl_Interp *interp, Tk_TextLayout layout)
+}
+declare 176 {
+ int Tk_TextWidth(Tk_Font font, const char *str, int numBytes)
+}
+declare 177 {
+ void Tk_UndefineCursor(Tk_Window window)
+}
+declare 178 {
+ 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 {
+ void Tk_UnderlineTextLayout(Display *display, Drawable drawable, GC gc,
+ Tk_TextLayout layout, int x, int y,
+ int underline)
+}
+declare 180 {
+ void Tk_Ungrab(Tk_Window tkwin)
+}
+declare 181 {
+ void Tk_UnmaintainGeometry(Tk_Window slave, Tk_Window master)
+}
+declare 182 {
+ void Tk_UnmapWindow(Tk_Window tkwin)
+}
+declare 183 {
+ void Tk_UnsetGrid(Tk_Window tkwin)
+}
+declare 184 {
+ void Tk_UpdatePointer(Tk_Window tkwin, int x, int y, int state)
+}
+
+# new functions for 8.1
+
+declare 185 {
+ Pixmap Tk_AllocBitmapFromObj(Tcl_Interp *interp, Tk_Window tkwin,
+ Tcl_Obj *objPtr)
+}
+declare 186 {
+ Tk_3DBorder Tk_Alloc3DBorderFromObj(Tcl_Interp *interp, Tk_Window tkwin,
+ Tcl_Obj *objPtr)
+}
+declare 187 {
+ XColor *Tk_AllocColorFromObj(Tcl_Interp *interp, Tk_Window tkwin,
+ Tcl_Obj *objPtr)
+}
+declare 188 {
+ Tk_Cursor Tk_AllocCursorFromObj(Tcl_Interp *interp, Tk_Window tkwin,
+ Tcl_Obj *objPtr)
+}
+declare 189 {
+ Tk_Font Tk_AllocFontFromObj(Tcl_Interp *interp, Tk_Window tkwin,
+ Tcl_Obj *objPtr)
+
+}
+declare 190 {
+ Tk_OptionTable Tk_CreateOptionTable(Tcl_Interp *interp,
+ const Tk_OptionSpec *templatePtr)
+}
+declare 191 {
+ void Tk_DeleteOptionTable(Tk_OptionTable optionTable)
+}
+declare 192 {
+ void Tk_Free3DBorderFromObj(Tk_Window tkwin, Tcl_Obj *objPtr)
+}
+declare 193 {
+ void Tk_FreeBitmapFromObj(Tk_Window tkwin, Tcl_Obj *objPtr)
+}
+declare 194 {
+ void Tk_FreeColorFromObj(Tk_Window tkwin, Tcl_Obj *objPtr)
+}
+declare 195 {
+ void Tk_FreeConfigOptions(char *recordPtr, Tk_OptionTable optionToken,
+ Tk_Window tkwin)
+}
+declare 196 {
+ void Tk_FreeSavedOptions(Tk_SavedOptions *savePtr)
+}
+declare 197 {
+ void Tk_FreeCursorFromObj(Tk_Window tkwin, Tcl_Obj *objPtr)
+}
+declare 198 {
+ void Tk_FreeFontFromObj(Tk_Window tkwin, Tcl_Obj *objPtr)
+}
+declare 199 {
+ Tk_3DBorder Tk_Get3DBorderFromObj(Tk_Window tkwin, Tcl_Obj *objPtr)
+}
+declare 200 {
+ int Tk_GetAnchorFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr,
+ Tk_Anchor *anchorPtr)
+}
+declare 201 {
+ Pixmap Tk_GetBitmapFromObj(Tk_Window tkwin, Tcl_Obj *objPtr)
+}
+declare 202 {
+ XColor *Tk_GetColorFromObj(Tk_Window tkwin, Tcl_Obj *objPtr)
+}
+declare 203 {
+ Tk_Cursor Tk_GetCursorFromObj(Tk_Window tkwin, Tcl_Obj *objPtr)
+}
+declare 204 {
+ Tcl_Obj *Tk_GetOptionInfo(Tcl_Interp *interp,
+ char *recordPtr, Tk_OptionTable optionTable,
+ Tcl_Obj *namePtr, Tk_Window tkwin)
+}
+declare 205 {
+ Tcl_Obj *Tk_GetOptionValue(Tcl_Interp *interp, char *recordPtr,
+ Tk_OptionTable optionTable, Tcl_Obj *namePtr, Tk_Window tkwin)
+}
+declare 206 {
+ int Tk_GetJustifyFromObj(Tcl_Interp *interp,
+ Tcl_Obj *objPtr, Tk_Justify *justifyPtr)
+}
+declare 207 {
+ int Tk_GetMMFromObj(Tcl_Interp *interp,
+ Tk_Window tkwin, Tcl_Obj *objPtr, double *doublePtr)
+}
+declare 208 {
+ int Tk_GetPixelsFromObj(Tcl_Interp *interp,
+ Tk_Window tkwin, Tcl_Obj *objPtr, int *intPtr)
+}
+declare 209 {
+ int Tk_GetReliefFromObj(Tcl_Interp *interp,
+ Tcl_Obj *objPtr, int *resultPtr)
+}
+declare 210 {
+ int Tk_GetScrollInfoObj(Tcl_Interp *interp,
+ int objc, Tcl_Obj *const objv[], double *dblPtr, int *intPtr)
+}
+declare 211 {
+ int Tk_InitOptions(Tcl_Interp *interp, char *recordPtr,
+ Tk_OptionTable optionToken, Tk_Window tkwin)
+}
+declare 212 {
+ void Tk_MainEx(int argc, char **argv, Tcl_AppInitProc *appInitProc,
+ Tcl_Interp *interp)
+}
+declare 213 {
+ void Tk_RestoreSavedOptions(Tk_SavedOptions *savePtr)
+}
+declare 214 {
+ 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 {
+ void Tk_InitConsoleChannels(Tcl_Interp *interp)
+}
+declare 216 {
+ int Tk_CreateConsoleWindow(Tcl_Interp *interp)
+}
+declare 217 {
+ void Tk_CreateSmoothMethod(Tcl_Interp *interp, const Tk_SmoothMethod *method)
+}
+#declare 218 {
+# void Tk_CreateCanvasVisitor(Tcl_Interp *interp, void *typePtr)
+#}
+#declare 219 {
+# void *Tk_GetCanvasVisitor(Tcl_Interp *interp, const char *name)
+#}
+declare 220 {
+ int Tk_GetDash(Tcl_Interp *interp, const char *value, Tk_Dash *dash)
+}
+declare 221 {
+ void Tk_CreateOutline(Tk_Outline *outline)
+}
+declare 222 {
+ void Tk_DeleteOutline(Display *display, Tk_Outline *outline)
+}
+declare 223 {
+ int Tk_ConfigOutlineGC(XGCValues *gcValues, Tk_Canvas canvas,
+ Tk_Item *item, Tk_Outline *outline)
+}
+declare 224 {
+ int Tk_ChangeOutlineGC(Tk_Canvas canvas, Tk_Item *item,
+ Tk_Outline *outline)
+}
+declare 225 {
+ int Tk_ResetOutlineGC(Tk_Canvas canvas, Tk_Item *item,
+ Tk_Outline *outline)
+}
+declare 226 {
+ int Tk_CanvasPsOutline(Tk_Canvas canvas, Tk_Item *item,
+ Tk_Outline *outline)
+}
+declare 227 {
+ void Tk_SetTSOrigin(Tk_Window tkwin, GC gc, int x, int y)
+}
+declare 228 {
+ int Tk_CanvasGetCoordFromObj(Tcl_Interp *interp, Tk_Canvas canvas,
+ Tcl_Obj *obj, double *doublePtr)
+}
+declare 229 {
+ void Tk_CanvasSetOffset(Tk_Canvas canvas, GC gc, Tk_TSOffset *offset)
+}
+declare 230 {
+ void Tk_DitherPhoto(Tk_PhotoHandle handle, int x, int y, int width,
+ int height)
+}
+declare 231 {
+ int Tk_PostscriptBitmap(Tcl_Interp *interp, Tk_Window tkwin,
+ Tk_PostscriptInfo psInfo, Pixmap bitmap, int startX,
+ int startY, int width, int height)
+}
+declare 232 {
+ int Tk_PostscriptColor(Tcl_Interp *interp, Tk_PostscriptInfo psInfo,
+ XColor *colorPtr)
+}
+declare 233 {
+ int Tk_PostscriptFont(Tcl_Interp *interp, Tk_PostscriptInfo psInfo,
+ Tk_Font font)
+}
+declare 234 {
+ 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 {
+ void Tk_PostscriptPath(Tcl_Interp *interp, Tk_PostscriptInfo psInfo,
+ double *coordPtr, int numPoints)
+}
+declare 236 {
+ int Tk_PostscriptStipple(Tcl_Interp *interp, Tk_Window tkwin,
+ Tk_PostscriptInfo psInfo, Pixmap bitmap)
+}
+declare 237 {
+ double Tk_PostscriptY(double y, Tk_PostscriptInfo psInfo)
+}
+declare 238 {
+ int Tk_PostscriptPhoto(Tcl_Interp *interp,
+ Tk_PhotoImageBlock *blockPtr, Tk_PostscriptInfo psInfo,
+ int width, int height)
+}
+
+# New in 8.4a1
+#
+declare 239 {
+ void Tk_CreateClientMessageHandler(Tk_ClientMessageProc *proc)
+}
+declare 240 {
+ void Tk_DeleteClientMessageHandler(Tk_ClientMessageProc *proc)
+}
+
+# New in 8.4a2
+#
+declare 241 {
+ Tk_Window Tk_CreateAnonymousWindow(Tcl_Interp *interp,
+ Tk_Window parent, const char *screenName)
+}
+declare 242 {
+ void Tk_SetClassProcs(Tk_Window tkwin,
+ const Tk_ClassProcs *procs, ClientData instanceData)
+}
+
+# New in 8.4a4
+#
+declare 243 {
+ void Tk_SetInternalBorderEx(Tk_Window tkwin, int left, int right,
+ int top, int bottom)
+}
+declare 244 {
+ void Tk_SetMinimumRequestSize(Tk_Window tkwin,
+ int minWidth, int minHeight)
+}
+
+# New in 8.4a5
+#
+declare 245 {
+ void Tk_SetCaretPos(Tk_Window tkwin, int x, int y, int height)
+}
+declare 246 {
+ void Tk_PhotoPutBlock_Panic(Tk_PhotoHandle handle,
+ Tk_PhotoImageBlock *blockPtr, int x, int y,
+ int width, int height, int compRule)
+}
+declare 247 {
+ void Tk_PhotoPutZoomedBlock_Panic(Tk_PhotoHandle handle,
+ Tk_PhotoImageBlock *blockPtr, int x, int y,
+ int width, int height, int zoomX, int zoomY,
+ int subsampleX, int subsampleY, int compRule)
+}
+declare 248 {
+ int Tk_CollapseMotionEvents(Display *display, int collapse)
+}
+
+# Style engine
+declare 249 {
+ Tk_StyleEngine Tk_RegisterStyleEngine(const char *name,
+ Tk_StyleEngine parent)
+}
+declare 250 {
+ Tk_StyleEngine Tk_GetStyleEngine(const char *name)
+}
+declare 251 {
+ int Tk_RegisterStyledElement(Tk_StyleEngine engine,
+ Tk_ElementSpec *templatePtr)
+}
+declare 252 {
+ int Tk_GetElementId(const char *name)
+}
+declare 253 {
+ Tk_Style Tk_CreateStyle(const char *name, Tk_StyleEngine engine,
+ ClientData clientData)
+}
+declare 254 {
+ Tk_Style Tk_GetStyle(Tcl_Interp *interp, const char *name)
+}
+declare 255 {
+ void Tk_FreeStyle(Tk_Style style)
+}
+declare 256 {
+ const char *Tk_NameOfStyle(Tk_Style style)
+}
+declare 257 {
+ Tk_Style Tk_AllocStyleFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr)
+}
+declare 258 {
+ Tk_Style Tk_GetStyleFromObj(Tcl_Obj *objPtr)
+}
+declare 259 {
+ void Tk_FreeStyleFromObj(Tcl_Obj *objPtr)
+}
+declare 260 {
+ Tk_StyledElement Tk_GetStyledElement(Tk_Style style, int elementId,
+ Tk_OptionTable optionTable)
+}
+declare 261 {
+ void Tk_GetElementSize(Tk_Style style, Tk_StyledElement element,
+ char *recordPtr, Tk_Window tkwin, int width, int height,
+ int inner, int *widthPtr, int *heightPtr)
+}
+declare 262 {
+ void Tk_GetElementBox(Tk_Style style, Tk_StyledElement element,
+ char *recordPtr, Tk_Window tkwin, int x, int y, int width,
+ int height, int inner, int *xPtr, int *yPtr, int *widthPtr,
+ int *heightPtr)
+}
+declare 263 {
+ int Tk_GetElementBorderWidth(Tk_Style style, Tk_StyledElement element,
+ char *recordPtr, Tk_Window tkwin)
+}
+declare 264 {
+ void Tk_DrawElement(Tk_Style style, Tk_StyledElement element,
+ char *recordPtr, Tk_Window tkwin, Drawable d, int x, int y,
+ int width, int height, int state)
+}
+
+# TIP#116
+declare 265 {
+ int Tk_PhotoExpand(Tcl_Interp *interp, Tk_PhotoHandle handle,
+ int width, int height)
+}
+declare 266 {
+ int Tk_PhotoPutBlock(Tcl_Interp *interp, Tk_PhotoHandle handle,
+ Tk_PhotoImageBlock *blockPtr, int x, int y, int width, int height,
+ int compRule)
+}
+declare 267 {
+ int Tk_PhotoPutZoomedBlock(Tcl_Interp *interp, Tk_PhotoHandle handle,
+ Tk_PhotoImageBlock *blockPtr, int x, int y, int width, int height,
+ int zoomX, int zoomY, int subsampleX, int subsampleY, int compRule)
+}
+declare 268 {
+ int Tk_PhotoSetSize(Tcl_Interp *interp, Tk_PhotoHandle handle,
+ int width, int height)
+}
+# TIP#245
+declare 269 {
+ long Tk_GetUserInactiveTime(Display *dpy)
+}
+declare 270 {
+ void Tk_ResetUserInactiveTime(Display *dpy)
+}
+
+# TIP #264
+declare 271 {
+ Tcl_Interp *Tk_Interp(Tk_Window tkwin)
+}
+
+# Now that the Tk 8.2 -> 8.3 transition is long past, use more conventional
+# means to continue support for extensions using the USE_OLD_IMAGE to
+# continue use of their string-based Tcl_ImageTypes and Tcl_PhotoImageFormats.
+#
+# Note that this restores the usual rules for stub compatibility. Stub-enabled
+# extensions compiled against 8.5 headers and linked to the 8.5 stub library
+# will produce a file [load]able into an interp with Tk 8.X, for X >= 5.
+# It will *not* be [load]able into interps with Tk 8.4 (or Tk 8.2!).
+# Developers who need to produce a file [load]able into legacy interps must
+# build against legacy sources.
+declare 272 {
+ void Tk_CreateOldImageType(const Tk_ImageType *typePtr)
+}
+declare 273 {
+ void Tk_CreateOldPhotoImageFormat(const Tk_PhotoImageFormat *formatPtr)
+}
+
+# Define the platform specific public Tk interface. These functions are
+# only available on the designated platform.
+
+interface tkPlat
+
+################################
+# 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)
+}
+
+################################
+# Aqua specific functions
+
+declare 0 aqua {
+ void Tk_MacOSXSetEmbedHandler(
+ Tk_MacOSXEmbedRegisterWinProc *registerWinProcPtr,
+ Tk_MacOSXEmbedGetGrafPortProc *getPortProcPtr,
+ Tk_MacOSXEmbedMakeContainerExistProc *containerExistProcPtr,
+ Tk_MacOSXEmbedGetClipProc *getClipProc,
+ Tk_MacOSXEmbedGetOffsetInParentProc *getOffsetProc)
+}
+declare 1 aqua {
+ void Tk_MacOSXTurnOffMenus(void)
+}
+declare 2 aqua {
+ void Tk_MacOSXTkOwnsCursor(int tkOwnsIt)
+}
+declare 3 aqua {
+ void TkMacOSXInitMenus(Tcl_Interp *interp)
+}
+declare 4 aqua {
+ void TkMacOSXInitAppleEvents(Tcl_Interp *interp)
+}
+declare 5 aqua {
+ void TkGenWMConfigureEvent(Tk_Window tkwin, int x, int y, int width,
+ int height, int flags)
+}
+declare 6 aqua {
+ void TkMacOSXInvalClipRgns(Tk_Window tkwin)
+}
+declare 7 aqua {
+ void *TkMacOSXGetDrawablePort(Drawable drawable)
+}
+declare 8 aqua {
+ void *TkMacOSXGetRootControl(Drawable drawable)
+}
+declare 9 aqua {
+ void Tk_MacOSXSetupTkNotifier(void)
+}
+declare 10 aqua {
+ int Tk_MacOSXIsAppInFront(void)
+}
+
+##############################################################################
+
+# Public functions that are not accessible via the stubs table.
+
+export {
+ const char *Tk_PkgInitStubsCheck(Tcl_Interp *interp, const char *version,
+ int exact)
+}
+
+# Local Variables:
+# mode: tcl
+# End:
diff --git a/tk8.6/generic/tk.h b/tk8.6/generic/tk.h
new file mode 100644
index 0000000..69a0858
--- /dev/null
+++ b/tk8.6/generic/tk.h
@@ -0,0 +1,1619 @@
+/*
+ * tk.h --
+ *
+ * Declarations for Tk-related things that are visible outside of the Tk
+ * module itself.
+ *
+ * Copyright (c) 1989-1994 The Regents of the University of California.
+ * Copyright (c) 1994 The Australian National University.
+ * Copyright (c) 1994-1998 Sun Microsystems, Inc.
+ * Copyright (c) 1998-2000 Ajuba Solutions.
+ *
+ * See the file "license.terms" for information on usage and redistribution of
+ * this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ */
+
+#ifndef _TK
+#define _TK
+
+#include <tcl.h>
+#if (TCL_MAJOR_VERSION != 8) || (TCL_MINOR_VERSION < 6)
+# error Tk 8.6 must be compiled with tcl.h from Tcl 8.6 or better
+#endif
+
+#ifndef CONST84
+# define CONST84 const
+# define CONST84_RETURN const
+#endif
+#ifndef CONST86
+# define CONST86 CONST84
+#endif
+#ifndef EXTERN
+# define EXTERN extern TCL_STORAGE_CLASS
+#endif
+
+/*
+ * Utility macros: STRINGIFY takes an argument and wraps it in "" (double
+ * quotation marks), JOIN joins two arguments.
+ */
+
+#ifndef STRINGIFY
+# define STRINGIFY(x) STRINGIFY1(x)
+# define STRINGIFY1(x) #x
+#endif
+#ifndef JOIN
+# define JOIN(a,b) JOIN1(a,b)
+# define JOIN1(a,b) a##b
+#endif
+
+/*
+ * For C++ compilers, use extern "C"
+ */
+
+#ifdef __cplusplus
+extern "C" {
+#endif
+
+/*
+ * When version numbers change here, you must also go into the following files
+ * and update the version numbers:
+ *
+ * library/tk.tcl (1 LOC patch)
+ * unix/configure.in (2 LOC Major, 2 LOC minor, 1 LOC patch)
+ * win/configure.in (as above)
+ * README (sections 0 and 1)
+ * macosx/Tk-Common.xcconfig (not patchlevel) 1 LOC
+ * win/README (not patchlevel)
+ * unix/README (not patchlevel)
+ * unix/tk.spec (1 LOC patch)
+ * win/tcl.m4 (not patchlevel)
+ *
+ * You may also need to update some of these files when the numbers change for
+ * the version of Tcl that this release of Tk is compiled against.
+ */
+
+#define TK_MAJOR_VERSION 8
+#define TK_MINOR_VERSION 6
+#define TK_RELEASE_LEVEL TCL_FINAL_RELEASE
+#define TK_RELEASE_SERIAL 6
+
+#define TK_VERSION "8.6"
+#define TK_PATCH_LEVEL "8.6.6"
+
+/*
+ * A special definition used to allow this header file to be included from
+ * windows or mac resource files so that they can obtain version information.
+ * RC_INVOKED is defined by default by the windows RC tool and manually set
+ * for macintosh.
+ *
+ * Resource compilers don't like all the C stuff, like typedefs and procedure
+ * declarations, that occur below, so block them out.
+ */
+
+#ifndef RC_INVOKED
+
+#ifndef _XLIB_H
+# include <X11/Xlib.h>
+# ifdef MAC_OSX_TK
+# include <X11/X.h>
+# endif
+#endif
+#ifdef __STDC__
+# include <stddef.h>
+#endif
+
+#ifdef BUILD_tk
+#undef TCL_STORAGE_CLASS
+#define TCL_STORAGE_CLASS DLLEXPORT
+#endif
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Decide whether or not to use input methods.
+ */
+
+#ifdef XNQueryInputStyle
+#define TK_USE_INPUT_METHODS
+#endif
+
+/*
+ * Dummy types that are used by clients:
+ */
+
+typedef struct Tk_BindingTable_ *Tk_BindingTable;
+typedef struct Tk_Canvas_ *Tk_Canvas;
+typedef struct Tk_Cursor_ *Tk_Cursor;
+typedef struct Tk_ErrorHandler_ *Tk_ErrorHandler;
+typedef struct Tk_Font_ *Tk_Font;
+typedef struct Tk_Image__ *Tk_Image;
+typedef struct Tk_ImageMaster_ *Tk_ImageMaster;
+typedef struct Tk_OptionTable_ *Tk_OptionTable;
+typedef struct Tk_PostscriptInfo_ *Tk_PostscriptInfo;
+typedef struct Tk_TextLayout_ *Tk_TextLayout;
+typedef struct Tk_Window_ *Tk_Window;
+typedef struct Tk_3DBorder_ *Tk_3DBorder;
+typedef struct Tk_Style_ *Tk_Style;
+typedef struct Tk_StyleEngine_ *Tk_StyleEngine;
+typedef struct Tk_StyledElement_ *Tk_StyledElement;
+
+/*
+ * Additional types exported to clients.
+ */
+
+typedef const char *Tk_Uid;
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * The enum below defines the valid types for Tk configuration options as
+ * implemented by Tk_InitOptions, Tk_SetOptions, etc.
+ */
+
+typedef enum {
+ TK_OPTION_BOOLEAN,
+ TK_OPTION_INT,
+ TK_OPTION_DOUBLE,
+ TK_OPTION_STRING,
+ TK_OPTION_STRING_TABLE,
+ TK_OPTION_COLOR,
+ TK_OPTION_FONT,
+ TK_OPTION_BITMAP,
+ TK_OPTION_BORDER,
+ TK_OPTION_RELIEF,
+ TK_OPTION_CURSOR,
+ TK_OPTION_JUSTIFY,
+ TK_OPTION_ANCHOR,
+ TK_OPTION_SYNONYM,
+ TK_OPTION_PIXELS,
+ TK_OPTION_WINDOW,
+ TK_OPTION_END,
+ TK_OPTION_CUSTOM,
+ TK_OPTION_STYLE
+} Tk_OptionType;
+
+/*
+ * Structures of the following type are used by widgets to specify their
+ * configuration options. Typically each widget has a static array of these
+ * structures, where each element of the array describes a single
+ * configuration option. The array is passed to Tk_CreateOptionTable.
+ */
+
+typedef struct Tk_OptionSpec {
+ Tk_OptionType type; /* Type of option, such as TK_OPTION_COLOR;
+ * see definitions above. Last option in table
+ * must have type TK_OPTION_END. */
+ const char *optionName; /* Name used to specify option in Tcl
+ * commands. */
+ const char *dbName; /* Name for option in option database. */
+ const char *dbClass; /* Class for option in database. */
+ const 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. */
+ const void *clientData; /* An alternate place to put option-specific
+ * data. Used for the monochrome default value
+ * for colors, etc. */
+ int typeMask; /* An arbitrary bit mask defined by the class
+ * manager; typically bits correspond to
+ * certain kinds of options such as all those
+ * that require a redisplay when they change.
+ * Tk_SetOptions returns the bit-wise OR of
+ * the typeMasks of all options that were
+ * changed. */
+} Tk_OptionSpec;
+
+/*
+ * Flag values for Tk_OptionSpec structures. These flags are shared by
+ * Tk_ConfigSpec structures, so be sure to coordinate any changes carefully.
+ */
+
+#define TK_OPTION_NULL_OK (1 << 0)
+#define TK_OPTION_DONT_SET_DEFAULT (1 << 3)
+
+/*
+ * The following structure and function types are used by TK_OPTION_CUSTOM
+ * options; the structure holds pointers to the functions needed by the Tk
+ * option config code to handle a custom option.
+ */
+
+typedef int (Tk_CustomOptionSetProc) (ClientData clientData,
+ Tcl_Interp *interp, Tk_Window tkwin, Tcl_Obj **value, char *widgRec,
+ int offset, char *saveInternalPtr, int flags);
+typedef Tcl_Obj *(Tk_CustomOptionGetProc) (ClientData clientData,
+ Tk_Window tkwin, char *widgRec, int offset);
+typedef void (Tk_CustomOptionRestoreProc) (ClientData clientData,
+ Tk_Window tkwin, char *internalPtr, char *saveInternalPtr);
+typedef void (Tk_CustomOptionFreeProc) (ClientData clientData, Tk_Window tkwin,
+ char *internalPtr);
+
+typedef struct Tk_ObjCustomOption {
+ const char *name; /* Name of the custom option. */
+ Tk_CustomOptionSetProc *setProc;
+ /* Function to use to set a record's option
+ * value from a Tcl_Obj */
+ Tk_CustomOptionGetProc *getProc;
+ /* Function to use to get a Tcl_Obj
+ * representation from an internal
+ * representation of an option. */
+ Tk_CustomOptionRestoreProc *restoreProc;
+ /* Function to use to restore a saved value
+ * for the internal representation. */
+ Tk_CustomOptionFreeProc *freeProc;
+ /* Function to use to free the internal
+ * representation of an option. */
+ ClientData clientData; /* Arbitrary one-word value passed to the
+ * handling procs. */
+} Tk_ObjCustomOption;
+
+/*
+ * Macro to use to fill in "offset" fields of the Tk_OptionSpec structure.
+ * 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 config
+ * 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 was
+ * not 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 the field
+ * 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 (i.e., 8 bytes) is big
+ * enough. Also, using a double guarantees
+ * that the field is properly aligned for
+ * storing large values. */
+} Tk_SavedOption;
+
+#ifdef TCL_MEM_DEBUG
+# define TK_NUM_SAVED_OPTIONS 2
+#else
+# define TK_NUM_SAVED_OPTIONS 20
+#endif
+
+typedef struct Tk_SavedOptions {
+ char *recordPtr; /* The data structure in which to restore
+ * configuration options. */
+ Tk_Window tkwin; /* Window associated with recordPtr; needed to
+ * restore certain options. */
+ int numItems; /* The number of valid items in items field. */
+ Tk_SavedOption items[TK_NUM_SAVED_OPTIONS];
+ /* Items used to hold old values. */
+ struct Tk_SavedOptions *nextPtr;
+ /* Points to next structure in list; needed if
+ * too many options changed to hold all the
+ * old values in a single structure. NULL
+ * means no more structures. */
+} Tk_SavedOptions;
+
+/*
+ * Structure used to describe application-specific configuration options:
+ * indicates procedures to call to parse an option and to return a text string
+ * describing an option. THESE ARE DEPRECATED; PLEASE USE THE NEW STRUCTURES
+ * LISTED ABOVE.
+ */
+
+/*
+ * This is a temporary flag used while tkObjConfig and new widgets are in
+ * development.
+ */
+
+#ifndef __NO_OLD_CONFIG
+
+typedef int (Tk_OptionParseProc) (ClientData clientData, Tcl_Interp *interp,
+ Tk_Window tkwin, CONST84 char *value, char *widgRec, int offset);
+typedef CONST86 char *(Tk_OptionPrintProc) (ClientData clientData,
+ Tk_Window tkwin, char *widgRec, int offset, Tcl_FreeProc **freeProcPtr);
+
+typedef struct Tk_CustomOption {
+ Tk_OptionParseProc *parseProc;
+ /* Procedure to call to parse an option and
+ * store it in converted form. */
+ Tk_OptionPrintProc *printProc;
+ /* Procedure to return a printable string
+ * describing an existing option. */
+ ClientData clientData; /* Arbitrary one-word value used by option
+ * parser: passed to parseProc and
+ * printProc. */
+} Tk_CustomOption;
+
+/*
+ * Structure used to specify information for Tk_ConfigureWidget. Each
+ * structure gives complete information for one option, including how the
+ * option is specified on the command line, where it appears in the option
+ * database, etc.
+ */
+
+typedef struct Tk_ConfigSpec {
+ int type; /* Type of option, such as TK_CONFIG_COLOR;
+ * see definitions below. Last option in table
+ * must have type TK_CONFIG_END. */
+ CONST86 char *argvName; /* Switch used to specify option in argv. NULL
+ * means this spec is part of a group. */
+ Tk_Uid dbName; /* Name for option in option database. */
+ Tk_Uid dbClass; /* Class for option in database. */
+ Tk_Uid defValue; /* Default value for option if not specified
+ * in command line or database. */
+ int offset; /* Where in widget record to store value; use
+ * Tk_Offset macro to generate values for
+ * this. */
+ int specFlags; /* Any combination of the values defined
+ * below; other bits are used internally by
+ * tkConfig.c. */
+ CONST86 Tk_CustomOption *customPtr;
+ /* If type is TK_CONFIG_CUSTOM then this is a
+ * pointer to info about how to parse and
+ * print the option. Otherwise it is
+ * irrelevant. */
+} Tk_ConfigSpec;
+
+/*
+ * Type values for Tk_ConfigSpec structures. See the user documentation for
+ * details.
+ */
+
+typedef enum {
+ TK_CONFIG_BOOLEAN, TK_CONFIG_INT, TK_CONFIG_DOUBLE, TK_CONFIG_STRING,
+ TK_CONFIG_UID, TK_CONFIG_COLOR, TK_CONFIG_FONT, TK_CONFIG_BITMAP,
+ TK_CONFIG_BORDER, TK_CONFIG_RELIEF, TK_CONFIG_CURSOR,
+ TK_CONFIG_ACTIVE_CURSOR, TK_CONFIG_JUSTIFY, TK_CONFIG_ANCHOR,
+ TK_CONFIG_SYNONYM, TK_CONFIG_CAP_STYLE, TK_CONFIG_JOIN_STYLE,
+ TK_CONFIG_PIXELS, TK_CONFIG_MM, TK_CONFIG_WINDOW, TK_CONFIG_CUSTOM,
+ TK_CONFIG_END
+} Tk_ConfigTypes;
+
+/*
+ * Possible values for flags argument to Tk_ConfigureWidget:
+ */
+
+#define TK_CONFIG_ARGV_ONLY 1
+#define TK_CONFIG_OBJS 0x80
+
+/*
+ * Possible flag values for Tk_ConfigSpec structures. Any bits at or above
+ * TK_CONFIG_USER_BIT may be used by clients for selecting certain entries.
+ * Before changing any values here, coordinate with tkOldConfig.c
+ * (internal-use-only flags are defined there).
+ */
+
+#define TK_CONFIG_NULL_OK (1 << 0)
+#define TK_CONFIG_COLOR_ONLY (1 << 1)
+#define TK_CONFIG_MONO_ONLY (1 << 2)
+#define TK_CONFIG_DONT_SET_DEFAULT (1 << 3)
+#define TK_CONFIG_OPTION_SPECIFIED (1 << 4)
+#define TK_CONFIG_USER_BIT 0x100
+#endif /* __NO_OLD_CONFIG */
+
+/*
+ * Structure used to specify how to handle argv options.
+ */
+
+typedef struct {
+ CONST86 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. */
+ CONST86 char *help; /* Documentation message describing this
+ * option. */
+} Tk_ArgvInfo;
+
+/*
+ * Legal values for the type field of a Tk_ArgvInfo: see the user
+ * documentation for details.
+ */
+
+#define TK_ARGV_CONSTANT 15
+#define TK_ARGV_INT 16
+#define TK_ARGV_STRING 17
+#define TK_ARGV_UID 18
+#define TK_ARGV_REST 19
+#define TK_ARGV_FLOAT 20
+#define TK_ARGV_FUNC 21
+#define TK_ARGV_GENFUNC 22
+#define TK_ARGV_HELP 23
+#define TK_ARGV_CONST_OPTION 24
+#define TK_ARGV_OPTION_VALUE 25
+#define TK_ARGV_OPTION_NAME_VALUE 26
+#define TK_ARGV_END 27
+
+/*
+ * Flag bits for passing to Tk_ParseArgv:
+ */
+
+#define TK_ARGV_NO_DEFAULTS 0x1
+#define TK_ARGV_NO_LEFTOVERS 0x2
+#define TK_ARGV_NO_ABBREV 0x4
+#define TK_ARGV_DONT_SKIP_FIRST_ARG 0x8
+
+/*
+ * Enumerated type for describing actions to be taken in response to a
+ * restrictProc established by Tk_RestrictEvents.
+ */
+
+typedef enum {
+ TK_DEFER_EVENT, TK_PROCESS_EVENT, TK_DISCARD_EVENT
+} Tk_RestrictAction;
+
+/*
+ * Priority levels to pass to Tk_AddOption:
+ */
+
+#define TK_WIDGET_DEFAULT_PRIO 20
+#define TK_STARTUP_FILE_PRIO 40
+#define TK_USER_DEFAULT_PRIO 60
+#define TK_INTERACTIVE_PRIO 80
+#define TK_MAX_PRIO 100
+
+/*
+ * Relief values returned by Tk_GetRelief:
+ */
+
+#define TK_RELIEF_NULL -1
+#define TK_RELIEF_FLAT 0
+#define TK_RELIEF_GROOVE 1
+#define TK_RELIEF_RAISED 2
+#define TK_RELIEF_RIDGE 3
+#define TK_RELIEF_SOLID 4
+#define TK_RELIEF_SUNKEN 5
+
+/*
+ * "Which" argument values for Tk_3DBorderGC:
+ */
+
+#define TK_3D_FLAT_GC 1
+#define TK_3D_LIGHT_GC 2
+#define TK_3D_DARK_GC 3
+
+/*
+ * Special EnterNotify/LeaveNotify "mode" for use in events generated by
+ * tkShare.c. Pick a high enough value that it's unlikely to conflict with
+ * existing values (like NotifyNormal) or any new values defined in the
+ * future.
+ */
+
+#define TK_NOTIFY_SHARE 20
+
+/*
+ * Enumerated type for describing a point by which to anchor something:
+ */
+
+typedef enum {
+ TK_ANCHOR_N, TK_ANCHOR_NE, TK_ANCHOR_E, TK_ANCHOR_SE,
+ TK_ANCHOR_S, TK_ANCHOR_SW, TK_ANCHOR_W, TK_ANCHOR_NW,
+ TK_ANCHOR_CENTER
+} Tk_Anchor;
+
+/*
+ * Enumerated type for describing a style of justification:
+ */
+
+typedef enum {
+ TK_JUSTIFY_LEFT, TK_JUSTIFY_RIGHT, TK_JUSTIFY_CENTER
+} Tk_Justify;
+
+/*
+ * The following structure is used by Tk_GetFontMetrics() to return
+ * information about the properties of a Tk_Font.
+ */
+
+typedef struct Tk_FontMetrics {
+ int ascent; /* The amount in pixels that the tallest
+ * letter sticks up above the baseline, plus
+ * any extra blank space added by the designer
+ * of the font. */
+ int descent; /* The largest amount in pixels that any
+ * letter sticks below the baseline, plus any
+ * extra blank space added by the designer of
+ * the font. */
+ int linespace; /* The sum of the ascent and descent. How far
+ * apart two lines of text in the same font
+ * should be placed so that none of the
+ * characters in one line overlap any of the
+ * characters in the other line. */
+} Tk_FontMetrics;
+
+/*
+ * Flags passed to Tk_MeasureChars:
+ */
+
+#define TK_WHOLE_WORDS 1
+#define TK_AT_LEAST_ONE 2
+#define TK_PARTIAL_OK 4
+
+/*
+ * Flags passed to Tk_ComputeTextLayout:
+ */
+
+#define TK_IGNORE_TABS 8
+#define TK_IGNORE_NEWLINES 16
+
+/*
+ * Widget class procedures used to implement platform specific widget
+ * behavior.
+ */
+
+typedef Window (Tk_ClassCreateProc) (Tk_Window tkwin, Window parent,
+ ClientData instanceData);
+typedef void (Tk_ClassWorldChangedProc) (ClientData instanceData);
+typedef void (Tk_ClassModalProc) (Tk_Window tkwin, XEvent *eventPtr);
+
+typedef struct Tk_ClassProcs {
+ unsigned int size;
+ Tk_ClassWorldChangedProc *worldChangedProc;
+ /* Procedure to invoke when the widget needs
+ * to respond in some way to a change in the
+ * world (font changes, etc.) */
+ Tk_ClassCreateProc *createProc;
+ /* Procedure to invoke when the platform-
+ * dependent window needs to be created. */
+ Tk_ClassModalProc *modalProc;
+ /* Procedure to invoke after all bindings on a
+ * widget have been triggered in order to
+ * handle a modal loop. */
+} Tk_ClassProcs;
+
+/*
+ * Simple accessor for Tk_ClassProcs structure. Checks that the structure is
+ * not NULL, then checks the size field and returns either the requested
+ * field, if present, or NULL if the structure is too small to have the field
+ * (or NULL if the structure is NULL).
+ *
+ * A more general version of this function may be useful if other
+ * size-versioned structure pop up in the future:
+ *
+ * #define Tk_GetField(name, who, which) \
+ * (((who) == NULL) ? NULL :
+ * (((who)->size <= Tk_Offset(name, which)) ? NULL :(name)->which))
+ */
+
+#define Tk_GetClassProc(procs, which) \
+ (((procs) == NULL) ? NULL : \
+ (((procs)->size <= Tk_Offset(Tk_ClassProcs, which)) ? NULL:(procs)->which))
+
+/*
+ * Each geometry manager (the packer, the placer, etc.) is represented by a
+ * structure of the following form, which indicates procedures to invoke in
+ * the geometry manager to carry out certain functions.
+ */
+
+typedef void (Tk_GeomRequestProc) (ClientData clientData, Tk_Window tkwin);
+typedef void (Tk_GeomLostSlaveProc) (ClientData clientData, Tk_Window tkwin);
+
+typedef struct Tk_GeomMgr {
+ const char *name; /* Name of the geometry manager (command used
+ * to invoke it, or name of widget class that
+ * allows embedded widgets). */
+ Tk_GeomRequestProc *requestProc;
+ /* Procedure to invoke when a slave's
+ * requested geometry changes. */
+ Tk_GeomLostSlaveProc *lostSlaveProc;
+ /* Procedure to invoke when a slave is taken
+ * away from one geometry manager by another.
+ * NULL means geometry manager doesn't care
+ * when slaves are lost. */
+} Tk_GeomMgr;
+
+/*
+ * Result values returned by Tk_GetScrollInfo:
+ */
+
+#define TK_SCROLL_MOVETO 1
+#define TK_SCROLL_PAGES 2
+#define TK_SCROLL_UNITS 3
+#define TK_SCROLL_ERROR 4
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Extensions to the X event set
+ *
+ *----------------------------------------------------------------------
+ */
+
+#define VirtualEvent (MappingNotify + 1)
+#define ActivateNotify (MappingNotify + 2)
+#define DeactivateNotify (MappingNotify + 3)
+#define MouseWheelEvent (MappingNotify + 4)
+#define TK_LASTEVENT (MappingNotify + 5)
+
+#define MouseWheelMask (1L << 28)
+#define ActivateMask (1L << 29)
+#define VirtualEventMask (1L << 30)
+
+/*
+ * A virtual event shares most of its fields with the XKeyEvent and
+ * XButtonEvent structures. 99% of the time a virtual event will be an
+ * abstraction of a key or button event, so this structure provides the most
+ * information to the user. The only difference is the changing of the detail
+ * field for a virtual event so that it holds the name of the virtual event
+ * being triggered.
+ *
+ * When using this structure, you should ensure that you zero out all the
+ * fields first using memset() or bzero().
+ */
+
+typedef struct {
+ int type;
+ unsigned long serial; /* # of last request processed by server. */
+ Bool send_event; /* True if this came from a SendEvent
+ * request. */
+ Display *display; /* Display the event was read from. */
+ Window event; /* Window on which event was requested. */
+ Window root; /* Root window that the event occured on. */
+ Window subwindow; /* Child window. */
+ Time time; /* Milliseconds. */
+ int x, y; /* Pointer x, y coordinates in event
+ * window. */
+ int x_root, y_root; /* Coordinates relative to root. */
+ unsigned int state; /* Key or button mask */
+ Tk_Uid name; /* Name of virtual event. */
+ Bool same_screen; /* Same screen flag. */
+ Tcl_Obj *user_data; /* Application-specific data reference; Tk
+ * will decrement the reference count *once*
+ * when it has finished processing the
+ * event. */
+} XVirtualEvent;
+
+typedef struct {
+ int type;
+ unsigned long serial; /* # of last request processed by server. */
+ Bool send_event; /* True if this came from a SendEvent
+ * request. */
+ Display *display; /* Display the event was read from. */
+ Window window; /* Window in which event occurred. */
+} XActivateDeactivateEvent;
+typedef XActivateDeactivateEvent XActivateEvent;
+typedef XActivateDeactivateEvent XDeactivateEvent;
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Macros for querying Tk_Window structures. See the manual entries for
+ * documentation.
+ *
+ *----------------------------------------------------------------------
+ */
+
+#define Tk_Display(tkwin) (((Tk_FakeWin *) (tkwin))->display)
+#define Tk_ScreenNumber(tkwin) (((Tk_FakeWin *) (tkwin))->screenNum)
+#define Tk_Screen(tkwin) \
+ (ScreenOfDisplay(Tk_Display(tkwin), Tk_ScreenNumber(tkwin)))
+#define Tk_Depth(tkwin) (((Tk_FakeWin *) (tkwin))->depth)
+#define Tk_Visual(tkwin) (((Tk_FakeWin *) (tkwin))->visual)
+#define Tk_WindowId(tkwin) (((Tk_FakeWin *) (tkwin))->window)
+#define Tk_PathName(tkwin) (((Tk_FakeWin *) (tkwin))->pathName)
+#define Tk_Name(tkwin) (((Tk_FakeWin *) (tkwin))->nameUid)
+#define Tk_Class(tkwin) (((Tk_FakeWin *) (tkwin))->classUid)
+#define Tk_X(tkwin) (((Tk_FakeWin *) (tkwin))->changes.x)
+#define Tk_Y(tkwin) (((Tk_FakeWin *) (tkwin))->changes.y)
+#define Tk_Width(tkwin) (((Tk_FakeWin *) (tkwin))->changes.width)
+#define Tk_Height(tkwin) \
+ (((Tk_FakeWin *) (tkwin))->changes.height)
+#define Tk_Changes(tkwin) (&((Tk_FakeWin *) (tkwin))->changes)
+#define Tk_Attributes(tkwin) (&((Tk_FakeWin *) (tkwin))->atts)
+#define Tk_IsEmbedded(tkwin) \
+ (((Tk_FakeWin *) (tkwin))->flags & TK_EMBEDDED)
+#define Tk_IsContainer(tkwin) \
+ (((Tk_FakeWin *) (tkwin))->flags & TK_CONTAINER)
+#define Tk_IsMapped(tkwin) \
+ (((Tk_FakeWin *) (tkwin))->flags & TK_MAPPED)
+#define Tk_IsTopLevel(tkwin) \
+ (((Tk_FakeWin *) (tkwin))->flags & TK_TOP_LEVEL)
+#define Tk_HasWrapper(tkwin) \
+ (((Tk_FakeWin *) (tkwin))->flags & TK_HAS_WRAPPER)
+#define Tk_WinManaged(tkwin) \
+ (((Tk_FakeWin *) (tkwin))->flags & TK_WIN_MANAGED)
+#define Tk_TopWinHierarchy(tkwin) \
+ (((Tk_FakeWin *) (tkwin))->flags & TK_TOP_HIERARCHY)
+#define Tk_IsManageable(tkwin) \
+ (((Tk_FakeWin *) (tkwin))->flags & TK_WM_MANAGEABLE)
+#define Tk_ReqWidth(tkwin) (((Tk_FakeWin *) (tkwin))->reqWidth)
+#define Tk_ReqHeight(tkwin) (((Tk_FakeWin *) (tkwin))->reqHeight)
+/* Tk_InternalBorderWidth is deprecated */
+#define Tk_InternalBorderWidth(tkwin) \
+ (((Tk_FakeWin *) (tkwin))->internalBorderLeft)
+#define Tk_InternalBorderLeft(tkwin) \
+ (((Tk_FakeWin *) (tkwin))->internalBorderLeft)
+#define Tk_InternalBorderRight(tkwin) \
+ (((Tk_FakeWin *) (tkwin))->internalBorderRight)
+#define Tk_InternalBorderTop(tkwin) \
+ (((Tk_FakeWin *) (tkwin))->internalBorderTop)
+#define Tk_InternalBorderBottom(tkwin) \
+ (((Tk_FakeWin *) (tkwin))->internalBorderBottom)
+#define Tk_MinReqWidth(tkwin) (((Tk_FakeWin *) (tkwin))->minReqWidth)
+#define Tk_MinReqHeight(tkwin) (((Tk_FakeWin *) (tkwin))->minReqHeight)
+#define Tk_Parent(tkwin) (((Tk_FakeWin *) (tkwin))->parentPtr)
+#define Tk_Colormap(tkwin) (((Tk_FakeWin *) (tkwin))->atts.colormap)
+
+/*
+ * The structure below is needed by the macros above so that they can access
+ * the fields of a Tk_Window. The fields not needed by the macros are declared
+ * as "dummyX". The structure has its own type in order to prevent apps from
+ * accessing Tk_Window fields except using official macros. WARNING!! The
+ * structure definition must be kept consistent with the TkWindow structure in
+ * tkInt.h. If you change one, then change the other. See the declaration in
+ * tkInt.h for documentation on what the fields are used for internally.
+ */
+
+typedef struct Tk_FakeWin {
+ Display *display;
+ char *dummy1; /* dispPtr */
+ int screenNum;
+ Visual *visual;
+ int depth;
+ Window window;
+ char *dummy2; /* childList */
+ char *dummy3; /* lastChildPtr */
+ Tk_Window parentPtr; /* parentPtr */
+ char *dummy4; /* nextPtr */
+ char *dummy5; /* mainPtr */
+ char *pathName;
+ Tk_Uid nameUid;
+ Tk_Uid classUid;
+ XWindowChanges changes;
+ unsigned int dummy6; /* dirtyChanges */
+ XSetWindowAttributes atts;
+ unsigned long dummy7; /* dirtyAtts */
+ unsigned int flags;
+ char *dummy8; /* handlerList */
+#ifdef TK_USE_INPUT_METHODS
+ XIC dummy9; /* inputContext */
+#endif /* TK_USE_INPUT_METHODS */
+ ClientData *dummy10; /* tagPtr */
+ int dummy11; /* numTags */
+ int dummy12; /* optionLevel */
+ char *dummy13; /* selHandlerList */
+ char *dummy14; /* geomMgrPtr */
+ ClientData dummy15; /* geomData */
+ int reqWidth, reqHeight;
+ int internalBorderLeft;
+ char *dummy16; /* wmInfoPtr */
+ char *dummy17; /* classProcPtr */
+ ClientData dummy18; /* instanceData */
+ char *dummy19; /* privatePtr */
+ int internalBorderRight;
+ int internalBorderTop;
+ int internalBorderBottom;
+ int minReqWidth;
+ int minReqHeight;
+ char *dummy20; /* geometryMaster */
+} Tk_FakeWin;
+
+/*
+ * Flag values for TkWindow (and Tk_FakeWin) structures are:
+ *
+ * TK_MAPPED: 1 means window is currently mapped,
+ * 0 means unmapped.
+ * TK_TOP_LEVEL: 1 means this is a top-level widget.
+ * TK_ALREADY_DEAD: 1 means the window is in the process of
+ * being destroyed already.
+ * TK_NEED_CONFIG_NOTIFY: 1 means that the window has been reconfigured
+ * before it was made to exist. At the time of
+ * making it exist a ConfigureNotify event needs
+ * to be generated.
+ * TK_GRAB_FLAG: Used to manage grabs. See tkGrab.c for details
+ * TK_CHECKED_IC: 1 means we've already tried to get an input
+ * context for this window; if the ic field is
+ * NULL it means that there isn't a context for
+ * the field.
+ * TK_DONT_DESTROY_WINDOW: 1 means that Tk_DestroyWindow should not
+ * invoke XDestroyWindow to destroy this widget's
+ * X window. The flag is set when the window has
+ * already been destroyed elsewhere (e.g. by
+ * another application) or when it will be
+ * destroyed later (e.g. by destroying its parent)
+ * TK_WM_COLORMAP_WINDOW: 1 means that this window has at some time
+ * appeared in the WM_COLORMAP_WINDOWS property
+ * for its toplevel, so we have to remove it from
+ * that property if the window is deleted and the
+ * toplevel isn't.
+ * TK_EMBEDDED: 1 means that this window (which must be a
+ * toplevel) is not a free-standing window but
+ * rather is embedded in some other application.
+ * TK_CONTAINER: 1 means that this window is a container, and
+ * that some other application (either in this
+ * process or elsewhere) may be embedding itself
+ * inside the window.
+ * TK_BOTH_HALVES: 1 means that this window is used for
+ * application embedding (either as container or
+ * embedded application), and both the containing
+ * and embedded halves are associated with
+ * windows in this particular process.
+ * TK_WRAPPER: 1 means that this window is the extra wrapper
+ * window created around a toplevel to hold the
+ * menubar under Unix. See tkUnixWm.c for more
+ * information.
+ * TK_REPARENTED: 1 means that this window has been reparented
+ * so that as far as the window system is
+ * concerned it isn't a child of its Tk parent.
+ * Initially this is used only for special Unix
+ * menubar windows.
+ * TK_ANONYMOUS_WINDOW: 1 means that this window has no name, and is
+ * thus not accessible from Tk.
+ * TK_HAS_WRAPPER 1 means that this window has a wrapper window
+ * TK_WIN_MANAGED 1 means that this window is a child of the root
+ * window, and is managed by the window manager.
+ * TK_TOP_HIERARCHY 1 means this window is at the top of a physical
+ * window hierarchy within this process, i.e. the
+ * window's parent either doesn't exist or is not
+ * owned by this Tk application.
+ * TK_PROP_PROPCHANGE 1 means that PropertyNotify events in the
+ * window's children should propagate up to this
+ * window.
+ * TK_WM_MANAGEABLE 1 marks a window as capable of being converted
+ * into a toplevel using [wm manage].
+ */
+
+#define TK_MAPPED 1
+#define TK_TOP_LEVEL 2
+#define TK_ALREADY_DEAD 4
+#define TK_NEED_CONFIG_NOTIFY 8
+#define TK_GRAB_FLAG 0x10
+#define TK_CHECKED_IC 0x20
+#define TK_DONT_DESTROY_WINDOW 0x40
+#define TK_WM_COLORMAP_WINDOW 0x80
+#define TK_EMBEDDED 0x100
+#define TK_CONTAINER 0x200
+#define TK_BOTH_HALVES 0x400
+#define TK_WRAPPER 0x1000
+#define TK_REPARENTED 0x2000
+#define TK_ANONYMOUS_WINDOW 0x4000
+#define TK_HAS_WRAPPER 0x8000
+#define TK_WIN_MANAGED 0x10000
+#define TK_TOP_HIERARCHY 0x20000
+#define TK_PROP_PROPCHANGE 0x40000
+#define TK_WM_MANAGEABLE 0x80000
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Procedure prototypes and structures used for defining new canvas items:
+ *
+ *----------------------------------------------------------------------
+ */
+
+typedef enum {
+ TK_STATE_NULL = -1, TK_STATE_ACTIVE, TK_STATE_DISABLED,
+ TK_STATE_NORMAL, TK_STATE_HIDDEN
+} Tk_State;
+
+typedef struct Tk_SmoothMethod {
+ CONST86 char *name;
+ int (*coordProc) (Tk_Canvas canvas, double *pointPtr, int numPoints,
+ int numSteps, XPoint xPoints[], double dblPoints[]);
+ void (*postscriptProc) (Tcl_Interp *interp, Tk_Canvas canvas,
+ double *coordPtr, int numPoints, int numSteps);
+} Tk_SmoothMethod;
+
+/*
+ * For each item in a canvas widget there exists one record with the following
+ * structure. Each actual item is represented by a record with the following
+ * stuff at its beginning, plus additional type-specific stuff after that.
+ */
+
+#define TK_TAG_SPACE 3
+
+typedef struct Tk_Item {
+ int id; /* Unique identifier for this item (also
+ * serves as first tag for item). */
+ struct Tk_Item *nextPtr; /* Next in display list of all items in this
+ * canvas. Later items in list are drawn on
+ * top of earlier ones. */
+ Tk_Uid staticTagSpace[TK_TAG_SPACE];
+ /* Built-in space for limited # of tags. */
+ Tk_Uid *tagPtr; /* Pointer to array of tags. Usually points to
+ * staticTagSpace, but may point to malloc-ed
+ * space if there are lots of tags. */
+ int tagSpace; /* Total amount of tag space available at
+ * tagPtr. */
+ int numTags; /* Number of tag slots actually used at
+ * *tagPtr. */
+ struct Tk_ItemType *typePtr;/* Table of procedures that implement this
+ * type of item. */
+ int x1, y1, x2, y2; /* Bounding box for item, in integer canvas
+ * units. Set by item-specific code and
+ * guaranteed to contain every pixel drawn in
+ * item. Item area includes x1 and y1 but not
+ * x2 and y2. */
+ struct Tk_Item *prevPtr; /* Previous in display list of all items in
+ * this canvas. Later items in list are drawn
+ * just below earlier ones. */
+ Tk_State state; /* State of item. */
+ char *reserved1; /* reserved for future use */
+ int redraw_flags; /* Some flags used in the canvas */
+
+ /*
+ *------------------------------------------------------------------
+ * Starting here is additional type-specific stuff; see the declarations
+ * for individual types to see what is part of each type. The actual space
+ * below is determined by the "itemInfoSize" of the type's Tk_ItemType
+ * record.
+ *------------------------------------------------------------------
+ */
+} Tk_Item;
+
+/*
+ * Flag bits for canvases (redraw_flags):
+ *
+ * TK_ITEM_STATE_DEPENDANT - 1 means that object needs to be redrawn if the
+ * canvas state changes.
+ * TK_ITEM_DONT_REDRAW - 1 means that the object redraw is already been
+ * prepared, so the general canvas code doesn't
+ * need to do that any more.
+ */
+
+#define TK_ITEM_STATE_DEPENDANT 1
+#define TK_ITEM_DONT_REDRAW 2
+
+/*
+ * Records of the following type are used to describe a type of item (e.g.
+ * lines, circles, etc.) that can form part of a canvas widget.
+ */
+
+#ifdef USE_OLD_CANVAS
+typedef int (Tk_ItemCreateProc)(Tcl_Interp *interp, Tk_Canvas canvas,
+ Tk_Item *itemPtr, int argc, char **argv);
+typedef int (Tk_ItemConfigureProc)(Tcl_Interp *interp, Tk_Canvas canvas,
+ Tk_Item *itemPtr, int argc, char **argv, int flags);
+typedef int (Tk_ItemCoordProc)(Tcl_Interp *interp, Tk_Canvas canvas,
+ Tk_Item *itemPtr, int argc, char **argv);
+#else
+typedef int (Tk_ItemCreateProc)(Tcl_Interp *interp, Tk_Canvas canvas,
+ Tk_Item *itemPtr, int argc, Tcl_Obj *const objv[]);
+typedef int (Tk_ItemConfigureProc)(Tcl_Interp *interp, Tk_Canvas canvas,
+ Tk_Item *itemPtr, int argc, Tcl_Obj *const objv[],
+ int flags);
+typedef int (Tk_ItemCoordProc)(Tcl_Interp *interp, Tk_Canvas canvas,
+ Tk_Item *itemPtr, int argc, Tcl_Obj *const argv[]);
+#endif /* USE_OLD_CANVAS */
+typedef void (Tk_ItemDeleteProc)(Tk_Canvas canvas, Tk_Item *itemPtr,
+ Display *display);
+typedef void (Tk_ItemDisplayProc)(Tk_Canvas canvas, Tk_Item *itemPtr,
+ Display *display, Drawable dst, int x, int y, int width,
+ int height);
+typedef double (Tk_ItemPointProc)(Tk_Canvas canvas, Tk_Item *itemPtr,
+ double *pointPtr);
+typedef int (Tk_ItemAreaProc)(Tk_Canvas canvas, Tk_Item *itemPtr,
+ double *rectPtr);
+typedef int (Tk_ItemPostscriptProc)(Tcl_Interp *interp, Tk_Canvas canvas,
+ Tk_Item *itemPtr, int prepass);
+typedef void (Tk_ItemScaleProc)(Tk_Canvas canvas, Tk_Item *itemPtr,
+ double originX, double originY, double scaleX,
+ double scaleY);
+typedef void (Tk_ItemTranslateProc)(Tk_Canvas canvas, Tk_Item *itemPtr,
+ double deltaX, double deltaY);
+#ifdef USE_OLD_CANVAS
+typedef int (Tk_ItemIndexProc)(Tcl_Interp *interp, Tk_Canvas canvas,
+ Tk_Item *itemPtr, char *indexString, int *indexPtr);
+#else
+typedef int (Tk_ItemIndexProc)(Tcl_Interp *interp, Tk_Canvas canvas,
+ Tk_Item *itemPtr, Tcl_Obj *indexString, int *indexPtr);
+#endif /* USE_OLD_CANVAS */
+typedef void (Tk_ItemCursorProc)(Tk_Canvas canvas, Tk_Item *itemPtr,
+ int index);
+typedef int (Tk_ItemSelectionProc)(Tk_Canvas canvas, Tk_Item *itemPtr,
+ int offset, char *buffer, int maxBytes);
+#ifdef USE_OLD_CANVAS
+typedef void (Tk_ItemInsertProc)(Tk_Canvas canvas, Tk_Item *itemPtr,
+ int beforeThis, char *string);
+#else
+typedef void (Tk_ItemInsertProc)(Tk_Canvas canvas, Tk_Item *itemPtr,
+ int beforeThis, Tcl_Obj *string);
+#endif /* USE_OLD_CANVAS */
+typedef void (Tk_ItemDCharsProc)(Tk_Canvas canvas, Tk_Item *itemPtr,
+ int first, int last);
+
+#ifndef __NO_OLD_CONFIG
+
+typedef struct Tk_ItemType {
+ CONST86 char *name; /* The name of this type of item, such as
+ * "line". */
+ int itemSize; /* Total amount of space needed for item's
+ * record. */
+ Tk_ItemCreateProc *createProc;
+ /* Procedure to create a new item of this
+ * type. */
+ CONST86 Tk_ConfigSpec *configSpecs; /* Pointer to array of configuration specs for
+ * this type. Used for returning configuration
+ * info. */
+ Tk_ItemConfigureProc *configProc;
+ /* Procedure to call to change configuration
+ * options. */
+ Tk_ItemCoordProc *coordProc;/* Procedure to call to get and set the item's
+ * coordinates. */
+ Tk_ItemDeleteProc *deleteProc;
+ /* Procedure to delete existing item of this
+ * type. */
+ Tk_ItemDisplayProc *displayProc;
+ /* Procedure to display items of this type. */
+ int alwaysRedraw; /* Non-zero means displayProc should be called
+ * even when the item has been moved
+ * off-screen. */
+ Tk_ItemPointProc *pointProc;/* Computes distance from item to a given
+ * point. */
+ Tk_ItemAreaProc *areaProc; /* Computes whether item is inside, outside,
+ * or overlapping an area. */
+ Tk_ItemPostscriptProc *postscriptProc;
+ /* Procedure to write a Postscript description
+ * for items of this type. */
+ Tk_ItemScaleProc *scaleProc;/* Procedure to rescale items of this type. */
+ Tk_ItemTranslateProc *translateProc;
+ /* Procedure to translate items of this
+ * type. */
+ Tk_ItemIndexProc *indexProc;/* Procedure to determine index of indicated
+ * character. NULL if item doesn't support
+ * indexing. */
+ Tk_ItemCursorProc *icursorProc;
+ /* Procedure to set insert cursor posn to just
+ * before a given position. */
+ Tk_ItemSelectionProc *selectionProc;
+ /* Procedure to return selection (in STRING
+ * format) when it is in this item. */
+ Tk_ItemInsertProc *insertProc;
+ /* Procedure to insert something into an
+ * item. */
+ Tk_ItemDCharsProc *dCharsProc;
+ /* Procedure to delete characters from an
+ * item. */
+ struct Tk_ItemType *nextPtr;/* Used to link types together into a list. */
+ char *reserved1; /* Reserved for future extension. */
+ int reserved2; /* Carefully compatible with */
+ char *reserved3; /* Jan Nijtmans dash patch */
+ char *reserved4;
+} Tk_ItemType;
+
+/*
+ * Flag (used in the alwaysRedraw field) to say whether an item supports
+ * point-level manipulation like the line and polygon items.
+ */
+
+#define TK_MOVABLE_POINTS 2
+
+#endif /* __NO_OLD_CONFIG */
+
+/*
+ * The following structure provides information about the selection and the
+ * insertion cursor. It is needed by only a few items, such as those that
+ * display text. It is shared by the generic canvas code and the item-specific
+ * code, but most of the fields should be written only by the canvas generic
+ * code.
+ */
+
+typedef struct Tk_CanvasTextInfo {
+ Tk_3DBorder selBorder; /* Border and background for selected
+ * characters. Read-only to items.*/
+ int selBorderWidth; /* Width of border around selection. Read-only
+ * to items. */
+ XColor *selFgColorPtr; /* Foreground color for selected text.
+ * Read-only to items. */
+ Tk_Item *selItemPtr; /* Pointer to selected item. NULL means
+ * selection isn't in this canvas. Writable by
+ * items. */
+ int selectFirst; /* Character index of first selected
+ * character. Writable by items. */
+ int selectLast; /* Character index of last selected character.
+ * Writable by items. */
+ Tk_Item *anchorItemPtr; /* Item corresponding to "selectAnchor": not
+ * necessarily selItemPtr. Read-only to
+ * items. */
+ int selectAnchor; /* Character index of fixed end of selection
+ * (i.e. "select to" operation will use this
+ * as one end of the selection). Writable by
+ * items. */
+ Tk_3DBorder insertBorder; /* Used to draw vertical bar for insertion
+ * cursor. Read-only to items. */
+ int insertWidth; /* Total width of insertion cursor. Read-only
+ * to items. */
+ int insertBorderWidth; /* Width of 3-D border around insert cursor.
+ * Read-only to items. */
+ Tk_Item *focusItemPtr; /* Item that currently has the input focus, or
+ * NULL if no such item. Read-only to items. */
+ int gotFocus; /* Non-zero means that the canvas widget has
+ * the input focus. Read-only to items.*/
+ int cursorOn; /* Non-zero means that an insertion cursor
+ * should be displayed in focusItemPtr.
+ * Read-only to items.*/
+} Tk_CanvasTextInfo;
+
+/*
+ * Structures used for Dashing and Outline.
+ */
+
+typedef struct Tk_Dash {
+ int number;
+ union {
+ char *pt;
+ char array[sizeof(char *)];
+ } pattern;
+} Tk_Dash;
+
+typedef struct Tk_TSOffset {
+ int flags; /* Flags; see below for possible values */
+ int xoffset; /* x offset */
+ int yoffset; /* y offset */
+} Tk_TSOffset;
+
+/*
+ * Bit fields in Tk_Offset->flags:
+ */
+
+#define TK_OFFSET_INDEX 1
+#define TK_OFFSET_RELATIVE 2
+#define TK_OFFSET_LEFT 4
+#define TK_OFFSET_CENTER 8
+#define TK_OFFSET_RIGHT 16
+#define TK_OFFSET_TOP 32
+#define TK_OFFSET_MIDDLE 64
+#define TK_OFFSET_BOTTOM 128
+
+typedef struct Tk_Outline {
+ GC gc; /* Graphics context. */
+ double width; /* Width of outline. */
+ double activeWidth; /* Width of outline. */
+ double disabledWidth; /* Width of outline. */
+ int offset; /* Dash offset. */
+ Tk_Dash dash; /* Dash pattern. */
+ Tk_Dash activeDash; /* Dash pattern if state is active. */
+ Tk_Dash disabledDash; /* Dash pattern if state is disabled. */
+ void *reserved1; /* Reserved for future expansion. */
+ void *reserved2;
+ void *reserved3;
+ Tk_TSOffset tsoffset; /* Stipple offset for outline. */
+ XColor *color; /* Outline color. */
+ XColor *activeColor; /* Outline color if state is active. */
+ XColor *disabledColor; /* Outline color if state is disabled. */
+ Pixmap stipple; /* Outline Stipple pattern. */
+ Pixmap activeStipple; /* Outline Stipple pattern if state is
+ * active. */
+ Pixmap disabledStipple; /* Outline Stipple pattern if state is
+ * disabled. */
+} Tk_Outline;
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Procedure prototypes and structures used for managing images:
+ *
+ *----------------------------------------------------------------------
+ */
+
+typedef struct Tk_ImageType Tk_ImageType;
+#ifdef USE_OLD_IMAGE
+typedef int (Tk_ImageCreateProc) (Tcl_Interp *interp, char *name, int argc,
+ char **argv, Tk_ImageType *typePtr, Tk_ImageMaster master,
+ ClientData *masterDataPtr);
+#else
+typedef int (Tk_ImageCreateProc) (Tcl_Interp *interp, CONST86 char *name, int objc,
+ Tcl_Obj *const objv[], CONST86 Tk_ImageType *typePtr, Tk_ImageMaster master,
+ ClientData *masterDataPtr);
+#endif /* USE_OLD_IMAGE */
+typedef ClientData (Tk_ImageGetProc) (Tk_Window tkwin, ClientData masterData);
+typedef void (Tk_ImageDisplayProc) (ClientData instanceData, Display *display,
+ Drawable drawable, int imageX, int imageY, int width, int height,
+ int drawableX, int drawableY);
+typedef void (Tk_ImageFreeProc) (ClientData instanceData, Display *display);
+typedef void (Tk_ImageDeleteProc) (ClientData masterData);
+typedef void (Tk_ImageChangedProc) (ClientData clientData, int x, int y,
+ int width, int height, int imageWidth, int imageHeight);
+typedef int (Tk_ImagePostscriptProc) (ClientData clientData,
+ Tcl_Interp *interp, Tk_Window tkwin, Tk_PostscriptInfo psinfo,
+ int x, int y, int width, int height, int prepass);
+
+/*
+ * The following structure represents a particular type of image (bitmap, xpm
+ * image, etc.). It provides information common to all images of that type,
+ * such as the type name and a collection of procedures in the image manager
+ * that respond to various events. Each image manager is represented by one of
+ * these structures.
+ */
+
+struct Tk_ImageType {
+ CONST86 char *name; /* Name of image type. */
+ Tk_ImageCreateProc *createProc;
+ /* Procedure to call to create a new image of
+ * this type. */
+ Tk_ImageGetProc *getProc; /* Procedure to call the first time
+ * Tk_GetImage is called in a new way (new
+ * visual or screen). */
+ Tk_ImageDisplayProc *displayProc;
+ /* Call to draw image, in response to
+ * Tk_RedrawImage calls. */
+ Tk_ImageFreeProc *freeProc; /* Procedure to call whenever Tk_FreeImage is
+ * called to release an instance of an
+ * image. */
+ Tk_ImageDeleteProc *deleteProc;
+ /* Procedure to call to delete image. It will
+ * not be called until after freeProc has been
+ * called for each instance of the image. */
+ Tk_ImagePostscriptProc *postscriptProc;
+ /* Procedure to call to produce postscript
+ * output for the image. */
+ struct Tk_ImageType *nextPtr;
+ /* Next in list of all image types currently
+ * known. Filled in by Tk, not by image
+ * manager. */
+ char *reserved; /* reserved for future expansion */
+};
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Additional definitions used to manage images of type "photo".
+ *
+ *----------------------------------------------------------------------
+ */
+
+/*
+ * The following type is used to identify a particular photo image to be
+ * manipulated:
+ */
+
+typedef void *Tk_PhotoHandle;
+
+/*
+ * The following structure describes a block of pixels in memory:
+ */
+
+typedef struct Tk_PhotoImageBlock {
+ unsigned char *pixelPtr; /* Pointer to the first pixel. */
+ int width; /* Width of block, in pixels. */
+ int height; /* Height of block, in pixels. */
+ int pitch; /* Address difference between corresponding
+ * pixels in successive lines. */
+ int pixelSize; /* Address difference between successive
+ * pixels in the same line. */
+ int offset[4]; /* Address differences between the red, green,
+ * blue and alpha components of the pixel and
+ * the pixel as a whole. */
+} Tk_PhotoImageBlock;
+
+/*
+ * The following values control how blocks are combined into photo images when
+ * the alpha component of a pixel is not 255, a.k.a. the compositing rule.
+ */
+
+#define TK_PHOTO_COMPOSITE_OVERLAY 0
+#define TK_PHOTO_COMPOSITE_SET 1
+
+/*
+ * Procedure prototypes and structures used in reading and writing photo
+ * images:
+ */
+
+typedef struct Tk_PhotoImageFormat Tk_PhotoImageFormat;
+#ifdef USE_OLD_IMAGE
+typedef int (Tk_ImageFileMatchProc) (Tcl_Channel chan, char *fileName,
+ char *formatString, int *widthPtr, int *heightPtr);
+typedef int (Tk_ImageStringMatchProc) (char *string, char *formatString,
+ int *widthPtr, int *heightPtr);
+typedef int (Tk_ImageFileReadProc) (Tcl_Interp *interp, Tcl_Channel chan,
+ char *fileName, char *formatString, Tk_PhotoHandle imageHandle,
+ int destX, int destY, int width, int height, int srcX, int srcY);
+typedef int (Tk_ImageStringReadProc) (Tcl_Interp *interp, char *string,
+ char *formatString, Tk_PhotoHandle imageHandle, int destX, int destY,
+ int width, int height, int srcX, int srcY);
+typedef int (Tk_ImageFileWriteProc) (Tcl_Interp *interp, char *fileName,
+ char *formatString, Tk_PhotoImageBlock *blockPtr);
+typedef int (Tk_ImageStringWriteProc) (Tcl_Interp *interp,
+ Tcl_DString *dataPtr, char *formatString, Tk_PhotoImageBlock *blockPtr);
+#else
+typedef int (Tk_ImageFileMatchProc) (Tcl_Channel chan, const char *fileName,
+ Tcl_Obj *format, int *widthPtr, int *heightPtr, Tcl_Interp *interp);
+typedef int (Tk_ImageStringMatchProc) (Tcl_Obj *dataObj, Tcl_Obj *format,
+ int *widthPtr, int *heightPtr, Tcl_Interp *interp);
+typedef int (Tk_ImageFileReadProc) (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) (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) (Tcl_Interp *interp, const char *fileName,
+ Tcl_Obj *format, Tk_PhotoImageBlock *blockPtr);
+typedef int (Tk_ImageStringWriteProc) (Tcl_Interp *interp, Tcl_Obj *format,
+ Tk_PhotoImageBlock *blockPtr);
+#endif /* USE_OLD_IMAGE */
+
+/*
+ * The following structure represents a particular file format for storing
+ * images (e.g., PPM, GIF, JPEG, etc.). It provides information to allow image
+ * files of that format to be recognized and read into a photo image.
+ */
+
+struct Tk_PhotoImageFormat {
+ CONST86 char *name; /* Name of image file format */
+ Tk_ImageFileMatchProc *fileMatchProc;
+ /* Procedure to call to determine whether an
+ * image file matches this format. */
+ Tk_ImageStringMatchProc *stringMatchProc;
+ /* Procedure to call to determine whether the
+ * data in a string matches this format. */
+ Tk_ImageFileReadProc *fileReadProc;
+ /* Procedure to call to read data from an
+ * image file into a photo image. */
+ Tk_ImageStringReadProc *stringReadProc;
+ /* Procedure to call to read data from a
+ * string into a photo image. */
+ Tk_ImageFileWriteProc *fileWriteProc;
+ /* Procedure to call to write data from a
+ * photo image to a file. */
+ Tk_ImageStringWriteProc *stringWriteProc;
+ /* Procedure to call to obtain a string
+ * representation of the data in a photo
+ * image.*/
+ struct Tk_PhotoImageFormat *nextPtr;
+ /* Next in list of all photo image formats
+ * currently known. Filled in by Tk, not by
+ * image format handler. */
+};
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Procedure prototypes and structures used for managing styles:
+ *
+ *----------------------------------------------------------------------
+ */
+
+/*
+ * Style support version tag.
+ */
+
+#define TK_STYLE_VERSION_1 0x1
+#define TK_STYLE_VERSION TK_STYLE_VERSION_1
+
+/*
+ * The following structures and prototypes are used as static templates to
+ * declare widget elements.
+ */
+
+typedef void (Tk_GetElementSizeProc) (ClientData clientData, char *recordPtr,
+ const Tk_OptionSpec **optionsPtr, Tk_Window tkwin, int width,
+ int height, int inner, int *widthPtr, int *heightPtr);
+typedef void (Tk_GetElementBoxProc) (ClientData clientData, char *recordPtr,
+ const Tk_OptionSpec **optionsPtr, Tk_Window tkwin, int x, int y,
+ int width, int height, int inner, int *xPtr, int *yPtr, int *widthPtr,
+ int *heightPtr);
+typedef int (Tk_GetElementBorderWidthProc) (ClientData clientData,
+ char *recordPtr, const Tk_OptionSpec **optionsPtr, Tk_Window tkwin);
+typedef void (Tk_DrawElementProc) (ClientData clientData, char *recordPtr,
+ const Tk_OptionSpec **optionsPtr, Tk_Window tkwin, Drawable d, int x,
+ int y, int width, int height, int state);
+
+typedef struct Tk_ElementOptionSpec {
+ char *name; /* Name of the required option. */
+ Tk_OptionType type; /* Accepted option type. TK_OPTION_END means
+ * any. */
+} Tk_ElementOptionSpec;
+
+typedef struct Tk_ElementSpec {
+ int version; /* Version of the style support. */
+ char *name; /* Name of element. */
+ Tk_ElementOptionSpec *options;
+ /* List of required options. Last one's name
+ * must be NULL. */
+ Tk_GetElementSizeProc *getSize;
+ /* Compute the external (resp. internal) size
+ * of the element from its desired internal
+ * (resp. external) size. */
+ Tk_GetElementBoxProc *getBox;
+ /* Compute the inscribed or bounding boxes
+ * within a given area. */
+ Tk_GetElementBorderWidthProc *getBorderWidth;
+ /* Return the element's internal border width.
+ * Mostly useful for widgets. */
+ Tk_DrawElementProc *draw; /* Draw the element in the given bounding
+ * box. */
+} Tk_ElementSpec;
+
+/*
+ * Element state flags. Can be OR'ed.
+ */
+
+#define TK_ELEMENT_STATE_ACTIVE 1<<0
+#define TK_ELEMENT_STATE_DISABLED 1<<1
+#define TK_ELEMENT_STATE_FOCUS 1<<2
+#define TK_ELEMENT_STATE_PRESSED 1<<3
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * The definitions below provide backward compatibility for functions and
+ * types related to event handling that used to be in Tk but have moved to
+ * Tcl.
+ *
+ *----------------------------------------------------------------------
+ */
+
+#define TK_READABLE TCL_READABLE
+#define TK_WRITABLE TCL_WRITABLE
+#define TK_EXCEPTION TCL_EXCEPTION
+
+#define TK_DONT_WAIT TCL_DONT_WAIT
+#define TK_X_EVENTS TCL_WINDOW_EVENTS
+#define TK_WINDOW_EVENTS TCL_WINDOW_EVENTS
+#define TK_FILE_EVENTS TCL_FILE_EVENTS
+#define TK_TIMER_EVENTS TCL_TIMER_EVENTS
+#define TK_IDLE_EVENTS TCL_IDLE_EVENTS
+#define TK_ALL_EVENTS TCL_ALL_EVENTS
+
+#define Tk_IdleProc Tcl_IdleProc
+#define Tk_FileProc Tcl_FileProc
+#define Tk_TimerProc Tcl_TimerProc
+#define Tk_TimerToken Tcl_TimerToken
+
+#define Tk_BackgroundError Tcl_BackgroundError
+#define Tk_CancelIdleCall Tcl_CancelIdleCall
+#define Tk_CreateFileHandler Tcl_CreateFileHandler
+#define Tk_CreateTimerHandler Tcl_CreateTimerHandler
+#define Tk_DeleteFileHandler Tcl_DeleteFileHandler
+#define Tk_DeleteTimerHandler Tcl_DeleteTimerHandler
+#define Tk_DoOneEvent Tcl_DoOneEvent
+#define Tk_DoWhenIdle Tcl_DoWhenIdle
+#define Tk_Sleep Tcl_Sleep
+
+/* Additional stuff that has moved to Tcl: */
+
+#define Tk_EventuallyFree Tcl_EventuallyFree
+#define Tk_FreeProc Tcl_FreeProc
+#define Tk_Preserve Tcl_Preserve
+#define Tk_Release Tcl_Release
+
+/* Removed Tk_Main, use macro instead */
+#if defined(_WIN32) || defined(__CYGWIN__)
+#define Tk_Main(argc, argv, proc) Tk_MainEx(argc, argv, proc, \
+ (Tcl_FindExecutable(0), (Tcl_CreateInterp)()))
+#else
+#define Tk_Main(argc, argv, proc) Tk_MainEx(argc, argv, proc, \
+ (Tcl_FindExecutable(argv[0]), (Tcl_CreateInterp)()))
+#endif
+const char * Tk_InitStubs(Tcl_Interp *interp, const char *version,
+ int exact);
+EXTERN const char * Tk_PkgInitStubsCheck(Tcl_Interp *interp,
+ const char *version, int exact);
+
+#ifndef USE_TK_STUBS
+#define Tk_InitStubs(interp, version, exact) \
+ Tk_PkgInitStubsCheck(interp, version, exact)
+#endif /* USE_TK_STUBS */
+
+#define Tk_InitImageArgs(interp, argc, argv) /**/
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Additional procedure types defined by Tk.
+ *
+ *----------------------------------------------------------------------
+ */
+
+typedef int (Tk_ErrorProc) (ClientData clientData, XErrorEvent *errEventPtr);
+typedef void (Tk_EventProc) (ClientData clientData, XEvent *eventPtr);
+typedef int (Tk_GenericProc) (ClientData clientData, XEvent *eventPtr);
+typedef int (Tk_ClientMessageProc) (Tk_Window tkwin, XEvent *eventPtr);
+typedef int (Tk_GetSelProc) (ClientData clientData, Tcl_Interp *interp,
+ CONST86 char *portion);
+typedef void (Tk_LostSelProc) (ClientData clientData);
+typedef Tk_RestrictAction (Tk_RestrictProc) (ClientData clientData,
+ XEvent *eventPtr);
+typedef int (Tk_SelectionProc) (ClientData clientData, int offset,
+ char *buffer, int maxBytes);
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Platform independent exported procedures and variables.
+ *
+ *----------------------------------------------------------------------
+ */
+
+#include "tkDecls.h"
+
+#ifdef USE_OLD_IMAGE
+#undef Tk_CreateImageType
+#define Tk_CreateImageType Tk_CreateOldImageType
+#undef Tk_CreatePhotoImageFormat
+#define Tk_CreatePhotoImageFormat Tk_CreateOldPhotoImageFormat
+#endif /* USE_OLD_IMAGE */
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Allow users to say that they don't want to alter their source to add extra
+ * arguments to Tk_PhotoPutBlock() et al; DO NOT DEFINE THIS WHEN BUILDING TK.
+ *
+ * This goes after the inclusion of the stubbed-decls so that the declarations
+ * of what is actually there can be correct.
+ */
+
+#ifdef USE_COMPOSITELESS_PHOTO_PUT_BLOCK
+# ifdef Tk_PhotoPutBlock
+# undef Tk_PhotoPutBlock
+# endif
+# define Tk_PhotoPutBlock Tk_PhotoPutBlock_NoComposite
+# ifdef Tk_PhotoPutZoomedBlock
+# undef Tk_PhotoPutZoomedBlock
+# endif
+# define Tk_PhotoPutZoomedBlock Tk_PhotoPutZoomedBlock_NoComposite
+# define USE_PANIC_ON_PHOTO_ALLOC_FAILURE
+#else /* !USE_COMPOSITELESS_PHOTO_PUT_BLOCK */
+# ifdef USE_PANIC_ON_PHOTO_ALLOC_FAILURE
+# ifdef Tk_PhotoPutBlock
+# undef Tk_PhotoPutBlock
+# endif
+# define Tk_PhotoPutBlock Tk_PhotoPutBlock_Panic
+# ifdef Tk_PhotoPutZoomedBlock
+# undef Tk_PhotoPutZoomedBlock
+# endif
+# define Tk_PhotoPutZoomedBlock Tk_PhotoPutZoomedBlock_Panic
+# endif /* USE_PANIC_ON_PHOTO_ALLOC_FAILURE */
+#endif /* USE_COMPOSITELESS_PHOTO_PUT_BLOCK */
+#ifdef USE_PANIC_ON_PHOTO_ALLOC_FAILURE
+# ifdef Tk_PhotoExpand
+# undef Tk_PhotoExpand
+# endif
+# define Tk_PhotoExpand Tk_PhotoExpand_Panic
+# ifdef Tk_PhotoSetSize
+# undef Tk_PhotoSetSize
+# endif
+# define Tk_PhotoSetSize Tk_PhotoSetSize_Panic
+#endif /* USE_PANIC_ON_PHOTO_ALLOC_FAILURE */
+
+#undef TCL_STORAGE_CLASS
+#define TCL_STORAGE_CLASS DLLIMPORT
+
+#endif /* RC_INVOKED */
+
+/*
+ * end block for C++
+ */
+
+#ifdef __cplusplus
+}
+#endif
+
+#endif /* _TK */
+
+/*
+ * Local Variables:
+ * mode: c
+ * c-basic-offset: 4
+ * fill-column: 78
+ * End:
+ */
diff --git a/tk8.6/generic/tk3d.c b/tk8.6/generic/tk3d.c
new file mode 100644
index 0000000..87ddf76
--- /dev/null
+++ b/tk8.6/generic/tk3d.c
@@ -0,0 +1,1398 @@
+/*
+ * tk3d.c --
+ *
+ * This module provides procedures to draw borders in the
+ * three-dimensional Motif style.
+ *
+ * Copyright (c) 1990-1994 The Regents of the University of California.
+ * Copyright (c) 1994-1997 Sun Microsystems, Inc.
+ *
+ * See the file "license.terms" for information on usage and redistribution of
+ * this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ */
+
+#include "tkInt.h"
+#include "tk3d.h"
+
+/*
+ * The following table defines the string values for reliefs, which are used
+ * by Tk_GetReliefFromObj.
+ */
+
+static const char *const reliefStrings[] = {
+ "flat", "groove", "raised", "ridge", "solid", "sunken", NULL
+};
+
+/*
+ * Forward declarations for functions defined in this file:
+ */
+
+static void BorderInit(TkDisplay *dispPtr);
+static void DupBorderObjProc(Tcl_Obj *srcObjPtr,
+ Tcl_Obj *dupObjPtr);
+static void FreeBorderObj(Tcl_Obj *objPtr);
+static void FreeBorderObjProc(Tcl_Obj *objPtr);
+static int Intersect(XPoint *a1Ptr, XPoint *a2Ptr,
+ XPoint *b1Ptr, XPoint *b2Ptr, XPoint *iPtr);
+static void InitBorderObj(Tcl_Obj *objPtr);
+static void ShiftLine(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.
+ */
+
+const Tcl_ObjType tkBorderObjType = {
+ "border", /* name */
+ FreeBorderObjProc, /* freeIntRepProc */
+ DupBorderObjProc, /* dupIntRepProc */
+ NULL, /* updateStringProc */
+ NULL /* setFromAnyProc */
+};
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_Alloc3DBorderFromObj --
+ *
+ * Given a Tcl_Obj *, map the value to a corresponding Tk_3DBorder
+ * structure based on the tkwin given.
+ *
+ * Results:
+ * The return value is a token for a data structure describing a 3-D
+ * border. This token may be passed to functions 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 function, there should eventually be a call to
+ * FreeBorderObj so that the database is cleaned up when borders aren't
+ * in use anymore.
+ *
+ *----------------------------------------------------------------------
+ */
+
+Tk_3DBorder
+Tk_Alloc3DBorderFromObj(
+ Tcl_Interp *interp, /* Interp for error results. */
+ Tk_Window tkwin, /* Need the screen the border is used on.*/
+ Tcl_Obj *objPtr) /* Object giving name of color for window
+ * background. */
+{
+ TkBorder *borderPtr;
+
+ if (objPtr->typePtr != &tkBorderObjType) {
+ InitBorderObj(objPtr);
+ }
+ borderPtr = 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.
+ */
+
+ FreeBorderObj(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 = Tcl_GetHashValue(borderPtr->hashPtr);
+
+ FreeBorderObj(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 = 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 = borderPtr;
+ if (borderPtr != NULL) {
+ borderPtr->objRefCount++;
+ }
+ return (Tk_3DBorder) borderPtr;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * Tk_Get3DBorder --
+ *
+ * Create a data structure for displaying a 3-D border.
+ *
+ * Results:
+ * The return value is a token for a data structure describing a 3-D
+ * border. This token may be passed to functions such as
+ * Tk_Draw3DRectangle and Tk_Free3DBorder. If an error prevented the
+ * border from being created then NULL is returned and an error message
+ * will be left in the interp's result.
+ *
+ * Side effects:
+ * Data structures, graphics contexts, etc. are allocated. It is the
+ * caller's responsibility to eventually call Tk_Free3DBorder to release
+ * the resources.
+ *
+ *--------------------------------------------------------------
+ */
+
+Tk_3DBorder
+Tk_Get3DBorder(
+ Tcl_Interp *interp, /* Place to store an error message. */
+ Tk_Window tkwin, /* Token for window in which border will be
+ * drawn. */
+ Tk_Uid colorName) /* String giving name of color for window
+ * background. */
+{
+ Tcl_HashEntry *hashPtr;
+ TkBorder *borderPtr, *existingBorderPtr;
+ int isNew;
+ XGCValues gcValues;
+ XColor *bgColorPtr;
+ TkDisplay *dispPtr;
+
+ dispPtr = ((TkWindow *) tkwin)->dispPtr;
+
+ if (!dispPtr->borderInit) {
+ BorderInit(dispPtr);
+ }
+
+ hashPtr = Tcl_CreateHashEntry(&dispPtr->borderTable, colorName, &isNew);
+ if (!isNew) {
+ existingBorderPtr = Tcl_GetHashValue(hashPtr);
+ for (borderPtr = existingBorderPtr; borderPtr != NULL;
+ borderPtr = borderPtr->nextPtr) {
+ if ((Tk_Screen(tkwin) == borderPtr->screen)
+ && (Tk_Colormap(tkwin) == borderPtr->colormap)) {
+ borderPtr->resourceRefCount++;
+ return (Tk_3DBorder) borderPtr;
+ }
+ }
+ } else {
+ existingBorderPtr = NULL;
+ }
+
+ /*
+ * No satisfactory border exists yet. Initialize a new one.
+ */
+
+ bgColorPtr = Tk_GetColor(interp, tkwin, colorName);
+ if (bgColorPtr == NULL) {
+ if (isNew) {
+ Tcl_DeleteHashEntry(hashPtr);
+ }
+ return NULL;
+ }
+
+ borderPtr = TkpGetBorder();
+ borderPtr->screen = Tk_Screen(tkwin);
+ borderPtr->visual = Tk_Visual(tkwin);
+ borderPtr->depth = Tk_Depth(tkwin);
+ borderPtr->colormap = Tk_Colormap(tkwin);
+ borderPtr->resourceRefCount = 1;
+ borderPtr->objRefCount = 0;
+ borderPtr->bgColorPtr = bgColorPtr;
+ borderPtr->darkColorPtr = NULL;
+ borderPtr->lightColorPtr = NULL;
+ borderPtr->shadow = None;
+ borderPtr->bgGC = None;
+ borderPtr->darkGC = None;
+ borderPtr->lightGC = None;
+ borderPtr->hashPtr = hashPtr;
+ borderPtr->nextPtr = existingBorderPtr;
+ Tcl_SetHashValue(hashPtr, borderPtr);
+
+ /*
+ * Create the information for displaying the background color, but delay
+ * the allocation of shadows until they are actually needed for drawing.
+ */
+
+ gcValues.foreground = borderPtr->bgColorPtr->pixel;
+ borderPtr->bgGC = Tk_GetGC(tkwin, GCForeground, &gcValues);
+ return (Tk_3DBorder) borderPtr;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * Tk_Draw3DRectangle --
+ *
+ * Draw a 3-D border at a given place in a given window.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * A 3-D border will be drawn in the indicated drawable. The outside
+ * edges of the border will be determined by x, y, width, and height. The
+ * inside edges of the border will be determined by the borderWidth
+ * argument.
+ *
+ *--------------------------------------------------------------
+ */
+
+void
+Tk_Draw3DRectangle(
+ Tk_Window tkwin, /* Window for which border was allocated. */
+ Drawable drawable, /* X window or pixmap in which to draw. */
+ Tk_3DBorder border, /* Token for border to draw. */
+ int x, int y, int width, int height,
+ /* Outside area of region in which border will
+ * be drawn. */
+ int borderWidth, /* Desired width for border, in pixels. */
+ int relief) /* Type of relief: TK_RELIEF_RAISED,
+ * TK_RELIEF_SUNKEN, TK_RELIEF_GROOVE, etc. */
+{
+ if (width < 2*borderWidth) {
+ borderWidth = width/2;
+ }
+ if (height < 2*borderWidth) {
+ borderWidth = height/2;
+ }
+ Tk_3DVerticalBevel(tkwin, drawable, border, x, y, borderWidth, height,
+ 1, relief);
+ Tk_3DVerticalBevel(tkwin, drawable, border, x+width-borderWidth, y,
+ borderWidth, height, 0, relief);
+ Tk_3DHorizontalBevel(tkwin, drawable, border, x, y, width, borderWidth,
+ 1, 1, 1, relief);
+ Tk_3DHorizontalBevel(tkwin, drawable, border, x, y+height-borderWidth,
+ width, borderWidth, 0, 0, 0, relief);
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * Tk_NameOf3DBorder --
+ *
+ * Given a border, return a textual string identifying the border's
+ * color.
+ *
+ * Results:
+ * The return value is the string that was used to create the border.
+ *
+ * Side effects:
+ * None.
+ *
+ *--------------------------------------------------------------
+ */
+
+const char *
+Tk_NameOf3DBorder(
+ Tk_3DBorder border) /* Token for border. */
+{
+ TkBorder *borderPtr = (TkBorder *) border;
+
+ return borderPtr->hashPtr->key.string;
+}
+
+/*
+ *--------------------------------------------------------------------
+ *
+ * Tk_3DBorderColor --
+ *
+ * Given a 3D border, return the X color used for the "flat" surfaces.
+ *
+ * Results:
+ * Returns the color used drawing flat surfaces with the border.
+ *
+ * Side effects:
+ * None.
+ *
+ *--------------------------------------------------------------------
+ */
+XColor *
+Tk_3DBorderColor(
+ Tk_3DBorder border) /* Border whose color is wanted. */
+{
+ return ((TkBorder *) border)->bgColorPtr;
+}
+
+/*
+ *--------------------------------------------------------------------
+ *
+ * Tk_3DBorderGC --
+ *
+ * Given a 3D border, returns one of the graphics contexts used to draw
+ * the border.
+ *
+ * Results:
+ * Returns the graphics context given by the "which" argument.
+ *
+ * Side effects:
+ * None.
+ *
+ *--------------------------------------------------------------------
+ */
+GC
+Tk_3DBorderGC(
+ Tk_Window tkwin, /* Window for which border was allocated. */
+ Tk_3DBorder border, /* Border whose GC is wanted. */
+ int which) /* Selects one of the border's 3 GC's:
+ * TK_3D_FLAT_GC, TK_3D_LIGHT_GC, or
+ * TK_3D_DARK_GC. */
+{
+ TkBorder * borderPtr = (TkBorder *) border;
+
+ if ((borderPtr->lightGC == None) && (which != TK_3D_FLAT_GC)) {
+ TkpGetShadows(borderPtr, tkwin);
+ }
+ if (which == TK_3D_FLAT_GC) {
+ return borderPtr->bgGC;
+ } else if (which == TK_3D_LIGHT_GC) {
+ return borderPtr->lightGC;
+ } else if (which == TK_3D_DARK_GC){
+ return borderPtr->darkGC;
+ }
+ Tcl_Panic("bogus \"which\" value in Tk_3DBorderGC");
+
+ /*
+ * The code below will never be executed, but it's needed to keep
+ * compilers happy.
+ */
+
+ return (GC) None;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * Tk_Free3DBorder --
+ *
+ * This function is called when a 3D border is no longer needed. It frees
+ * the resources associated with the border. After this call, the caller
+ * should never again use the "border" token.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Resources are freed.
+ *
+ *--------------------------------------------------------------
+ */
+
+void
+Tk_Free3DBorder(
+ Tk_3DBorder border) /* Token for border to be released. */
+{
+ TkBorder *borderPtr = (TkBorder *) border;
+ Display *display = DisplayOfScreen(borderPtr->screen);
+ TkBorder *prevPtr;
+
+ borderPtr->resourceRefCount--;
+ if (borderPtr->resourceRefCount > 0) {
+ return;
+ }
+
+ prevPtr = Tcl_GetHashValue(borderPtr->hashPtr);
+ TkpFreeBorder(borderPtr);
+ if (borderPtr->bgColorPtr != NULL) {
+ Tk_FreeColor(borderPtr->bgColorPtr);
+ }
+ if (borderPtr->darkColorPtr != NULL) {
+ Tk_FreeColor(borderPtr->darkColorPtr);
+ }
+ if (borderPtr->lightColorPtr != NULL) {
+ Tk_FreeColor(borderPtr->lightColorPtr);
+ }
+ if (borderPtr->shadow != None) {
+ Tk_FreeBitmap(display, borderPtr->shadow);
+ }
+ if (borderPtr->bgGC != None) {
+ Tk_FreeGC(display, borderPtr->bgGC);
+ }
+ if (borderPtr->darkGC != None) {
+ Tk_FreeGC(display, borderPtr->darkGC);
+ }
+ if (borderPtr->lightGC != None) {
+ Tk_FreeGC(display, borderPtr->lightGC);
+ }
+ if (prevPtr == borderPtr) {
+ if (borderPtr->nextPtr == NULL) {
+ Tcl_DeleteHashEntry(borderPtr->hashPtr);
+ } else {
+ Tcl_SetHashValue(borderPtr->hashPtr, borderPtr->nextPtr);
+ }
+ } else {
+ while (prevPtr->nextPtr != borderPtr) {
+ prevPtr = prevPtr->nextPtr;
+ }
+ prevPtr->nextPtr = borderPtr->nextPtr;
+ }
+ if (borderPtr->objRefCount == 0) {
+ ckfree(borderPtr);
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_Free3DBorderFromObj --
+ *
+ * This function 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(
+ 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));
+ FreeBorderObj(objPtr);
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * FreeBorderObjProc, FreeBorderObj --
+ *
+ * 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(
+ Tcl_Obj *objPtr) /* The object we are releasing. */
+{
+ FreeBorderObj(objPtr);
+ objPtr->typePtr = NULL;
+}
+
+static void
+FreeBorderObj(
+ Tcl_Obj *objPtr) /* The object we are releasing. */
+{
+ TkBorder *borderPtr = objPtr->internalRep.twoPtrValue.ptr1;
+
+ if (borderPtr != NULL) {
+ borderPtr->objRefCount--;
+ if ((borderPtr->objRefCount == 0)
+ && (borderPtr->resourceRefCount == 0)) {
+ ckfree(borderPtr);
+ }
+ objPtr->internalRep.twoPtrValue.ptr1 = 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(
+ Tcl_Obj *srcObjPtr, /* The object we are copying from. */
+ Tcl_Obj *dupObjPtr) /* The object we are copying to. */
+{
+ TkBorder *borderPtr = srcObjPtr->internalRep.twoPtrValue.ptr1;
+
+ dupObjPtr->typePtr = srcObjPtr->typePtr;
+ dupObjPtr->internalRep.twoPtrValue.ptr1 = borderPtr;
+
+ if (borderPtr != NULL) {
+ borderPtr->objRefCount++;
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_SetBackgroundFromBorder --
+ *
+ * Change the background of a window to one appropriate for a given 3-D
+ * border.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Tkwin's background gets modified.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tk_SetBackgroundFromBorder(
+ Tk_Window tkwin, /* Window whose background is to be set. */
+ Tk_3DBorder border) /* Token for border. */
+{
+ register TkBorder *borderPtr = (TkBorder *) border;
+
+ Tk_SetWindowBackground(tkwin, borderPtr->bgColorPtr->pixel);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_GetReliefFromObj --
+ *
+ * Return an integer value based on the value of the objPtr.
+ *
+ * Results:
+ * The return value is a standard Tcl result. If an error occurs during
+ * conversion, an error message is left in the interpreter's result
+ * unless "interp" is NULL.
+ *
+ * Side effects:
+ * The object gets converted by Tcl_GetIndexFromObj.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tk_GetReliefFromObj(
+ 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_GetIndexFromObjStruct(interp, objPtr, reliefStrings,
+ sizeof(char *), "relief", 0, resultPtr);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_GetRelief --
+ *
+ * Parse a relief description and return the corresponding relief value,
+ * or an error.
+ *
+ * Results:
+ * A standard Tcl return value. If all goes well then *reliefPtr is
+ * filled in with one of the values TK_RELIEF_RAISED, TK_RELIEF_FLAT, or
+ * TK_RELIEF_SUNKEN.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tk_GetRelief(
+ Tcl_Interp *interp, /* For error messages. */
+ const char *name, /* Name of a relief type. */
+ int *reliefPtr) /* Where to store converted relief. */
+{
+ char c;
+ size_t length;
+
+ c = name[0];
+ length = strlen(name);
+ if ((c == 'f') && (strncmp(name, "flat", length) == 0)) {
+ *reliefPtr = TK_RELIEF_FLAT;
+ } else if ((c == 'g') && (strncmp(name, "groove", length) == 0)
+ && (length >= 2)) {
+ *reliefPtr = TK_RELIEF_GROOVE;
+ } else if ((c == 'r') && (strncmp(name, "raised", length) == 0)
+ && (length >= 2)) {
+ *reliefPtr = TK_RELIEF_RAISED;
+ } else if ((c == 'r') && (strncmp(name, "ridge", length) == 0)) {
+ *reliefPtr = TK_RELIEF_RIDGE;
+ } else if ((c == 's') && (strncmp(name, "solid", length) == 0)) {
+ *reliefPtr = TK_RELIEF_SOLID;
+ } else if ((c == 's') && (strncmp(name, "sunken", length) == 0)) {
+ *reliefPtr = TK_RELIEF_SUNKEN;
+ } else {
+ Tcl_SetObjResult(interp,
+ Tcl_ObjPrintf("bad relief \"%.50s\": must be %s",
+ name, "flat, groove, raised, ridge, solid, or sunken"));
+ Tcl_SetErrorCode(interp, "TK", "VALUE", "RELIEF", NULL);
+ return TCL_ERROR;
+ }
+ return TCL_OK;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * Tk_NameOfRelief --
+ *
+ * Given a relief value, produce a string describing that relief value.
+ *
+ * Results:
+ * The return value is a static string that is equivalent to relief.
+ *
+ * Side effects:
+ * None.
+ *
+ *--------------------------------------------------------------
+ */
+
+const char *
+Tk_NameOfRelief(
+ int relief) /* One of TK_RELIEF_FLAT, TK_RELIEF_RAISED, or
+ * TK_RELIEF_SUNKEN. */
+{
+ if (relief == TK_RELIEF_FLAT) {
+ return "flat";
+ } else if (relief == TK_RELIEF_SUNKEN) {
+ return "sunken";
+ } else if (relief == TK_RELIEF_RAISED) {
+ return "raised";
+ } else if (relief == TK_RELIEF_GROOVE) {
+ return "groove";
+ } else if (relief == TK_RELIEF_RIDGE) {
+ return "ridge";
+ } else if (relief == TK_RELIEF_SOLID) {
+ return "solid";
+ } else if (relief == TK_RELIEF_NULL) {
+ return "";
+ } else {
+ return "unknown relief";
+ }
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * Tk_Draw3DPolygon --
+ *
+ * Draw a border with 3-D appearance around the edge of a given polygon.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Information is drawn in "drawable" in the form of a 3-D border
+ * borderWidth units width wide on the left of the trajectory given by
+ * pointPtr and numPoints (or -borderWidth units wide on the right side,
+ * if borderWidth is negative).
+ *
+ *--------------------------------------------------------------
+ */
+
+void
+Tk_Draw3DPolygon(
+ Tk_Window tkwin, /* Window for which border was allocated. */
+ Drawable drawable, /* X window or pixmap in which to draw. */
+ Tk_3DBorder border, /* Token for border to draw. */
+ XPoint *pointPtr, /* Array of points describing polygon. All
+ * points must be absolute
+ * (CoordModeOrigin). */
+ int numPoints, /* Number of points at *pointPtr. */
+ int borderWidth, /* Width of border, measured in pixels to the
+ * left of the polygon's trajectory. May be
+ * negative. */
+ int leftRelief) /* TK_RELIEF_RAISED or TK_RELIEF_SUNKEN:
+ * indicates how stuff to left of trajectory
+ * looks relative to stuff on right. */
+{
+ XPoint poly[4], b1, b2, newB1, newB2;
+ XPoint perp, c, shift1, shift2; /* Used for handling parallel lines. */
+ register XPoint *p1Ptr, *p2Ptr;
+ TkBorder *borderPtr = (TkBorder *) border;
+ GC gc;
+ int i, lightOnLeft, dx, dy, parallel, pointsSeen;
+ Display *display = Tk_Display(tkwin);
+
+ if (borderPtr->lightGC == None) {
+ TkpGetShadows(borderPtr, tkwin);
+ }
+
+ /*
+ * Handle grooves and ridges with recursive calls.
+ */
+
+ if ((leftRelief == TK_RELIEF_GROOVE) || (leftRelief == TK_RELIEF_RIDGE)) {
+ int halfWidth = borderWidth/2;
+
+ Tk_Draw3DPolygon(tkwin, drawable, border, pointPtr, numPoints,
+ halfWidth, (leftRelief == TK_RELIEF_GROOVE) ? TK_RELIEF_RAISED
+ : TK_RELIEF_SUNKEN);
+ Tk_Draw3DPolygon(tkwin, drawable, border, pointPtr, numPoints,
+ -halfWidth, (leftRelief == TK_RELIEF_GROOVE) ? TK_RELIEF_SUNKEN
+ : TK_RELIEF_RAISED);
+ return;
+ }
+
+ /*
+ * If the polygon is already closed, drop the last point from it (we'll
+ * close it automatically).
+ */
+
+ p1Ptr = &pointPtr[numPoints-1];
+ p2Ptr = &pointPtr[0];
+ if ((p1Ptr->x == p2Ptr->x) && (p1Ptr->y == p2Ptr->y)) {
+ numPoints--;
+ }
+
+ /*
+ * The loop below is executed once for each vertex in the polgon. At the
+ * beginning of each iteration things look like this:
+ *
+ * poly[1] /
+ * * /
+ * | /
+ * b1 * poly[0] (pointPtr[i-1])
+ * | |
+ * | |
+ * | |
+ * | |
+ * | |
+ * | | *p1Ptr *p2Ptr
+ * b2 *--------------------*
+ * |
+ * |
+ * x-------------------------
+ *
+ * The job of this iteration is to do the following:
+ * (a) Compute x (the border corner corresponding to pointPtr[i]) and put
+ * it in poly[2]. As part of this, compute a new b1 and b2 value for
+ * the next side of the polygon.
+ * (b) Put pointPtr[i] into poly[3].
+ * (c) Draw the polygon given by poly[0..3].
+ * (d) Advance poly[0], poly[1], b1, and b2 for the next side of the
+ * polygon.
+ */
+
+ /*
+ * The above situation doesn't first come into existence until two points
+ * have been processed; the first two points are used to "prime the pump",
+ * so some parts of the processing are ommitted for these points. The
+ * variable "pointsSeen" keeps track of the priming process; it has to be
+ * separate from i in order to be able to ignore duplicate points in the
+ * polygon.
+ */
+
+ pointsSeen = 0;
+ for (i = -2, p1Ptr = &pointPtr[numPoints-2], p2Ptr = p1Ptr+1;
+ i < numPoints; i++, p1Ptr = p2Ptr, p2Ptr++) {
+ if ((i == -1) || (i == numPoints-1)) {
+ p2Ptr = pointPtr;
+ }
+ if ((p2Ptr->x == p1Ptr->x) && (p2Ptr->y == p1Ptr->y)) {
+ /*
+ * Ignore duplicate points (they'd cause core dumps in ShiftLine
+ * calls below).
+ */
+
+ continue;
+ }
+ ShiftLine(p1Ptr, p2Ptr, borderWidth, &newB1);
+ newB2.x = newB1.x + (p2Ptr->x - p1Ptr->x);
+ newB2.y = newB1.y + (p2Ptr->y - p1Ptr->y);
+ poly[3] = *p1Ptr;
+ parallel = 0;
+ if (pointsSeen >= 1) {
+ parallel = Intersect(&newB1, &newB2, &b1, &b2, &poly[2]);
+
+ /*
+ * If two consecutive segments of the polygon are parallel, then
+ * things get more complex. Consider the following diagram:
+ *
+ * poly[1]
+ * *----b1-----------b2------a
+ * \
+ * \
+ * *---------*----------* b
+ * poly[0] *p2Ptr *p1Ptr /
+ * /
+ * --*--------*----c
+ * newB1 newB2
+ *
+ * Instead of using x and *p1Ptr for poly[2] and poly[3], as in
+ * the original diagram, use a and b as above. Then instead of
+ * using x and *p1Ptr for the new poly[0] and poly[1], use b and c
+ * as above.
+ *
+ * Do the computation in three stages:
+ * 1. Compute a point "perp" such that the line p1Ptr-perp is
+ * perpendicular to p1Ptr-p2Ptr.
+ * 2. Compute the points a and c by intersecting the lines b1-b2
+ * and newB1-newB2 with p1Ptr-perp.
+ * 3. Compute b by shifting p1Ptr-perp to the right and
+ * intersecting it with p1Ptr-p2Ptr.
+ */
+
+ if (parallel) {
+ perp.x = p1Ptr->x + (p2Ptr->y - p1Ptr->y);
+ perp.y = p1Ptr->y - (p2Ptr->x - p1Ptr->x);
+ (void) Intersect(p1Ptr, &perp, &b1, &b2, &poly[2]);
+ (void) Intersect(p1Ptr, &perp, &newB1, &newB2, &c);
+ ShiftLine(p1Ptr, &perp, borderWidth, &shift1);
+ shift2.x = shift1.x + (perp.x - p1Ptr->x);
+ shift2.y = shift1.y + (perp.y - p1Ptr->y);
+ (void) Intersect(p1Ptr, p2Ptr, &shift1, &shift2, &poly[3]);
+ }
+ }
+ if (pointsSeen >= 2) {
+ dx = poly[3].x - poly[0].x;
+ dy = poly[3].y - poly[0].y;
+ if (dx > 0) {
+ lightOnLeft = (dy <= dx);
+ } else {
+ lightOnLeft = (dy < dx);
+ }
+ if (lightOnLeft ^ (leftRelief == TK_RELIEF_RAISED)) {
+ gc = borderPtr->lightGC;
+ } else {
+ gc = borderPtr->darkGC;
+ }
+ XFillPolygon(display, drawable, gc, poly, 4, Convex,
+ CoordModeOrigin);
+ }
+ b1.x = newB1.x;
+ b1.y = newB1.y;
+ b2.x = newB2.x;
+ b2.y = newB2.y;
+ poly[0].x = poly[3].x;
+ poly[0].y = poly[3].y;
+ if (parallel) {
+ poly[1].x = c.x;
+ poly[1].y = c.y;
+ } else if (pointsSeen >= 1) {
+ poly[1].x = poly[2].x;
+ poly[1].y = poly[2].y;
+ }
+ pointsSeen++;
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_Fill3DRectangle --
+ *
+ * Fill a rectangular area, supplying a 3D border if desired.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Information gets drawn on the screen.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tk_Fill3DRectangle(
+ Tk_Window tkwin, /* Window for which border was allocated. */
+ Drawable drawable, /* X window or pixmap in which to draw. */
+ Tk_3DBorder border, /* Token for border to draw. */
+ int x, int y, int width, int height,
+ /* Outside area of rectangular region. */
+ int borderWidth, /* Desired width for border, in pixels. Border
+ * will be *inside* region. */
+ int relief) /* Indicates 3D effect: TK_RELIEF_FLAT,
+ * TK_RELIEF_RAISED, or TK_RELIEF_SUNKEN. */
+{
+ register TkBorder *borderPtr = (TkBorder *) border;
+ int doubleBorder;
+
+ /*
+ * This code is slightly tricky because it only draws the background in
+ * areas not covered by the 3D border. This avoids flashing effects on the
+ * screen for the border region.
+ */
+
+ if (relief == TK_RELIEF_FLAT) {
+ borderWidth = 0;
+ } else {
+ /*
+ * We need to make this extra check, otherwise we will leave garbage
+ * in thin frames [Bug: 3596]
+ */
+
+ if (width < 2*borderWidth) {
+ borderWidth = width/2;
+ }
+ if (height < 2*borderWidth) {
+ borderWidth = height/2;
+ }
+ }
+ doubleBorder = 2*borderWidth;
+
+ if ((width > doubleBorder) && (height > doubleBorder)) {
+ XFillRectangle(Tk_Display(tkwin), drawable, borderPtr->bgGC,
+ x + borderWidth, y + borderWidth,
+ (unsigned) (width - doubleBorder),
+ (unsigned) (height - doubleBorder));
+ }
+ if (borderWidth) {
+ Tk_Draw3DRectangle(tkwin, drawable, border, x, y, width,
+ height, borderWidth, relief);
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_Fill3DPolygon --
+ *
+ * Fill a polygonal area, supplying a 3D border if desired.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Information gets drawn on the screen.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tk_Fill3DPolygon(
+ Tk_Window tkwin, /* Window for which border was allocated. */
+ Drawable drawable, /* X window or pixmap in which to draw. */
+ Tk_3DBorder border, /* Token for border to draw. */
+ XPoint *pointPtr, /* Array of points describing polygon. All
+ * points must be absolute
+ * (CoordModeOrigin). */
+ int numPoints, /* Number of points at *pointPtr. */
+ int borderWidth, /* Width of border, measured in pixels to the
+ * left of the polygon's trajectory. May be
+ * negative. */
+ int leftRelief) /* Indicates 3D effect of left side of
+ * trajectory relative to right:
+ * TK_RELIEF_FLAT, TK_RELIEF_RAISED, or
+ * TK_RELIEF_SUNKEN. */
+{
+ register TkBorder *borderPtr = (TkBorder *) border;
+
+ XFillPolygon(Tk_Display(tkwin), drawable, borderPtr->bgGC,
+ pointPtr, numPoints, Complex, CoordModeOrigin);
+ if (leftRelief != TK_RELIEF_FLAT) {
+ Tk_Draw3DPolygon(tkwin, drawable, border, pointPtr, numPoints,
+ borderWidth, leftRelief);
+ }
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * BorderInit --
+ *
+ * Initialize the structures used for border management.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Read the code.
+ *
+ *-------------------------------------------------------------
+ */
+
+static void
+BorderInit(
+ TkDisplay *dispPtr) /* Used to access thread-specific data. */
+{
+ dispPtr->borderInit = 1;
+ Tcl_InitHashTable(&dispPtr->borderTable, TCL_STRING_KEYS);
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * ShiftLine --
+ *
+ * Given two points on a line, compute a point on a new line that is
+ * parallel to the given line and a given distance away from it.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * None.
+ *
+ *--------------------------------------------------------------
+ */
+
+static void
+ShiftLine(
+ XPoint *p1Ptr, /* First point on line. */
+ XPoint *p2Ptr, /* Second point on line. */
+ int distance, /* New line is to be this many units to the
+ * left of original line, when looking from p1
+ * to p2. May be negative. */
+ XPoint *p3Ptr) /* Store coords of point on new line here. */
+{
+ int dx, dy, dxNeg, dyNeg;
+ static int shiftTable[129]; /* Used for a quick approximation in computing
+ * the new point. An index into the table is
+ * 128 times the slope of the original line
+ * (the slope must always be between 0 and 1).
+ * The value of the table entry is 128 times
+ * the amount to displace the new line in y
+ * for each unit of perpendicular distance. In
+ * other words, the table maps from the
+ * tangent of an angle to the inverse of its
+ * cosine. If the slope of the original line
+ * is greater than 1, then the displacement is
+ * done in x rather than in y. */
+
+ /*
+ * Initialize the table if this is the first time it is used.
+ */
+
+ if (shiftTable[0] == 0) {
+ int i;
+ double tangent, cosine;
+
+ for (i = 0; i <= 128; i++) {
+ tangent = i/128.0;
+ cosine = 128/cos(atan(tangent)) + .5;
+ shiftTable[i] = (int) cosine;
+ }
+ }
+
+ *p3Ptr = *p1Ptr;
+ dx = p2Ptr->x - p1Ptr->x;
+ dy = p2Ptr->y - p1Ptr->y;
+ if (dy < 0) {
+ dyNeg = 1;
+ dy = -dy;
+ } else {
+ dyNeg = 0;
+ }
+ if (dx < 0) {
+ dxNeg = 1;
+ dx = -dx;
+ } else {
+ dxNeg = 0;
+ }
+ if (dy <= dx) {
+ dy = ((distance * shiftTable[(dy<<7)/dx]) + 64) >> 7;
+ if (!dxNeg) {
+ dy = -dy;
+ }
+ p3Ptr->y += dy;
+ } else {
+ dx = ((distance * shiftTable[(dx<<7)/dy]) + 64) >> 7;
+ if (dyNeg) {
+ dx = -dx;
+ }
+ p3Ptr->x += dx;
+ }
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * Intersect --
+ *
+ * Find the intersection point between two lines.
+ *
+ * Results:
+ * Under normal conditions 0 is returned and the point at *iPtr is filled
+ * in with the intersection between the two lines. If the two lines are
+ * parallel, then -1 is returned and *iPtr isn't modified.
+ *
+ * Side effects:
+ * None.
+ *
+ *--------------------------------------------------------------
+ */
+
+static int
+Intersect(
+ XPoint *a1Ptr, /* First point of first line. */
+ XPoint *a2Ptr, /* Second point of first line. */
+ XPoint *b1Ptr, /* First point of second line. */
+ XPoint *b2Ptr, /* Second point of second line. */
+ XPoint *iPtr) /* Filled in with intersection point. */
+{
+ int dxadyb, dxbdya, dxadxb, dyadyb, p, q;
+
+ /*
+ * The code below is just a straightforward manipulation of two equations
+ * of the form y = (x-x1)*(y2-y1)/(x2-x1) + y1 to solve for the
+ * x-coordinate of intersection, then the y-coordinate.
+ */
+
+ dxadyb = (a2Ptr->x - a1Ptr->x)*(b2Ptr->y - b1Ptr->y);
+ dxbdya = (b2Ptr->x - b1Ptr->x)*(a2Ptr->y - a1Ptr->y);
+ dxadxb = (a2Ptr->x - a1Ptr->x)*(b2Ptr->x - b1Ptr->x);
+ dyadyb = (a2Ptr->y - a1Ptr->y)*(b2Ptr->y - b1Ptr->y);
+
+ if (dxadyb == dxbdya) {
+ return -1;
+ }
+ p = (a1Ptr->x*dxbdya - b1Ptr->x*dxadyb + (b1Ptr->y - a1Ptr->y)*dxadxb);
+ q = dxbdya - dxadyb;
+ if (q < 0) {
+ p = -p;
+ q = -q;
+ }
+ if (p < 0) {
+ iPtr->x = - ((-p + q/2)/q);
+ } else {
+ iPtr->x = (p + q/2)/q;
+ }
+ p = (a1Ptr->y*dxadyb - b1Ptr->y*dxbdya + (b1Ptr->x - a1Ptr->x)*dyadyb);
+ q = dxadyb - dxbdya;
+ if (q < 0) {
+ p = -p;
+ q = -q;
+ }
+ if (p < 0) {
+ iPtr->y = - ((-p + q/2)/q);
+ } else {
+ iPtr->y = (p + q/2)/q;
+ }
+ return 0;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_Get3DBorderFromObj --
+ *
+ * Returns the border referred to by a Tcl object. The border must
+ * already have been allocated via a call to Tk_Alloc3DBorderFromObj or
+ * Tk_Get3DBorder.
+ *
+ * Results:
+ * Returns the Tk_3DBorder that matches the tkwin and the string rep of
+ * the name of the border given in objPtr.
+ *
+ * Side effects:
+ * If the object is not already a border, the conversion will free any
+ * old internal representation.
+ *
+ *----------------------------------------------------------------------
+ */
+
+Tk_3DBorder
+Tk_Get3DBorderFromObj(
+ Tk_Window tkwin,
+ Tcl_Obj *objPtr) /* The object whose string value selects a
+ * border. */
+{
+ TkBorder *borderPtr = NULL;
+ Tcl_HashEntry *hashPtr;
+ TkDisplay *dispPtr = ((TkWindow *) tkwin)->dispPtr;
+
+ if (objPtr->typePtr != &tkBorderObjType) {
+ InitBorderObj(objPtr);
+ }
+
+ /*
+ * If we are lucky (and the user doesn't use too many different displays,
+ * screens, or colormaps...) then the TkBorder structure we need will be
+ * cached in the internal representation of the Tcl_Obj. Check it out...
+ */
+
+ borderPtr = 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 = Tcl_GetHashValue(hashPtr); borderPtr != NULL;
+ borderPtr = borderPtr->nextPtr) {
+ if ((Tk_Screen(tkwin) == borderPtr->screen)
+ && (Tk_Colormap(tkwin) == borderPtr->colormap)) {
+ FreeBorderObj(objPtr);
+ objPtr->internalRep.twoPtrValue.ptr1 = borderPtr;
+ borderPtr->objRefCount++;
+ return (Tk_3DBorder) borderPtr;
+ }
+ }
+
+ error:
+ Tcl_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(
+ Tcl_Obj *objPtr) /* The object to convert. */
+{
+ const Tcl_ObjType *typePtr;
+
+ /*
+ * Free the old internalRep before setting the new one.
+ */
+
+ Tcl_GetString(objPtr);
+ typePtr = objPtr->typePtr;
+ if ((typePtr != NULL) && (typePtr->freeIntRepProc != NULL)) {
+ typePtr->freeIntRepProc(objPtr);
+ }
+ objPtr->typePtr = &tkBorderObjType;
+ objPtr->internalRep.twoPtrValue.ptr1 = NULL;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkDebugBorder --
+ *
+ * This function 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(
+ Tk_Window tkwin, /* The window in which the border will be used
+ * (not currently used). */
+ const char *name) /* Name of the desired color. */
+{
+ Tcl_HashEntry *hashPtr;
+ Tcl_Obj *resultPtr;
+ TkDisplay *dispPtr = ((TkWindow *) tkwin)->dispPtr;
+
+ resultPtr = Tcl_NewObj();
+ hashPtr = Tcl_FindHashEntry(&dispPtr->borderTable, name);
+ if (hashPtr != NULL) {
+ TkBorder *borderPtr = Tcl_GetHashValue(hashPtr);
+
+ if (borderPtr == NULL) {
+ Tcl_Panic("TkDebugBorder found empty hash table entry");
+ }
+ for ( ; (borderPtr != NULL); borderPtr = borderPtr->nextPtr) {
+ Tcl_Obj *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;
+}
+
+/*
+ * Local Variables:
+ * mode: c
+ * c-basic-offset: 4
+ * fill-column: 78
+ * End:
+ */
diff --git a/tk8.6/generic/tk3d.h b/tk8.6/generic/tk3d.h
new file mode 100644
index 0000000..891e927
--- /dev/null
+++ b/tk8.6/generic/tk3d.h
@@ -0,0 +1,85 @@
+/*
+ * tk3d.h --
+ *
+ * Declarations of types and functions shared by the 3d border module.
+ *
+ * Copyright (c) 1996-1997 by Sun Microsystems, Inc.
+ *
+ * See the file "license.terms" for information on usage and redistribution of
+ * this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ */
+
+#ifndef _TK3D
+#define _TK3D
+
+#include "tkInt.h"
+
+/*
+ * One of the following data structures is allocated for each 3-D border
+ * currently in use. Structures of this type are indexed by borderTable, so
+ * that a single structure can be shared for several uses.
+ */
+
+typedef struct TkBorder {
+ Screen *screen; /* Screen on which the border will be used. */
+ Visual *visual; /* Visual for all windows and pixmaps using
+ * the border. */
+ int depth; /* Number of bits per pixel of drawables where
+ * the border will be used. */
+ Colormap colormap; /* Colormap out of which pixels are
+ * allocated. */
+ int resourceRefCount; /* Number of active uses of this color (each
+ * active use corresponds to a call to
+ * Tk_Alloc3DBorderFromObj or Tk_Get3DBorder).
+ * If this count is 0, then this structure is
+ * no longer valid and it isn't present in
+ * borderTable: it is being kept around only
+ * because there are objects referring to it.
+ * The structure is freed when objRefCount and
+ * resourceRefCount are both 0. */
+ int objRefCount; /* The number of Tcl objects that reference
+ * this structure. */
+ XColor *bgColorPtr; /* Background color (intensity between
+ * lightColorPtr and darkColorPtr). */
+ XColor *darkColorPtr; /* Color for darker areas (must free when
+ * deleting structure). NULL means shadows
+ * haven't been allocated yet.*/
+ XColor *lightColorPtr; /* Color used for lighter areas of border
+ * (must free this when deleting structure).
+ * NULL means shadows haven't been allocated
+ * yet. */
+ Pixmap shadow; /* Stipple pattern to use for drawing shadows
+ * areas. Used for displays with <= 64 colors
+ * or where colormap has filled up. */
+ GC bgGC; /* Used (if necessary) to draw areas in the
+ * background color. */
+ GC darkGC; /* Used to draw darker parts of the border.
+ * None means the shadow colors haven't been
+ * allocated yet.*/
+ GC lightGC; /* Used to draw lighter parts of the border.
+ * None means the shadow colors haven't been
+ * allocated yet. */
+ Tcl_HashEntry *hashPtr; /* Entry in borderTable (needed in order to
+ * delete structure). */
+ struct TkBorder *nextPtr; /* Points to the next TkBorder structure with
+ * the same color name. Borders with the same
+ * name but different screens or colormaps are
+ * chained together off a single entry in
+ * borderTable. */
+} TkBorder;
+
+/*
+ * Maximum intensity for a color:
+ */
+
+#define MAX_INTENSITY 65535
+
+/*
+ * Declarations for platform specific interfaces used by this module.
+ */
+
+MODULE_SCOPE TkBorder *TkpGetBorder(void);
+MODULE_SCOPE void TkpGetShadows(TkBorder *borderPtr, Tk_Window tkwin);
+MODULE_SCOPE void TkpFreeBorder(TkBorder *borderPtr);
+
+#endif /* _TK3D */
diff --git a/tk8.6/generic/tkArgv.c b/tk8.6/generic/tkArgv.c
new file mode 100644
index 0000000..6c2c5c5
--- /dev/null
+++ b/tk8.6/generic/tkArgv.c
@@ -0,0 +1,417 @@
+/*
+ * tkArgv.c --
+ *
+ * This file contains a function that handles table-based argv-argc
+ * parsing.
+ *
+ * Copyright (c) 1990-1994 The Regents of the University of California.
+ * Copyright (c) 1994-1997 Sun Microsystems, Inc.
+ *
+ * See the file "license.terms" for information on usage and redistribution of
+ * this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ */
+
+#include "tkInt.h"
+
+/*
+ * Default table of argument descriptors. These are normally available in
+ * every application.
+ */
+
+static const Tk_ArgvInfo defaultTable[] = {
+ {"-help", TK_ARGV_HELP, NULL, NULL,
+ "Print summary of command-line options and abort"},
+ {NULL, TK_ARGV_END, NULL, NULL, NULL}
+};
+
+/*
+ * Forward declarations for functions defined in this file:
+ */
+
+static void PrintUsage(Tcl_Interp *interp, const Tk_ArgvInfo *argTable,
+ int flags);
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_ParseArgv --
+ *
+ * Process an argv array according to a table of expected command-line
+ * options. See the manual page for more details.
+ *
+ * Results:
+ * The return value is a standard Tcl return value. If an error occurs
+ * then an error message is left in the interp's result. Under normal
+ * conditions, both *argcPtr and *argv are modified to return the
+ * arguments that couldn't be processed here (they didn't match the
+ * option table, or followed an TK_ARGV_REST argument).
+ *
+ * Side effects:
+ * Variables may be modified, resources may be entered for tkwin, or
+ * functions may be called. It all depends on the arguments and their
+ * entries in argTable. See the user documentation for details.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tk_ParseArgv(
+ Tcl_Interp *interp, /* Place to store error message. */
+ Tk_Window tkwin, /* Window to use for setting Tk options. NULL
+ * means ignore Tk option specs. */
+ int *argcPtr, /* Number of arguments in argv. Modified to
+ * hold # args left in argv at end. */
+ const char **argv, /* Array of arguments. Modified to hold those
+ * that couldn't be processed here. */
+ const Tk_ArgvInfo *argTable, /* Array of option descriptions */
+ int flags) /* Or'ed combination of various flag bits,
+ * such as TK_ARGV_NO_DEFAULTS. */
+{
+ register const Tk_ArgvInfo *infoPtr;
+ /* Pointer to the current entry in the table
+ * of argument descriptions. */
+ const Tk_ArgvInfo *matchPtr;/* Descriptor that matches current argument. */
+ const char *curArg; /* Current argument */
+ register char c; /* Second character of current arg (used for
+ * quick check for matching; use 2nd char.
+ * because first char. will almost always be
+ * '-'). */
+ int srcIndex; /* Location from which to read next argument
+ * from argv. */
+ int dstIndex; /* Index into argv to which next unused
+ * argument should be copied (never greater
+ * than srcIndex). */
+ int argc; /* # arguments in argv still to process. */
+ size_t length; /* Number of characters in current argument. */
+ char *endPtr; /* Used for identifying junk in arguments. */
+ int i;
+
+ if (flags & TK_ARGV_DONT_SKIP_FIRST_ARG) {
+ srcIndex = dstIndex = 0;
+ argc = *argcPtr;
+ } else {
+ srcIndex = dstIndex = 1;
+ argc = *argcPtr-1;
+ }
+
+ while (argc > 0) {
+ curArg = argv[srcIndex];
+ srcIndex++;
+ argc--;
+ length = strlen(curArg);
+ if (length > 0) {
+ c = curArg[1];
+ } else {
+ c = 0;
+ }
+
+ /*
+ * Loop throught the argument descriptors searching for one with the
+ * matching key string. If found, leave a pointer to it in matchPtr.
+ */
+
+ matchPtr = NULL;
+ for (i = 0; i < 2; i++) {
+ if (i == 0) {
+ infoPtr = argTable;
+ } else {
+ infoPtr = defaultTable;
+ }
+ for (; (infoPtr != NULL) && (infoPtr->type != TK_ARGV_END);
+ infoPtr++) {
+ if (infoPtr->key == NULL) {
+ continue;
+ }
+ if ((infoPtr->key[1] != c)
+ || (strncmp(infoPtr->key, curArg, length) != 0)) {
+ continue;
+ }
+ if ((tkwin == NULL)
+ && ((infoPtr->type == TK_ARGV_CONST_OPTION)
+ || (infoPtr->type == TK_ARGV_OPTION_VALUE)
+ || (infoPtr->type == TK_ARGV_OPTION_NAME_VALUE))) {
+ continue;
+ }
+ if (infoPtr->key[length] == 0) {
+ matchPtr = infoPtr;
+ goto gotMatch;
+ }
+ if (flags & TK_ARGV_NO_ABBREV) {
+ continue;
+ }
+ if (matchPtr != NULL) {
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "ambiguous option \"%s\"", curArg));
+ Tcl_SetErrorCode(interp, "TK", "ARG", "AMBIGUOUS", curArg,
+ NULL);
+ return TCL_ERROR;
+ }
+ matchPtr = infoPtr;
+ }
+ }
+ if (matchPtr == NULL) {
+ /*
+ * Unrecognized argument. Just copy it down, unless the caller
+ * prefers an error to be registered.
+ */
+
+ if (flags & TK_ARGV_NO_LEFTOVERS) {
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "unrecognized argument \"%s\"", curArg));
+ Tcl_SetErrorCode(interp, "TK", "ARG", "UNRECOGNIZED", curArg,
+ NULL);
+ return TCL_ERROR;
+ }
+ argv[dstIndex] = curArg;
+ dstIndex++;
+ continue;
+ }
+
+ /*
+ * Take the appropriate action based on the option type
+ */
+
+ gotMatch:
+ infoPtr = matchPtr;
+ switch (infoPtr->type) {
+ case TK_ARGV_CONSTANT:
+ *((int *) infoPtr->dst) = PTR2INT(infoPtr->src);
+ break;
+ case TK_ARGV_INT:
+ if (argc == 0) {
+ goto missingArg;
+ }
+ *((int *) infoPtr->dst) = strtol(argv[srcIndex], &endPtr, 0);
+ if ((endPtr == argv[srcIndex]) || (*endPtr != 0)) {
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "expected %s argument for \"%s\" but got \"%s\"",
+ "integer", infoPtr->key, argv[srcIndex]));
+ Tcl_SetErrorCode(interp, "TK", "ARG", "INTEGER", curArg,NULL);
+ return TCL_ERROR;
+ }
+ srcIndex++;
+ argc--;
+ break;
+ case TK_ARGV_STRING:
+ if (argc == 0) {
+ goto missingArg;
+ }
+ *((const char **) infoPtr->dst) = argv[srcIndex];
+ srcIndex++;
+ argc--;
+ break;
+ case TK_ARGV_UID:
+ if (argc == 0) {
+ goto missingArg;
+ }
+ *((Tk_Uid *) infoPtr->dst) = Tk_GetUid(argv[srcIndex]);
+ srcIndex++;
+ argc--;
+ break;
+ case TK_ARGV_REST:
+ *((int *) infoPtr->dst) = dstIndex;
+ goto argsDone;
+ case TK_ARGV_FLOAT:
+ if (argc == 0) {
+ goto missingArg;
+ }
+ *((double *) infoPtr->dst) = strtod(argv[srcIndex], &endPtr);
+ if ((endPtr == argv[srcIndex]) || (*endPtr != 0)) {
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "expected %s argument for \"%s\" but got \"%s\"",
+ "floating-point", infoPtr->key, argv[srcIndex]));
+ Tcl_SetErrorCode(interp, "TK", "ARG", "FLOAT", curArg, NULL);
+ return TCL_ERROR;
+ }
+ srcIndex++;
+ argc--;
+ break;
+ case TK_ARGV_FUNC: {
+ typedef int (ArgvFunc)(char *, const char *, const char *);
+ ArgvFunc *handlerProc = (ArgvFunc *) infoPtr->src;
+
+ if (handlerProc(infoPtr->dst, infoPtr->key, argv[srcIndex])) {
+ srcIndex++;
+ argc--;
+ }
+ break;
+ }
+ case TK_ARGV_GENFUNC: {
+ typedef int (ArgvGenFunc)(char *, Tcl_Interp *, const char *, int,
+ const char **);
+ ArgvGenFunc *handlerProc = (ArgvGenFunc *) infoPtr->src;
+
+ argc = handlerProc(infoPtr->dst, interp, infoPtr->key, argc,
+ argv+srcIndex);
+ if (argc < 0) {
+ return TCL_ERROR;
+ }
+ break;
+ }
+ case TK_ARGV_HELP:
+ PrintUsage(interp, argTable, flags);
+ Tcl_SetErrorCode(interp, "TK", "ARG", "HELP", NULL);
+ return TCL_ERROR;
+ case TK_ARGV_CONST_OPTION:
+ Tk_AddOption(tkwin, infoPtr->dst, infoPtr->src,
+ TK_INTERACTIVE_PRIO);
+ break;
+ case TK_ARGV_OPTION_VALUE:
+ if (argc < 1) {
+ goto missingArg;
+ }
+ Tk_AddOption(tkwin, infoPtr->dst, argv[srcIndex],
+ TK_INTERACTIVE_PRIO);
+ srcIndex++;
+ argc--;
+ break;
+ case TK_ARGV_OPTION_NAME_VALUE:
+ if (argc < 2) {
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "\"%s\" option requires two following arguments",
+ curArg));
+ Tcl_SetErrorCode(interp, "TK", "ARG", "NAME_VALUE", curArg,
+ NULL);
+ return TCL_ERROR;
+ }
+ Tk_AddOption(tkwin, argv[srcIndex], argv[srcIndex+1],
+ TK_INTERACTIVE_PRIO);
+ srcIndex += 2;
+ argc -= 2;
+ break;
+ default:
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "bad argument type %d in Tk_ArgvInfo", infoPtr->type));
+ Tcl_SetErrorCode(interp, "TK", "API_ABUSE", NULL);
+ return TCL_ERROR;
+ }
+ }
+
+ /*
+ * If we broke out of the loop because of an OPT_REST argument, copy the
+ * remaining arguments down.
+ */
+
+ argsDone:
+ while (argc) {
+ argv[dstIndex] = argv[srcIndex];
+ srcIndex++;
+ dstIndex++;
+ argc--;
+ }
+ argv[dstIndex] = NULL;
+ *argcPtr = dstIndex;
+ return TCL_OK;
+
+ missingArg:
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "\"%s\" option requires an additional argument", curArg));
+ Tcl_SetErrorCode(interp, "TK", "ARG", "MISSING", curArg, NULL);
+ return TCL_ERROR;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * PrintUsage --
+ *
+ * Generate a help string describing command-line options.
+ *
+ * Results:
+ * The interp's result will be modified to hold a help string describing
+ * all the options in argTable, plus all those in the default table
+ * unless TK_ARGV_NO_DEFAULTS is specified in flags.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+PrintUsage(
+ Tcl_Interp *interp, /* Place information in this interp's result
+ * area. */
+ const Tk_ArgvInfo *argTable,/* Array of command-specific argument
+ * descriptions. */
+ int flags) /* If the TK_ARGV_NO_DEFAULTS bit is set in
+ * this word, then don't generate information
+ * for default options. */
+{
+ register const Tk_ArgvInfo *infoPtr;
+ size_t width, i, numSpaces;
+ Tcl_Obj *message;
+
+ /*
+ * First, compute the width of the widest option key, so that we can make
+ * everything line up.
+ */
+
+ width = 4;
+ for (i = 0; i < 2; i++) {
+ for (infoPtr = i ? defaultTable : argTable;
+ infoPtr->type != TK_ARGV_END; infoPtr++) {
+ size_t length;
+
+ if (infoPtr->key == NULL) {
+ continue;
+ }
+ length = strlen(infoPtr->key);
+ if (length > width) {
+ width = length;
+ }
+ }
+ }
+
+ message = Tcl_NewStringObj("Command-specific options:", -1);
+ for (i = 0; ; i++) {
+ for (infoPtr = i ? defaultTable : argTable;
+ infoPtr->type != TK_ARGV_END; infoPtr++) {
+ if ((infoPtr->type == TK_ARGV_HELP) && (infoPtr->key == NULL)) {
+ Tcl_AppendPrintfToObj(message, "\n%s", infoPtr->help);
+ continue;
+ }
+ Tcl_AppendPrintfToObj(message, "\n %s:", infoPtr->key);
+ numSpaces = width + 1 - strlen(infoPtr->key);
+ while (numSpaces-- > 0) {
+ Tcl_AppendToObj(message, " ", 1);
+ }
+ Tcl_AppendToObj(message, infoPtr->help, -1);
+ switch (infoPtr->type) {
+ case TK_ARGV_INT:
+ Tcl_AppendPrintfToObj(message, "\n\t\tDefault value: %d",
+ *((int *) infoPtr->dst));
+ break;
+ case TK_ARGV_FLOAT:
+ Tcl_AppendPrintfToObj(message, "\n\t\tDefault value: %f",
+ *((double *) infoPtr->dst));
+ break;
+ case TK_ARGV_STRING: {
+ char *string = *((char **) infoPtr->dst);
+
+ if (string != NULL) {
+ Tcl_AppendPrintfToObj(message,
+ "\n\t\tDefault value: \"%s\"", string);
+ }
+ break;
+ }
+ default:
+ break;
+ }
+ }
+
+ if ((flags & TK_ARGV_NO_DEFAULTS) || (i > 0)) {
+ break;
+ }
+ Tcl_AppendToObj(message, "\nGeneric options for all commands:", -1);
+ }
+ Tcl_SetObjResult(interp, message);
+}
+
+/*
+ * Local Variables:
+ * mode: c
+ * c-basic-offset: 4
+ * fill-column: 78
+ * End:
+ */
diff --git a/tk8.6/generic/tkAtom.c b/tk8.6/generic/tkAtom.c
new file mode 100644
index 0000000..2491fb2
--- /dev/null
+++ b/tk8.6/generic/tkAtom.c
@@ -0,0 +1,215 @@
+/*
+ * tkAtom.c --
+ *
+ * This file manages a cache of X Atoms in order to avoid interactions
+ * with the X server. It's much like the Xmu routines, except it has a
+ * cleaner interface (caller doesn't have to provide permanent storage
+ * for atom names, for example).
+ *
+ * Copyright (c) 1990-1994 The Regents of the University of California.
+ * Copyright (c) 1994 Sun Microsystems, Inc.
+ *
+ * See the file "license.terms" for information on usage and redistribution of
+ * this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ */
+
+#include "tkInt.h"
+
+/*
+ * The following are a list of the predefined atom strings. They should match
+ * those found in xatom.h
+ */
+
+static const char *const atomNameArray[] = {
+ "PRIMARY", "SECONDARY", "ARC",
+ "ATOM", "BITMAP", "CARDINAL",
+ "COLORMAP", "CURSOR", "CUT_BUFFER0",
+ "CUT_BUFFER1", "CUT_BUFFER2", "CUT_BUFFER3",
+ "CUT_BUFFER4", "CUT_BUFFER5", "CUT_BUFFER6",
+ "CUT_BUFFER7", "DRAWABLE", "FONT",
+ "INTEGER", "PIXMAP", "POINT",
+ "RECTANGLE", "RESOURCE_MANAGER", "RGB_COLOR_MAP",
+ "RGB_BEST_MAP", "RGB_BLUE_MAP", "RGB_DEFAULT_MAP",
+ "RGB_GRAY_MAP", "RGB_GREEN_MAP", "RGB_RED_MAP",
+ "STRING", "VISUALID", "WINDOW",
+ "WM_COMMAND", "WM_HINTS", "WM_CLIENT_MACHINE",
+ "WM_ICON_NAME", "WM_ICON_SIZE", "WM_NAME",
+ "WM_NORMAL_HINTS", "WM_SIZE_HINTS", "WM_ZOOM_HINTS",
+ "MIN_SPACE", "NORM_SPACE", "MAX_SPACE",
+ "END_SPACE", "SUPERSCRIPT_X", "SUPERSCRIPT_Y",
+ "SUBSCRIPT_X", "SUBSCRIPT_Y", "UNDERLINE_POSITION",
+ "UNDERLINE_THICKNESS", "STRIKEOUT_ASCENT", "STRIKEOUT_DESCENT",
+ "ITALIC_ANGLE", "X_HEIGHT", "QUAD_WIDTH",
+ "WEIGHT", "POINT_SIZE", "RESOLUTION",
+ "COPYRIGHT", "NOTICE", "FONT_NAME",
+ "FAMILY_NAME", "FULL_NAME", "CAP_HEIGHT",
+ "WM_CLASS", "WM_TRANSIENT_FOR",
+ NULL
+};
+
+/*
+ * Forward references to functions defined in this file:
+ */
+
+static void AtomInit(TkDisplay *dispPtr);
+
+/*
+ *--------------------------------------------------------------
+ *
+ * Tk_InternAtom --
+ *
+ * Given a string, produce the equivalent X atom. This function is
+ * equivalent to XInternAtom, except that it keeps a local cache of
+ * atoms. Once a name is known, the server need not be contacted again
+ * for that name.
+ *
+ * Results:
+ * The return value is the Atom corresponding to name.
+ *
+ * Side effects:
+ * A new entry may be added to the local atom cache.
+ *
+ *--------------------------------------------------------------
+ */
+
+Atom
+Tk_InternAtom(
+ Tk_Window tkwin, /* Window token; map name to atom for this
+ * window's display. */
+ const char *name) /* Name to turn into atom. */
+{
+ TkDisplay *dispPtr;
+ Tcl_HashEntry *hPtr;
+ int isNew;
+
+ dispPtr = ((TkWindow *) tkwin)->dispPtr;
+ if (!dispPtr->atomInit) {
+ AtomInit(dispPtr);
+ }
+
+ hPtr = Tcl_CreateHashEntry(&dispPtr->nameTable, name, &isNew);
+ if (isNew) {
+ Tcl_HashEntry *hPtr2;
+ Atom atom;
+
+ atom = XInternAtom(dispPtr->display, name, False);
+ Tcl_SetHashValue(hPtr, INT2PTR(atom));
+ hPtr2 = Tcl_CreateHashEntry(&dispPtr->atomTable, INT2PTR(atom), &isNew);
+ Tcl_SetHashValue(hPtr2, Tcl_GetHashKey(&dispPtr->nameTable, hPtr));
+ }
+ return (Atom)PTR2INT(Tcl_GetHashValue(hPtr));
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * Tk_GetAtomName --
+ *
+ * This function is equivalent to XGetAtomName except that it uses the
+ * local atom cache to avoid contacting the server.
+ *
+ * Results:
+ * The return value is a character string corresponding to the atom given
+ * by "atom". This string's storage space is static: it need not be freed
+ * by the caller, and should not be modified by the caller. If "atom"
+ * doesn't exist on tkwin's display, then the string "?bad atom?" is
+ * returned.
+ *
+ * Side effects:
+ * None.
+ *
+ *--------------------------------------------------------------
+ */
+
+const char *
+Tk_GetAtomName(
+ Tk_Window tkwin, /* Window token; map atom to name relative to
+ * this window's display. */
+ Atom atom) /* Atom whose name is wanted. */
+{
+ TkDisplay *dispPtr;
+ Tcl_HashEntry *hPtr;
+
+ dispPtr = ((TkWindow *) tkwin)->dispPtr;
+ if (!dispPtr->atomInit) {
+ AtomInit(dispPtr);
+ }
+
+ hPtr = Tcl_FindHashEntry(&dispPtr->atomTable, INT2PTR(atom));
+ if (hPtr == NULL) {
+ const char *name;
+ Tk_ErrorHandler handler;
+ int isNew;
+ char *mustFree = NULL;
+
+ handler = Tk_CreateErrorHandler(dispPtr->display, BadAtom, -1, -1,
+ NULL, NULL);
+ name = mustFree = XGetAtomName(dispPtr->display, atom);
+ if (name == NULL) {
+ name = "?bad atom?";
+ }
+ Tk_DeleteErrorHandler(handler);
+ hPtr = Tcl_CreateHashEntry(&dispPtr->nameTable, name, &isNew);
+ Tcl_SetHashValue(hPtr, INT2PTR(atom));
+ if (mustFree) {
+ XFree(mustFree);
+ }
+ name = Tcl_GetHashKey(&dispPtr->nameTable, hPtr);
+ hPtr = Tcl_CreateHashEntry(&dispPtr->atomTable, INT2PTR(atom), &isNew);
+ Tcl_SetHashValue(hPtr, name);
+ }
+ return Tcl_GetHashValue(hPtr);
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * AtomInit --
+ *
+ * Initialize atom-related information for a display.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Tables get initialized, etc. etc..
+ *
+ *--------------------------------------------------------------
+ */
+
+static void
+AtomInit(
+ TkDisplay *dispPtr)/* Display to initialize. */
+{
+ Tcl_HashEntry *hPtr;
+ Atom atom;
+
+ dispPtr->atomInit = 1;
+ Tcl_InitHashTable(&dispPtr->nameTable, TCL_STRING_KEYS);
+ Tcl_InitHashTable(&dispPtr->atomTable, TCL_ONE_WORD_KEYS);
+
+ for (atom = 1; atom <= XA_LAST_PREDEFINED; atom++) {
+ const char *name;
+ int isNew;
+
+ hPtr = Tcl_FindHashEntry(&dispPtr->atomTable, INT2PTR(atom));
+ if (hPtr != NULL) {
+ continue;
+ }
+
+ name = atomNameArray[atom - 1];
+ hPtr = Tcl_CreateHashEntry(&dispPtr->nameTable, name, &isNew);
+ Tcl_SetHashValue(hPtr, INT2PTR(atom));
+ name = Tcl_GetHashKey(&dispPtr->nameTable, hPtr);
+ hPtr = Tcl_CreateHashEntry(&dispPtr->atomTable, INT2PTR(atom), &isNew);
+ Tcl_SetHashValue(hPtr, name);
+ }
+}
+
+/*
+ * Local Variables:
+ * mode: c
+ * c-basic-offset: 4
+ * fill-column: 78
+ * End:
+ */
diff --git a/tk8.6/generic/tkBind.c b/tk8.6/generic/tkBind.c
new file mode 100644
index 0000000..3b05066
--- /dev/null
+++ b/tk8.6/generic/tkBind.c
@@ -0,0 +1,4298 @@
+/*
+ * tkBind.c --
+ *
+ * This file provides functions that associate Tcl commands with X events
+ * or sequences of X events.
+ *
+ * Copyright (c) 1989-1994 The Regents of the University of California.
+ * Copyright (c) 1994-1997 Sun Microsystems, Inc.
+ * Copyright (c) 1998 by Scriptics Corporation.
+ *
+ * See the file "license.terms" for information on usage and redistribution of
+ * this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ */
+
+#include "tkInt.h"
+
+#ifdef _WIN32
+#include "tkWinInt.h"
+#elif defined(MAC_OSX_TK)
+#include "tkMacOSXInt.h"
+#else
+#include "tkUnixInt.h"
+#endif
+
+/*
+ * File structure:
+ *
+ * Structure definitions and static variables.
+ *
+ * Init/Free this package.
+ *
+ * Tcl "bind" command (actually located in tkCmds.c) core implementation, plus
+ * helpers.
+ *
+ * Tcl "event" command implementation, plus helpers.
+ *
+ * Package-specific common helpers.
+ *
+ * Non-package-specific helpers.
+ */
+
+/*
+ * The following union is used to hold the detail information from an XEvent
+ * (including Tk's XVirtualEvent extension).
+ */
+
+typedef union {
+ KeySym keySym; /* KeySym that corresponds to xkey.keycode. */
+ int button; /* Button that was pressed (xbutton.button). */
+ Tk_Uid name; /* Tk_Uid of virtual event. */
+ ClientData clientData; /* Used when type of Detail is unknown, and to
+ * ensure that all bytes of Detail are
+ * initialized when this structure is used in
+ * a hash key. */
+} Detail;
+
+/*
+ * The structure below represents a binding table. A binding table represents
+ * a domain in which event bindings may occur. It includes a space of objects
+ * relative to which events occur (usually windows, but not always), a history
+ * of recent events in the domain, and a set of mappings that associate
+ * particular Tcl commands with sequences of events in the domain. Multiple
+ * binding tables may exist at once, either because there are multiple
+ * applications open, or because there are multiple domains within an
+ * application with separate event bindings for each (for example, each canvas
+ * widget has a separate binding table for associating events with the items
+ * in the canvas).
+ *
+ * Note: it is probably a bad idea to reduce EVENT_BUFFER_SIZE much below 30.
+ * To see this, consider a triple mouse button click while the Shift key is
+ * down (and auto-repeating). There may be as many as 3 auto-repeat events
+ * after each mouse button press or release (see the first large comment block
+ * within Tk_BindEvent for more on this), for a total of 20 events to cover
+ * the three button presses and two intervening releases. If you reduce
+ * EVENT_BUFFER_SIZE too much, shift multi-clicks will be lost.
+ */
+
+#define EVENT_BUFFER_SIZE 30
+typedef struct Tk_BindingTable_ {
+ XEvent eventRing[EVENT_BUFFER_SIZE];
+ /* Circular queue of recent events (higher
+ * indices are for more recent events). */
+ Detail detailRing[EVENT_BUFFER_SIZE];
+ /* "Detail" information (keySym, button,
+ * Tk_Uid, or 0) for each entry in
+ * eventRing. */
+ int curEvent; /* Index in eventRing of most recent event.
+ * Newer events have higher indices. */
+ Tcl_HashTable patternTable; /* Used to map from an event to a list of
+ * patterns that may match that event. Keys
+ * are PatternTableKey structs, values are
+ * (PatSeq *). */
+ Tcl_HashTable objectTable; /* Used to map from an object to a list of
+ * patterns associated with that object. Keys
+ * are ClientData, values are (PatSeq *). */
+ Tcl_Interp *interp; /* Interpreter in which commands are
+ * executed. */
+} BindingTable;
+
+/*
+ * The following structure represents virtual event table. A virtual event
+ * table provides a way to map from platform-specific physical events such as
+ * button clicks or key presses to virtual events such as <<Paste>>,
+ * <<Close>>, or <<ScrollWindow>>.
+ *
+ * A virtual event is usually never part of the event stream, but instead is
+ * synthesized inline by matching low-level events. However, a virtual event
+ * may be generated by platform-specific code or by Tcl commands. In that case,
+ * no lookup of the virtual event will need to be done using this table,
+ * because the virtual event is actually in the event stream.
+ */
+
+typedef struct {
+ Tcl_HashTable patternTable; /* Used to map from a physical event to a list
+ * of patterns that may match that event. Keys
+ * are PatternTableKey structs, values are
+ * (PatSeq *). */
+ Tcl_HashTable nameTable; /* Used to map a virtual event name to the
+ * array of physical events that can trigger
+ * it. Keys are the Tk_Uid names of the
+ * virtual events, values are PhysicalsOwned
+ * structs. */
+} VirtualEventTable;
+
+/*
+ * The following structure is used as a key in a patternTable for both binding
+ * tables and a virtual event tables.
+ *
+ * In a binding table, the object field corresponds to the binding tag for the
+ * widget whose bindings are being accessed.
+ *
+ * In a virtual event table, the object field is always NULL. Virtual events
+ * are a global definiton and are not tied to a particular binding tag.
+ *
+ * The same key is used for both types of pattern tables so that the helper
+ * functions that traverse and match patterns will work for both binding
+ * tables and virtual event tables.
+ */
+
+typedef struct {
+ ClientData object; /* For binding table, identifies the binding
+ * tag of the object (or class of objects)
+ * relative to which the event occurred. For
+ * virtual event table, always NULL. */
+ int type; /* Type of event (from X). */
+ Detail detail; /* Additional information, such as keysym,
+ * button, Tk_Uid, or 0 if nothing
+ * additional. */
+} PatternTableKey;
+
+/*
+ * The following structure defines a pattern, which is matched against X
+ * events as part of the process of converting X events into Tcl commands.
+ */
+
+typedef struct {
+ int eventType; /* Type of X event, e.g. ButtonPress. */
+ int needMods; /* Mask of modifiers that must be present (0
+ * means no modifiers are required). */
+ Detail detail; /* Additional information that must match
+ * event. Normally this is 0, meaning no
+ * additional information must match. For
+ * KeyPress and KeyRelease events, a keySym
+ * may be specified to select a particular
+ * keystroke (0 means any keystrokes). For
+ * button events, specifies a particular
+ * button (0 means any buttons are OK). For
+ * virtual events, specifies the Tk_Uid of the
+ * virtual event name (never 0). */
+} TkPattern;
+
+/*
+ * The following structure defines a pattern sequence, which consists of one
+ * or more patterns. In order to trigger, a pattern sequence must match the
+ * most recent X events (first pattern to most recent event, next pattern to
+ * next event, and so on). It is used as the hash value in a patternTable for
+ * both binding tables and virtual event tables.
+ *
+ * In a binding table, it is the sequence of physical events that make up a
+ * binding for an object.
+ *
+ * In a virtual event table, it is the sequence of physical events that define
+ * a virtual event.
+ *
+ * The same structure is used for both types of pattern tables so that the
+ * helper functions that traverse and match patterns will work for both
+ * binding tables and virtual event tables.
+ */
+
+typedef struct PatSeq {
+ int numPats; /* Number of patterns in sequence (usually
+ * 1). */
+ char *script; /* Binding script to evaluate when sequence
+ * matches (ckalloc()ed) */
+ int flags; /* Miscellaneous flag values; see below for
+ * definitions. */
+ struct PatSeq *nextSeqPtr; /* Next in list of all pattern sequences that
+ * have the same initial pattern. NULL means
+ * end of list. */
+ Tcl_HashEntry *hPtr; /* Pointer to hash table entry for the initial
+ * pattern. This is the head of the list of
+ * which nextSeqPtr forms a part. */
+ struct VirtualOwners *voPtr;/* In a binding table, always NULL. In a
+ * virtual event table, identifies the array
+ * of virtual events that can be triggered by
+ * this event. */
+ struct PatSeq *nextObjPtr; /* In a binding table, next in list of all
+ * pattern sequences for the same object (NULL
+ * for end of list). Needed to implement
+ * Tk_DeleteAllBindings. In a virtual event
+ * table, always NULL. */
+ TkPattern pats[1]; /* Array of "numPats" patterns. Only one
+ * element is declared here but in actuality
+ * enough space will be allocated for
+ * "numPats" patterns. To match, pats[0] must
+ * match event n, pats[1] must match event
+ * n-1, etc. */
+} PatSeq;
+
+/*
+ * Flag values for PatSeq structures:
+ *
+ * PAT_NEARBY 1 means that all of the events matching this sequence
+ * must occur with nearby X and Y mouse coordinates and
+ * close in time. This is typically used to restrict
+ * multiple button presses.
+ */
+
+#define PAT_NEARBY 0x1
+
+/*
+ * Constants that define how close together two events must be in milliseconds
+ * or pixels to meet the PAT_NEARBY constraint:
+ */
+
+#define NEARBY_PIXELS 5
+#define NEARBY_MS 500
+
+/*
+ * The following structure keeps track of all the virtual events that are
+ * associated with a particular physical event. It is pointed to by the voPtr
+ * field in a PatSeq in the patternTable of a virtual event table.
+ */
+
+typedef struct VirtualOwners {
+ int numOwners; /* Number of virtual events to trigger. */
+ Tcl_HashEntry *owners[1]; /* Array of pointers to entries in nameTable.
+ * Enough space will actually be allocated for
+ * numOwners hash entries. */
+} VirtualOwners;
+
+/*
+ * The following structure is used in the nameTable of a virtual event table
+ * to associate a virtual event with all the physical events that can trigger
+ * it.
+ */
+typedef struct {
+ int numOwned; /* Number of physical events owned. */
+ PatSeq *patSeqs[1]; /* Array of pointers to physical event
+ * patterns. Enough space will actually be
+ * allocated to hold numOwned. */
+} PhysicalsOwned;
+
+/*
+ * One of the following structures exists for each interpreter. This structure
+ * keeps track of the current display and screen in the interpreter, so that a
+ * command can be invoked whenever the display/screen changes (the command does
+ * things like point tk::Priv at a display-specific structure).
+ */
+
+typedef struct {
+ TkDisplay *curDispPtr; /* Display for last binding command invoked in
+ * this application. */
+ int curScreenIndex; /* Index of screen for last binding command */
+ int bindingDepth; /* Number of active instances of Tk_BindEvent
+ * in this application. */
+} ScreenInfo;
+
+/*
+ * The following structure keeps track of all the information local to the
+ * binding package on a per interpreter basis.
+ */
+
+typedef struct TkBindInfo_ {
+ VirtualEventTable virtualEventTable;
+ /* The virtual events that exist in this
+ * interpreter. */
+ ScreenInfo screenInfo; /* Keeps track of the current display and
+ * screen, so it can be restored after a
+ * binding has executed. */
+ int deleted; /* 1 the application has been deleted but the
+ * structure has been preserved. */
+} BindInfo;
+
+/*
+ * In X11R4 and earlier versions, XStringToKeysym is ridiculously slow. The
+ * data structure and hash table below, along with the code that uses them,
+ * implement a fast mapping from strings to keysyms. In X11R5 and later
+ * releases XStringToKeysym is plenty fast so this stuff isn't needed. The
+ * #define REDO_KEYSYM_LOOKUP is normally undefined, so that XStringToKeysym
+ * gets used. It can be set in the Makefile to enable the use of the hash
+ * table below.
+ */
+
+#ifdef REDO_KEYSYM_LOOKUP
+typedef struct {
+ const char *name; /* Name of keysym. */
+ KeySym value; /* Numeric identifier for keysym. */
+} KeySymInfo;
+static const KeySymInfo keyArray[] = {
+#ifndef lint
+#include "ks_names.h"
+#endif
+ {NULL, 0}
+};
+static Tcl_HashTable keySymTable; /* keyArray hashed by keysym value. */
+static Tcl_HashTable nameTable; /* keyArray hashed by keysym name. */
+#endif /* REDO_KEYSYM_LOOKUP */
+
+/*
+ * Set to non-zero when the package-wide static variables have been
+ * initialized.
+ */
+
+static int initialized = 0;
+TCL_DECLARE_MUTEX(bindMutex)
+
+/*
+ * A hash table is kept to map from the string names of event modifiers to
+ * information about those modifiers. The structure for storing this
+ * information, and the hash table built at initialization time, are defined
+ * below.
+ */
+
+typedef struct {
+ const char *name; /* Name of modifier. */
+ int mask; /* Button/modifier mask value, such as
+ * Button1Mask. */
+ int flags; /* Various flags; see below for
+ * definitions. */
+} ModInfo;
+
+/*
+ * Flags for ModInfo structures:
+ *
+ * DOUBLE - Non-zero means duplicate this event,
+ * e.g. for double-clicks.
+ * TRIPLE - Non-zero means triplicate this event,
+ * e.g. for triple-clicks.
+ * QUADRUPLE - Non-zero means quadruple this event,
+ * e.g. for 4-fold-clicks.
+ * MULT_CLICKS - Combination of all of above.
+ */
+
+#define DOUBLE 1
+#define TRIPLE 2
+#define QUADRUPLE 4
+#define MULT_CLICKS 7
+
+static const ModInfo modArray[] = {
+ {"Control", ControlMask, 0},
+ {"Shift", ShiftMask, 0},
+ {"Lock", LockMask, 0},
+ {"Meta", META_MASK, 0},
+ {"M", META_MASK, 0},
+ {"Alt", ALT_MASK, 0},
+ {"Extended", EXTENDED_MASK, 0},
+ {"B1", Button1Mask, 0},
+ {"Button1", Button1Mask, 0},
+ {"B2", Button2Mask, 0},
+ {"Button2", Button2Mask, 0},
+ {"B3", Button3Mask, 0},
+ {"Button3", Button3Mask, 0},
+ {"B4", Button4Mask, 0},
+ {"Button4", Button4Mask, 0},
+ {"B5", Button5Mask, 0},
+ {"Button5", Button5Mask, 0},
+ {"Mod1", Mod1Mask, 0},
+ {"M1", Mod1Mask, 0},
+ {"Command", Mod1Mask, 0},
+ {"Mod2", Mod2Mask, 0},
+ {"M2", Mod2Mask, 0},
+ {"Option", Mod2Mask, 0},
+ {"Mod3", Mod3Mask, 0},
+ {"M3", Mod3Mask, 0},
+ {"Mod4", Mod4Mask, 0},
+ {"M4", Mod4Mask, 0},
+ {"Mod5", Mod5Mask, 0},
+ {"M5", Mod5Mask, 0},
+ {"Double", 0, DOUBLE},
+ {"Triple", 0, TRIPLE},
+ {"Quadruple", 0, QUADRUPLE},
+ {"Any", 0, 0}, /* Ignored: historical relic */
+ {NULL, 0, 0}
+};
+static Tcl_HashTable modTable;
+
+/*
+ * This module also keeps a hash table mapping from event names to information
+ * about those events. The structure, an array to use to initialize the hash
+ * table, and the hash table are all defined below.
+ */
+
+typedef struct {
+ const char *name; /* Name of event. */
+ int type; /* Event type for X, such as ButtonPress. */
+ int eventMask; /* Mask bits (for XSelectInput) for this event
+ * type. */
+} EventInfo;
+
+/*
+ * Note: some of the masks below are an OR-ed combination of several masks.
+ * This is necessary because X doesn't report up events unless you also ask
+ * for down events. Also, X doesn't report button state in motion events
+ * unless you've asked about button events.
+ */
+
+static const EventInfo eventArray[] = {
+ {"Key", KeyPress, KeyPressMask},
+ {"KeyPress", KeyPress, KeyPressMask},
+ {"KeyRelease", KeyRelease, KeyPressMask|KeyReleaseMask},
+ {"Button", ButtonPress, ButtonPressMask},
+ {"ButtonPress", ButtonPress, ButtonPressMask},
+ {"ButtonRelease", ButtonRelease,
+ ButtonPressMask|ButtonReleaseMask},
+ {"Motion", MotionNotify,
+ ButtonPressMask|PointerMotionMask},
+ {"Enter", EnterNotify, EnterWindowMask},
+ {"Leave", LeaveNotify, LeaveWindowMask},
+ {"FocusIn", FocusIn, FocusChangeMask},
+ {"FocusOut", FocusOut, FocusChangeMask},
+ {"Expose", Expose, ExposureMask},
+ {"Visibility", VisibilityNotify, VisibilityChangeMask},
+ {"Destroy", DestroyNotify, StructureNotifyMask},
+ {"Unmap", UnmapNotify, StructureNotifyMask},
+ {"Map", MapNotify, StructureNotifyMask},
+ {"Reparent", ReparentNotify, StructureNotifyMask},
+ {"Configure", ConfigureNotify, StructureNotifyMask},
+ {"Gravity", GravityNotify, StructureNotifyMask},
+ {"Circulate", CirculateNotify, StructureNotifyMask},
+ {"Property", PropertyNotify, PropertyChangeMask},
+ {"Colormap", ColormapNotify, ColormapChangeMask},
+ {"Activate", ActivateNotify, ActivateMask},
+ {"Deactivate", DeactivateNotify, ActivateMask},
+ {"MouseWheel", MouseWheelEvent, MouseWheelMask},
+ {"CirculateRequest", CirculateRequest, SubstructureRedirectMask},
+ {"ConfigureRequest", ConfigureRequest, SubstructureRedirectMask},
+ {"Create", CreateNotify, SubstructureNotifyMask},
+ {"MapRequest", MapRequest, SubstructureRedirectMask},
+ {"ResizeRequest", ResizeRequest, ResizeRedirectMask},
+ {NULL, 0, 0}
+};
+static Tcl_HashTable eventTable;
+
+/*
+ * The defines and table below are used to classify events into various
+ * groups. The reason for this is that logically identical fields (e.g.
+ * "state") appear at different places in different types of events. The
+ * classification masks can be used to figure out quickly where to extract
+ * information from events.
+ */
+
+#define KEY 0x1
+#define BUTTON 0x2
+#define MOTION 0x4
+#define CROSSING 0x8
+#define FOCUS 0x10
+#define EXPOSE 0x20
+#define VISIBILITY 0x40
+#define CREATE 0x80
+#define DESTROY 0x100
+#define UNMAP 0x200
+#define MAP 0x400
+#define REPARENT 0x800
+#define CONFIG 0x1000
+#define GRAVITY 0x2000
+#define CIRC 0x4000
+#define PROP 0x8000
+#define COLORMAP 0x10000
+#define VIRTUAL 0x20000
+#define ACTIVATE 0x40000
+#define MAPREQ 0x80000
+#define CONFIGREQ 0x100000
+#define RESIZEREQ 0x200000
+#define CIRCREQ 0x400000
+
+#define KEY_BUTTON_MOTION_VIRTUAL (KEY|BUTTON|MOTION|VIRTUAL)
+#define KEY_BUTTON_MOTION_CROSSING (KEY|BUTTON|MOTION|VIRTUAL|CROSSING)
+
+static const int flagArray[TK_LASTEVENT] = {
+ /* Not used */ 0,
+ /* Not used */ 0,
+ /* KeyPress */ KEY,
+ /* KeyRelease */ KEY,
+ /* ButtonPress */ BUTTON,
+ /* ButtonRelease */ BUTTON,
+ /* MotionNotify */ MOTION,
+ /* EnterNotify */ CROSSING,
+ /* LeaveNotify */ CROSSING,
+ /* FocusIn */ FOCUS,
+ /* FocusOut */ FOCUS,
+ /* KeymapNotify */ 0,
+ /* Expose */ EXPOSE,
+ /* GraphicsExpose */ EXPOSE,
+ /* NoExpose */ 0,
+ /* VisibilityNotify */ VISIBILITY,
+ /* CreateNotify */ CREATE,
+ /* DestroyNotify */ DESTROY,
+ /* UnmapNotify */ UNMAP,
+ /* MapNotify */ MAP,
+ /* MapRequest */ MAPREQ,
+ /* ReparentNotify */ REPARENT,
+ /* ConfigureNotify */ CONFIG,
+ /* ConfigureRequest */ CONFIGREQ,
+ /* GravityNotify */ GRAVITY,
+ /* ResizeRequest */ RESIZEREQ,
+ /* CirculateNotify */ CIRC,
+ /* CirculateRequest */ 0,
+ /* PropertyNotify */ PROP,
+ /* SelectionClear */ 0,
+ /* SelectionRequest */ 0,
+ /* SelectionNotify */ 0,
+ /* ColormapNotify */ COLORMAP,
+ /* ClientMessage */ 0,
+ /* MappingNotify */ 0,
+ /* VirtualEvent */ VIRTUAL,
+ /* Activate */ ACTIVATE,
+ /* Deactivate */ ACTIVATE,
+ /* MouseWheel */ KEY
+};
+
+/*
+ * The following table is used to map between the location where an generated
+ * event should be queued and the string used to specify the location.
+ */
+
+static const TkStateMap queuePosition[] = {
+ {-1, "now"},
+ {TCL_QUEUE_HEAD, "head"},
+ {TCL_QUEUE_MARK, "mark"},
+ {TCL_QUEUE_TAIL, "tail"},
+ {-2, NULL}
+};
+
+/*
+ * The following tables are used as a two-way map between X's internal numeric
+ * values for fields in an XEvent and the strings used in Tcl. The tables are
+ * used both when constructing an XEvent from user input and when providing
+ * data from an XEvent to the user.
+ */
+
+static const TkStateMap notifyMode[] = {
+ {NotifyNormal, "NotifyNormal"},
+ {NotifyGrab, "NotifyGrab"},
+ {NotifyUngrab, "NotifyUngrab"},
+ {NotifyWhileGrabbed, "NotifyWhileGrabbed"},
+ {-1, NULL}
+};
+
+static const TkStateMap notifyDetail[] = {
+ {NotifyAncestor, "NotifyAncestor"},
+ {NotifyVirtual, "NotifyVirtual"},
+ {NotifyInferior, "NotifyInferior"},
+ {NotifyNonlinear, "NotifyNonlinear"},
+ {NotifyNonlinearVirtual, "NotifyNonlinearVirtual"},
+ {NotifyPointer, "NotifyPointer"},
+ {NotifyPointerRoot, "NotifyPointerRoot"},
+ {NotifyDetailNone, "NotifyDetailNone"},
+ {-1, NULL}
+};
+
+static const TkStateMap circPlace[] = {
+ {PlaceOnTop, "PlaceOnTop"},
+ {PlaceOnBottom, "PlaceOnBottom"},
+ {-1, NULL}
+};
+
+static const TkStateMap visNotify[] = {
+ {VisibilityUnobscured, "VisibilityUnobscured"},
+ {VisibilityPartiallyObscured, "VisibilityPartiallyObscured"},
+ {VisibilityFullyObscured, "VisibilityFullyObscured"},
+ {-1, NULL}
+};
+
+static const TkStateMap configureRequestDetail[] = {
+ {None, "None"},
+ {Above, "Above"},
+ {Below, "Below"},
+ {BottomIf, "BottomIf"},
+ {TopIf, "TopIf"},
+ {Opposite, "Opposite"},
+ {-1, NULL}
+};
+
+static const TkStateMap propNotify[] = {
+ {PropertyNewValue, "NewValue"},
+ {PropertyDelete, "Delete"},
+ {-1, NULL}
+};
+
+/*
+ * Prototypes for local functions defined in this file:
+ */
+
+static void ChangeScreen(Tcl_Interp *interp, char *dispName,
+ int screenIndex);
+static int CreateVirtualEvent(Tcl_Interp *interp,
+ VirtualEventTable *vetPtr, char *virtString,
+ const char *eventString);
+static int DeleteVirtualEvent(Tcl_Interp *interp,
+ VirtualEventTable *vetPtr, char *virtString,
+ const char *eventString);
+static void DeleteVirtualEventTable(VirtualEventTable *vetPtr);
+static void ExpandPercents(TkWindow *winPtr, const char *before,
+ XEvent *eventPtr,KeySym keySym,
+ unsigned int scriptCount, Tcl_DString *dsPtr);
+static PatSeq * FindSequence(Tcl_Interp *interp,
+ Tcl_HashTable *patternTablePtr, ClientData object,
+ const char *eventString, int create,
+ int allowVirtual, unsigned long *maskPtr);
+static void GetAllVirtualEvents(Tcl_Interp *interp,
+ VirtualEventTable *vetPtr);
+static char * GetField(char *p, char *copy, int size);
+static Tcl_Obj * GetPatternObj(PatSeq *psPtr);
+static int GetVirtualEvent(Tcl_Interp *interp,
+ VirtualEventTable *vetPtr, Tcl_Obj *virtName);
+static Tk_Uid GetVirtualEventUid(Tcl_Interp *interp,
+ char *virtString);
+static int HandleEventGenerate(Tcl_Interp *interp, Tk_Window main,
+ int objc, Tcl_Obj *const objv[]);
+static void InitVirtualEventTable(VirtualEventTable *vetPtr);
+static PatSeq * MatchPatterns(TkDisplay *dispPtr,
+ BindingTable *bindPtr, PatSeq *psPtr,
+ PatSeq *bestPtr, ClientData *objectPtr,
+ PatSeq **sourcePtrPtr);
+static int NameToWindow(Tcl_Interp *interp, Tk_Window main,
+ Tcl_Obj *objPtr, Tk_Window *tkwinPtr);
+static int ParseEventDescription(Tcl_Interp *interp,
+ const char **eventStringPtr, TkPattern *patPtr,
+ unsigned long *eventMaskPtr);
+static void DoWarp(ClientData clientData);
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * TkBindInit --
+ *
+ * This function is called when an application is created. It initializes
+ * all the structures used by bindings and virtual events. It must be
+ * called before any other functions in this file are called.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Memory allocated.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+void
+TkBindInit(
+ TkMainInfo *mainPtr) /* The newly created application. */
+{
+ BindInfo *bindInfoPtr;
+
+ if (sizeof(XEvent) < sizeof(XVirtualEvent)) {
+ Tcl_Panic("TkBindInit: virtual events can't be supported");
+ }
+
+ /*
+ * Initialize the static data structures used by the binding package. They
+ * are only initialized once, no matter how many interps are created.
+ */
+
+ if (!initialized) {
+ Tcl_MutexLock(&bindMutex);
+ if (!initialized) {
+ Tcl_HashEntry *hPtr;
+ const ModInfo *modPtr;
+ const EventInfo *eiPtr;
+ int newEntry;
+#ifdef REDO_KEYSYM_LOOKUP
+ const 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, &newEntry);
+ Tcl_SetHashValue(hPtr, kPtr->value);
+ hPtr = Tcl_CreateHashEntry(&nameTable, (char *) kPtr->value,
+ &newEntry);
+ if (newEntry) {
+ 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, &newEntry);
+ Tcl_SetHashValue(hPtr, modPtr);
+ }
+
+ Tcl_InitHashTable(&eventTable, TCL_STRING_KEYS);
+ for (eiPtr = eventArray; eiPtr->name != NULL; eiPtr++) {
+ hPtr = Tcl_CreateHashEntry(&eventTable, eiPtr->name, &newEntry);
+ Tcl_SetHashValue(hPtr, eiPtr);
+ }
+ initialized = 1;
+ }
+ Tcl_MutexUnlock(&bindMutex);
+ }
+
+ mainPtr->bindingTable = Tk_CreateBindingTable(mainPtr->interp);
+
+ bindInfoPtr = ckalloc(sizeof(BindInfo));
+ InitVirtualEventTable(&bindInfoPtr->virtualEventTable);
+ bindInfoPtr->screenInfo.curDispPtr = NULL;
+ bindInfoPtr->screenInfo.curScreenIndex = -1;
+ bindInfoPtr->screenInfo.bindingDepth = 0;
+ bindInfoPtr->deleted = 0;
+ mainPtr->bindInfo = bindInfoPtr;
+
+ TkpInitializeMenuBindings(mainPtr->interp, mainPtr->bindingTable);
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * TkBindFree --
+ *
+ * This function is called when an application is deleted. It deletes all
+ * the structures used by bindings and virtual events.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Memory freed.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+void
+TkBindFree(
+ TkMainInfo *mainPtr) /* The newly created application. */
+{
+ BindInfo *bindInfoPtr;
+
+ Tk_DeleteBindingTable(mainPtr->bindingTable);
+ mainPtr->bindingTable = NULL;
+
+ bindInfoPtr = mainPtr->bindInfo;
+ DeleteVirtualEventTable(&bindInfoPtr->virtualEventTable);
+ bindInfoPtr->deleted = 1;
+ Tcl_EventuallyFree(bindInfoPtr, TCL_DYNAMIC);
+ mainPtr->bindInfo = NULL;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * Tk_CreateBindingTable --
+ *
+ * Set up a new domain in which event bindings may be created.
+ *
+ * Results:
+ * The return value is a token for the new table, which must be passed to
+ * functions like Tk_CreateBinding.
+ *
+ * Side effects:
+ * Memory is allocated for the new table.
+ *
+ *--------------------------------------------------------------
+ */
+
+Tk_BindingTable
+Tk_CreateBindingTable(
+ Tcl_Interp *interp) /* Interpreter to associate with the binding
+ * table: commands are executed in this
+ * interpreter. */
+{
+ BindingTable *bindPtr = ckalloc(sizeof(BindingTable));
+ int i;
+
+ /*
+ * Create and initialize a new binding table.
+ */
+
+ for (i = 0; i < EVENT_BUFFER_SIZE; i++) {
+ bindPtr->eventRing[i].type = -1;
+ }
+ bindPtr->curEvent = 0;
+ Tcl_InitHashTable(&bindPtr->patternTable,
+ sizeof(PatternTableKey)/sizeof(int));
+ Tcl_InitHashTable(&bindPtr->objectTable, TCL_ONE_WORD_KEYS);
+ bindPtr->interp = interp;
+ return bindPtr;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * Tk_DeleteBindingTable --
+ *
+ * Destroy a binding table and free up all its memory. The caller should
+ * not use bindingTable again after this function returns.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Memory is freed.
+ *
+ *--------------------------------------------------------------
+ */
+
+void
+Tk_DeleteBindingTable(
+ Tk_BindingTable bindPtr) /* Token for the binding table to destroy. */
+{
+ PatSeq *psPtr, *nextPtr;
+ Tcl_HashEntry *hPtr;
+ Tcl_HashSearch search;
+
+ /*
+ * Find and delete all of the patterns associated with the binding table.
+ */
+
+ for (hPtr = Tcl_FirstHashEntry(&bindPtr->patternTable, &search);
+ hPtr != NULL; hPtr = Tcl_NextHashEntry(&search)) {
+ for (psPtr = Tcl_GetHashValue(hPtr); psPtr != NULL; psPtr = nextPtr) {
+ nextPtr = psPtr->nextSeqPtr;
+ ckfree(psPtr->script);
+ ckfree(psPtr);
+ }
+ }
+
+ /*
+ * Clean up the rest of the information associated with the binding table.
+ */
+
+ Tcl_DeleteHashTable(&bindPtr->patternTable);
+ Tcl_DeleteHashTable(&bindPtr->objectTable);
+ ckfree(bindPtr);
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * Tk_CreateBinding --
+ *
+ * Add a binding to a binding table, so that future calls to Tk_BindEvent
+ * may execute the command in the binding.
+ *
+ * Results:
+ * The return value is 0 if an error occurred while setting up the
+ * binding. In this case, an error message will be left in the interp's
+ * result. If all went well then the return value is a mask of the event
+ * types that must be made available to Tk_BindEvent in order to properly
+ * detect when this binding triggers. This value can be used to determine
+ * what events to select for in a window, for example.
+ *
+ * Side effects:
+ * An existing binding on the same event sequence may be replaced. The
+ * new binding may cause future calls to Tk_BindEvent to behave
+ * differently than they did previously.
+ *
+ *--------------------------------------------------------------
+ */
+
+unsigned long
+Tk_CreateBinding(
+ Tcl_Interp *interp, /* Used for error reporting. */
+ Tk_BindingTable bindPtr, /* Table in which to create binding. */
+ ClientData object, /* Token for object with which binding is
+ * associated. */
+ const char *eventString, /* String describing event sequence that
+ * triggers binding. */
+ const char *script, /* Contains Tcl script to execute when
+ * binding triggers. */
+ int append) /* 0 means replace any existing binding for
+ * eventString; 1 means append to that
+ * binding. If the existing binding is for a
+ * callback function and not a Tcl command
+ * string, the existing binding will always be
+ * replaced. */
+{
+ PatSeq *psPtr;
+ unsigned long eventMask;
+ char *newStr, *oldStr;
+
+ if (!*script) {
+ /* Silently ignore empty scripts -- see SF#3006842 */
+ return 1;
+ }
+ psPtr = FindSequence(interp, &bindPtr->patternTable, object, eventString,
+ 1, 1, &eventMask);
+ if (psPtr == NULL) {
+ return 0;
+ }
+ if (psPtr->script == NULL) {
+ int isNew;
+ Tcl_HashEntry *hPtr;
+
+ /*
+ * This pattern sequence was just created. Link the pattern into the
+ * list associated with the object, so that if the object goes away,
+ * these bindings will all automatically be deleted.
+ */
+
+ hPtr = Tcl_CreateHashEntry(&bindPtr->objectTable, (char *) object,
+ &isNew);
+ if (isNew) {
+ psPtr->nextObjPtr = NULL;
+ } else {
+ psPtr->nextObjPtr = Tcl_GetHashValue(hPtr);
+ }
+ Tcl_SetHashValue(hPtr, psPtr);
+ }
+
+ oldStr = psPtr->script;
+ if ((append != 0) && (oldStr != NULL)) {
+ size_t length1 = strlen(oldStr), length2 = strlen(script);
+
+ newStr = ckalloc(length1 + length2 + 2);
+ memcpy(newStr, oldStr, length1);
+ newStr[length1] = '\n';
+ memcpy(newStr+length1+1, script, length2+1);
+ } else {
+ size_t length = strlen(script);
+
+ newStr = ckalloc(length + 1);
+ memcpy(newStr, script, length+1);
+ }
+ if (oldStr != NULL) {
+ ckfree(oldStr);
+ }
+ psPtr->script = newStr;
+ return eventMask;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * Tk_DeleteBinding --
+ *
+ * Remove an event binding from a binding table.
+ *
+ * Results:
+ * The result is a standard Tcl return value. If an error occurs then the
+ * interp's result will contain an error message.
+ *
+ * Side effects:
+ * The binding given by object and eventString is removed from
+ * bindingTable.
+ *
+ *--------------------------------------------------------------
+ */
+
+int
+Tk_DeleteBinding(
+ Tcl_Interp *interp, /* Used for error reporting. */
+ Tk_BindingTable bindPtr, /* Table in which to delete binding. */
+ ClientData object, /* Token for object with which binding is
+ * associated. */
+ const char *eventString) /* String describing event sequence that
+ * triggers binding. */
+{
+ PatSeq *psPtr, *prevPtr;
+ unsigned long eventMask;
+ Tcl_HashEntry *hPtr;
+
+ psPtr = FindSequence(interp, &bindPtr->patternTable, object, eventString,
+ 0, 1, &eventMask);
+ if (psPtr == NULL) {
+ Tcl_ResetResult(interp);
+ return TCL_OK;
+ }
+
+ /*
+ * Unlink the binding from the list for its object, then from the list for
+ * its pattern.
+ */
+
+ hPtr = Tcl_FindHashEntry(&bindPtr->objectTable, (char *) object);
+ if (hPtr == NULL) {
+ Tcl_Panic("Tk_DeleteBinding couldn't find object table entry");
+ }
+ prevPtr = Tcl_GetHashValue(hPtr);
+ if (prevPtr == psPtr) {
+ Tcl_SetHashValue(hPtr, psPtr->nextObjPtr);
+ } else {
+ for ( ; ; prevPtr = prevPtr->nextObjPtr) {
+ if (prevPtr == NULL) {
+ Tcl_Panic("Tk_DeleteBinding couldn't find on object list");
+ }
+ if (prevPtr->nextObjPtr == psPtr) {
+ prevPtr->nextObjPtr = psPtr->nextObjPtr;
+ break;
+ }
+ }
+ }
+ prevPtr = Tcl_GetHashValue(psPtr->hPtr);
+ if (prevPtr == psPtr) {
+ if (psPtr->nextSeqPtr == NULL) {
+ Tcl_DeleteHashEntry(psPtr->hPtr);
+ } else {
+ Tcl_SetHashValue(psPtr->hPtr, psPtr->nextSeqPtr);
+ }
+ } else {
+ for ( ; ; prevPtr = prevPtr->nextSeqPtr) {
+ if (prevPtr == NULL) {
+ Tcl_Panic("Tk_DeleteBinding couldn't find on hash chain");
+ }
+ if (prevPtr->nextSeqPtr == psPtr) {
+ prevPtr->nextSeqPtr = psPtr->nextSeqPtr;
+ break;
+ }
+ }
+ }
+
+ ckfree(psPtr->script);
+ ckfree(psPtr);
+ return TCL_OK;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * Tk_GetBinding --
+ *
+ * Return the script associated with a given event string.
+ *
+ * Results:
+ * The return value is a pointer to the script associated with
+ * eventString for object in the domain given by bindingTable. If there
+ * is no binding for eventString, or if eventString is improperly formed,
+ * then NULL is returned and an error message is left in the interp's
+ * result. The return value is semi-static: it will persist until the
+ * binding is changed or deleted.
+ *
+ * Side effects:
+ * None.
+ *
+ *--------------------------------------------------------------
+ */
+
+const char *
+Tk_GetBinding(
+ Tcl_Interp *interp, /* Interpreter for error reporting. */
+ Tk_BindingTable bindPtr, /* Table in which to look for binding. */
+ ClientData object, /* Token for object with which binding is
+ * associated. */
+ const char *eventString) /* String describing event sequence that
+ * triggers binding. */
+{
+ PatSeq *psPtr;
+ unsigned long eventMask;
+
+ psPtr = FindSequence(interp, &bindPtr->patternTable, object, eventString,
+ 0, 1, &eventMask);
+ if (psPtr == NULL) {
+ return NULL;
+ }
+ return psPtr->script;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * Tk_GetAllBindings --
+ *
+ * Return a list of event strings for all the bindings associated with a
+ * given object.
+ *
+ * Results:
+ * There is no return value. The interp's result is modified to hold a
+ * Tcl list with one entry for each binding associated with object in
+ * bindingTable. Each entry in the list contains the event string
+ * associated with one binding.
+ *
+ * Side effects:
+ * None.
+ *
+ *--------------------------------------------------------------
+ */
+
+void
+Tk_GetAllBindings(
+ Tcl_Interp *interp, /* Interpreter returning result or error. */
+ Tk_BindingTable bindPtr, /* Table in which to look for bindings. */
+ ClientData object) /* Token for object. */
+{
+ PatSeq *psPtr;
+ Tcl_HashEntry *hPtr;
+ Tcl_Obj *resultObj;
+
+ hPtr = Tcl_FindHashEntry(&bindPtr->objectTable, (char *) object);
+ if (hPtr == NULL) {
+ return;
+ }
+
+ resultObj = Tcl_NewObj();
+ for (psPtr = Tcl_GetHashValue(hPtr); psPtr != NULL;
+ psPtr = psPtr->nextObjPtr) {
+ /*
+ * For each binding, output information about each of the patterns in
+ * its sequence.
+ */
+
+ Tcl_ListObjAppendElement(NULL, resultObj, GetPatternObj(psPtr));
+ }
+ Tcl_SetObjResult(interp, resultObj);
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * Tk_DeleteAllBindings --
+ *
+ * Remove all bindings associated with a given object in a given binding
+ * table.
+ *
+ * Results:
+ * All bindings associated with object are removed from bindingTable.
+ *
+ * Side effects:
+ * None.
+ *
+ *--------------------------------------------------------------
+ */
+
+void
+Tk_DeleteAllBindings(
+ Tk_BindingTable bindPtr, /* Table in which to delete bindings. */
+ ClientData object) /* Token for object. */
+{
+ PatSeq *psPtr, *prevPtr;
+ PatSeq *nextPtr;
+ Tcl_HashEntry *hPtr;
+
+ hPtr = Tcl_FindHashEntry(&bindPtr->objectTable, (char *) object);
+ if (hPtr == NULL) {
+ return;
+ }
+ for (psPtr = Tcl_GetHashValue(hPtr); psPtr != NULL;
+ psPtr = nextPtr) {
+ nextPtr = psPtr->nextObjPtr;
+
+ /*
+ * Be sure to remove each binding from its hash chain in the pattern
+ * table. If this is the last pattern in the chain, then delete the
+ * hash entry too.
+ */
+
+ prevPtr = Tcl_GetHashValue(psPtr->hPtr);
+ if (prevPtr == psPtr) {
+ if (psPtr->nextSeqPtr == NULL) {
+ Tcl_DeleteHashEntry(psPtr->hPtr);
+ } else {
+ Tcl_SetHashValue(psPtr->hPtr, psPtr->nextSeqPtr);
+ }
+ } else {
+ for ( ; ; prevPtr = prevPtr->nextSeqPtr) {
+ if (prevPtr == NULL) {
+ Tcl_Panic("Tk_DeleteAllBindings couldn't find on hash chain");
+ }
+ if (prevPtr->nextSeqPtr == psPtr) {
+ prevPtr->nextSeqPtr = psPtr->nextSeqPtr;
+ break;
+ }
+ }
+ }
+ ckfree(psPtr->script);
+ ckfree(psPtr);
+ }
+ Tcl_DeleteHashEntry(hPtr);
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * Tk_BindEvent --
+ *
+ * This function is invoked to process an X event. The event is added to
+ * those recorded for the binding table. Then each of the objects at
+ * *objectPtr is checked in order to see if it has a binding that matches
+ * the recent events. If so, the most specific binding is invoked for
+ * each object.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Depends on the script associated with the matching binding.
+ *
+ * All Tcl binding scripts for each object are accumulated before the
+ * first binding is evaluated. If the action of a Tcl binding is to
+ * change or delete a binding, or delete the window associated with the
+ * binding, all the original Tcl binding scripts will still fire.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+void
+Tk_BindEvent(
+ Tk_BindingTable bindPtr, /* Table in which to look for bindings. */
+ XEvent *eventPtr, /* What actually happened. */
+ Tk_Window tkwin, /* Window on display where event occurred
+ * (needed in order to locate display
+ * information). */
+ int numObjects, /* Number of objects at *objectPtr. */
+ ClientData *objectPtr) /* Array of one or more objects to check for a
+ * matching binding. */
+{
+ TkDisplay *dispPtr;
+ ScreenInfo *screenPtr;
+ BindInfo *bindInfoPtr;
+ TkDisplay *oldDispPtr;
+ XEvent *ringPtr;
+ PatSeq *vMatchDetailList, *vMatchNoDetailList;
+ int flags, oldScreen;
+ unsigned int scriptCount;
+ Tcl_Interp *interp;
+ Tcl_DString scripts;
+ Tcl_InterpState interpState;
+ Detail detail;
+ char *p, *end;
+ TkWindow *winPtr = (TkWindow *) tkwin;
+ PatternTableKey key;
+
+ /*
+ * Ignore events on windows that don't have names: these are windows like
+ * wrapper windows that shouldn't be visible to the application.
+ */
+
+ if (winPtr->pathName == NULL) {
+ return;
+ }
+
+ /*
+ * Ignore the event completely if it is an Enter, Leave, FocusIn, or
+ * FocusOut event with detail NotifyInferior. The reason for ignoring
+ * these events is that we don't want transitions between a window and its
+ * children to visible to bindings on the parent: this would cause
+ * problems for mega-widgets, since the internal structure of a
+ * mega-widget isn't supposed to be visible to people watching the parent.
+ */
+
+ if ((eventPtr->type == EnterNotify) || (eventPtr->type == LeaveNotify)) {
+ if (eventPtr->xcrossing.detail == NotifyInferior) {
+ return;
+ }
+ }
+ if ((eventPtr->type == FocusIn) || (eventPtr->type == FocusOut)) {
+ if (eventPtr->xfocus.detail == NotifyInferior) {
+ return;
+ }
+ }
+
+ dispPtr = ((TkWindow *) tkwin)->dispPtr;
+ bindInfoPtr = winPtr->mainPtr->bindInfo;
+
+ /*
+ * Add the new event to the ring of saved events for the binding table.
+ * Two tricky points:
+ *
+ * 1. Combine consecutive MotionNotify events. Do this by putting the new
+ * event *on top* of the previous event.
+ * 2. If a modifier key is held down, it auto-repeats to generate
+ * continuous KeyPress and KeyRelease events. These can flush the event
+ * ring so that valuable information is lost (such as repeated button
+ * clicks). To handle this, check for the special case of a modifier
+ * KeyPress arriving when the previous two events are a KeyRelease and
+ * KeyPress of the same key. If this happens, mark the most recent
+ * event (the KeyRelease) invalid and put the new event on top of the
+ * event before that (the KeyPress).
+ */
+
+ if ((eventPtr->type == MotionNotify)
+ && (bindPtr->eventRing[bindPtr->curEvent].type == MotionNotify)) {
+ /*
+ * Don't advance the ring pointer.
+ */
+ } else if (eventPtr->type == KeyPress) {
+ int i;
+
+ for (i = 0; ; i++) {
+ if (i >= dispPtr->numModKeyCodes) {
+ goto advanceRingPointer;
+ }
+ if (dispPtr->modKeyCodes[i] == eventPtr->xkey.keycode) {
+ break;
+ }
+ }
+ ringPtr = &bindPtr->eventRing[bindPtr->curEvent];
+ if ((ringPtr->type != KeyRelease)
+ || (ringPtr->xkey.keycode != eventPtr->xkey.keycode)) {
+ goto advanceRingPointer;
+ }
+ if (bindPtr->curEvent <= 0) {
+ i = EVENT_BUFFER_SIZE - 1;
+ } else {
+ i = bindPtr->curEvent - 1;
+ }
+ ringPtr = &bindPtr->eventRing[i];
+ if ((ringPtr->type != KeyPress)
+ || (ringPtr->xkey.keycode != eventPtr->xkey.keycode)) {
+ goto advanceRingPointer;
+ }
+ bindPtr->eventRing[bindPtr->curEvent].type = -1;
+ bindPtr->curEvent = i;
+ } else {
+
+ advanceRingPointer:
+ bindPtr->curEvent++;
+ if (bindPtr->curEvent >= EVENT_BUFFER_SIZE) {
+ bindPtr->curEvent = 0;
+ }
+ }
+ ringPtr = &bindPtr->eventRing[bindPtr->curEvent];
+ memcpy(ringPtr, eventPtr, sizeof(XEvent));
+ detail.clientData = 0;
+ flags = flagArray[ringPtr->type];
+ if (flags & KEY) {
+ detail.keySym = TkpGetKeySym(dispPtr, ringPtr);
+ if (detail.keySym == NoSymbol) {
+ detail.keySym = 0;
+ }
+ } else if (flags & BUTTON) {
+ detail.button = ringPtr->xbutton.button;
+ } else if (flags & VIRTUAL) {
+ detail.name = ((XVirtualEvent *) ringPtr)->name;
+ }
+ bindPtr->detailRing[bindPtr->curEvent] = detail;
+
+ /*
+ * Find out if there are any virtual events that correspond to this
+ * physical event (or sequence of physical events).
+ */
+
+ vMatchDetailList = NULL;
+ vMatchNoDetailList = NULL;
+ memset(&key, 0, sizeof(key));
+
+ if (ringPtr->type != VirtualEvent) {
+ Tcl_HashTable *veptPtr = &bindInfoPtr->virtualEventTable.patternTable;
+ Tcl_HashEntry *hPtr;
+
+ key.object = NULL;
+ key.type = ringPtr->type;
+ key.detail = detail;
+
+ hPtr = Tcl_FindHashEntry(veptPtr, (char *) &key);
+ if (hPtr != NULL) {
+ vMatchDetailList = Tcl_GetHashValue(hPtr);
+ }
+
+ if (key.detail.clientData != 0) {
+ key.detail.clientData = 0;
+ hPtr = Tcl_FindHashEntry(veptPtr, (char *) &key);
+ if (hPtr != NULL) {
+ vMatchNoDetailList = Tcl_GetHashValue(hPtr);
+ }
+ }
+ }
+
+ /*
+ * Loop over all the binding tags, finding the binding script or callback
+ * for each one. Append all of the binding scripts, with %-sequences
+ * expanded, to "scripts", with null characters separating the scripts for
+ * each object.
+ */
+
+ scriptCount = 0;
+ Tcl_DStringInit(&scripts);
+
+ for ( ; numObjects > 0; numObjects--, objectPtr++) {
+ PatSeq *matchPtr = NULL, *sourcePtr = NULL;
+ Tcl_HashEntry *hPtr;
+
+ /*
+ * Match the new event against those recorded in the pattern table,
+ * saving the longest matching pattern. For events with details
+ * (button and key events), look for a binding for the specific key or
+ * button. First see if the event matches a physical event that the
+ * object is interested in, then look for a virtual event.
+ */
+
+ key.object = *objectPtr;
+ key.type = ringPtr->type;
+ key.detail = detail;
+ hPtr = Tcl_FindHashEntry(&bindPtr->patternTable, (char *) &key);
+ if (hPtr != NULL) {
+ matchPtr = MatchPatterns(dispPtr, bindPtr, Tcl_GetHashValue(hPtr),
+ matchPtr, NULL, &sourcePtr);
+ }
+
+ if (vMatchDetailList != NULL) {
+ matchPtr = MatchPatterns(dispPtr, bindPtr, vMatchDetailList,
+ matchPtr, objectPtr, &sourcePtr);
+ }
+
+ /*
+ * If no match was found, look for a binding for all keys or buttons
+ * (detail of 0). Again, first match on a virtual event.
+ */
+
+ if ((detail.clientData != 0) && (matchPtr == NULL)) {
+ key.detail.clientData = 0;
+ hPtr = Tcl_FindHashEntry(&bindPtr->patternTable, (char *) &key);
+ if (hPtr != NULL) {
+ matchPtr = MatchPatterns(dispPtr, bindPtr,
+ Tcl_GetHashValue(hPtr), matchPtr, NULL, &sourcePtr);
+ }
+
+ if (vMatchNoDetailList != NULL) {
+ matchPtr = MatchPatterns(dispPtr, bindPtr, vMatchNoDetailList,
+ matchPtr, objectPtr, &sourcePtr);
+ }
+ }
+
+ if (matchPtr != NULL) {
+ ExpandPercents(winPtr, sourcePtr->script, eventPtr,
+ detail.keySym, scriptCount++, &scripts);
+
+ /*
+ * A "" is added to the scripts string to separate the various
+ * scripts that should be invoked.
+ */
+
+ Tcl_DStringAppend(&scripts, "", 1);
+ }
+ }
+ if (Tcl_DStringLength(&scripts) == 0) {
+ return;
+ }
+
+ /*
+ * Now go back through and evaluate the binding for each object, in order,
+ * dealing with "break" and "continue" exceptions appropriately.
+ *
+ * There are two tricks here:
+ * 1. Bindings can be invoked from in the middle of Tcl commands, where
+ * the interp's result is significant (for example, a widget might be
+ * deleted because of an error in creating it, so the result contains
+ * an error message that is eventually going to be returned by the
+ * creating command). To preserve the result, we save it in a dynamic
+ * string.
+ * 2. The binding's action can potentially delete the binding, so bindPtr
+ * may not point to anything valid once the action completes. Thus we
+ * have to save bindPtr->interp in a local variable in order to restore
+ * the result.
+ */
+
+ interp = bindPtr->interp;
+
+ /*
+ * Save information about the current screen, then invoke a script if the
+ * screen has changed.
+ */
+
+ interpState = Tcl_SaveInterpState(interp, TCL_OK);
+ screenPtr = &bindInfoPtr->screenInfo;
+ oldDispPtr = screenPtr->curDispPtr;
+ oldScreen = screenPtr->curScreenIndex;
+ if ((dispPtr != screenPtr->curDispPtr)
+ || (Tk_ScreenNumber(tkwin) != screenPtr->curScreenIndex)) {
+ screenPtr->curDispPtr = dispPtr;
+ screenPtr->curScreenIndex = Tk_ScreenNumber(tkwin);
+ ChangeScreen(interp, dispPtr->name, screenPtr->curScreenIndex);
+ }
+
+ p = Tcl_DStringValue(&scripts);
+ end = p + Tcl_DStringLength(&scripts);
+
+ /*
+ * Be careful 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(bindInfoPtr);
+ while (p < end) {
+ int len = (int) strlen(p);
+ int code;
+
+ if (!bindInfoPtr->deleted) {
+ screenPtr->bindingDepth++;
+ }
+ Tcl_AllowExceptions(interp);
+
+ code = Tcl_EvalEx(interp, p, len, TCL_EVAL_GLOBAL);
+ p += len + 1;
+
+ if (!bindInfoPtr->deleted) {
+ screenPtr->bindingDepth--;
+ }
+ if (code != TCL_OK) {
+ if (code == TCL_CONTINUE) {
+ /*
+ * Do nothing: just go on to the next command.
+ */
+ } else if (code == TCL_BREAK) {
+ break;
+ } else {
+ Tcl_AddErrorInfo(interp, "\n (command bound to event)");
+ Tcl_BackgroundException(interp, code);
+ break;
+ }
+ }
+ }
+
+ if (!bindInfoPtr->deleted && (screenPtr->bindingDepth != 0)
+ && ((oldDispPtr != screenPtr->curDispPtr)
+ || (oldScreen != screenPtr->curScreenIndex))) {
+ /*
+ * Some other binding script is currently executing, but its screen is
+ * no longer current. Change the current display back again.
+ */
+
+ screenPtr->curDispPtr = oldDispPtr;
+ screenPtr->curScreenIndex = oldScreen;
+ ChangeScreen(interp, oldDispPtr->name, oldScreen);
+ }
+ (void) Tcl_RestoreInterpState(interp, interpState);
+ Tcl_DStringFree(&scripts);
+
+ Tcl_Release(bindInfoPtr);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * MatchPatterns --
+ *
+ * Given a list of pattern sequences and a list of recent events, return
+ * the pattern sequence that best matches the event list, if there is
+ * one.
+ *
+ * This function is used in two different ways. In the simplest use,
+ * "object" is NULL and psPtr is a list of pattern sequences, each of
+ * which corresponds to a binding. In this case, the function finds the
+ * pattern sequences that match the event list and returns the most
+ * specific of those, if there is more than one.
+ *
+ * In the second case, psPtr is a list of pattern sequences, each of
+ * which corresponds to a definition for a virtual binding. In order for
+ * one of these sequences to "match", it must match the events (as above)
+ * but in addition there must be a binding for its associated virtual
+ * event on the current object. The "object" argument indicates which
+ * object the binding must be for.
+ *
+ * Results:
+
+ * The return value is NULL if bestPtr is NULL and no pattern matches the
+ * recent events from bindPtr. Otherwise the return value is the most
+ * specific pattern sequence among bestPtr and all those at psPtr that
+ * match the event list and object. If a pattern sequence other than
+ * bestPtr is returned, then *bestCommandPtr is filled in with a pointer
+ * to the command from the best sequence.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static PatSeq *
+MatchPatterns(
+ TkDisplay *dispPtr, /* Display from which the event came. */
+ BindingTable *bindPtr, /* Information about binding table, such as
+ * ring of recent events. */
+ PatSeq *psPtr, /* List of pattern sequences. */
+ PatSeq *bestPtr, /* The best match seen so far, from a previous
+ * call to this function. NULL means no prior
+ * best match. */
+ ClientData *objectPtr, /* If NULL, the sequences at psPtr correspond
+ * to "normal" bindings. If non-NULL, the
+ * sequences at psPtr correspond to virtual
+ * bindings; in order to match each sequence
+ * must correspond to a virtual binding for
+ * which a binding exists for object in
+ * bindPtr. */
+ PatSeq **sourcePtrPtr) /* Filled with the pattern sequence that
+ * contains the eventProc and clientData
+ * associated with the best match. If this
+ * differs from the return value, it is the
+ * virtual event that most closely matched the
+ * return value (a physical event). Not
+ * modified unless a result other than bestPtr
+ * is returned. */
+{
+ PatSeq *matchPtr, *bestSourcePtr, *sourcePtr;
+
+ bestSourcePtr = *sourcePtrPtr;
+
+ /*
+ * Iterate over all the pattern sequences.
+ */
+
+ for ( ; psPtr != NULL; psPtr = psPtr->nextSeqPtr) {
+ XEvent *eventPtr = &bindPtr->eventRing[bindPtr->curEvent];
+ Detail *detailPtr = &bindPtr->detailRing[bindPtr->curEvent];
+ TkPattern *patPtr = psPtr->pats;
+ Window window = eventPtr->xany.window;
+ int patCount, ringCount, flags, state, modMask, i;
+
+ /*
+ * Iterate over all the patterns in a sequence to be sure that they
+ * all match.
+ */
+
+ patCount = psPtr->numPats;
+ ringCount = EVENT_BUFFER_SIZE;
+ while (patCount > 0) {
+ if (ringCount <= 0) {
+ goto nextSequence;
+ }
+ if (eventPtr->xany.type != patPtr->eventType) {
+ /*
+ * Most of the event types are considered superfluous in that
+ * they are ignored if they occur in the middle of a pattern
+ * sequence and have mismatching types. The only ones that
+ * cannot be ignored are ButtonPress and ButtonRelease events
+ * (if the next event in the pattern is a KeyPress or
+ * KeyRelease) and KeyPress and KeyRelease events (if the next
+ * pattern event is a ButtonPress or ButtonRelease). Here are
+ * some tricky cases to consider:
+ * 1. Double-Button or Double-Key events.
+ * 2. Double-ButtonRelease or Double-KeyRelease events.
+ * 3. The arrival of various events like Enter and Leave and
+ * FocusIn and GraphicsExpose between two button presses or
+ * key presses.
+ * 4. Modifier keys like Shift and Control shouldn't generate
+ * conflicts with button events.
+ */
+
+ if ((patPtr->eventType == KeyPress)
+ || (patPtr->eventType == KeyRelease)) {
+ if ((eventPtr->xany.type == ButtonPress)
+ || (eventPtr->xany.type == ButtonRelease)) {
+ goto nextSequence;
+ }
+ } else if ((patPtr->eventType == ButtonPress)
+ || (patPtr->eventType == ButtonRelease)) {
+ if ((eventPtr->xany.type == KeyPress)
+ || (eventPtr->xany.type == KeyRelease)) {
+ /*
+ * Ignore key events if they are modifier keys.
+ */
+
+ for (i = 0; i < dispPtr->numModKeyCodes; i++) {
+ if (dispPtr->modKeyCodes[i]
+ == eventPtr->xkey.keycode) {
+ /*
+ * This key is a modifier key, so ignore it.
+ */
+
+ goto nextEvent;
+ }
+ }
+ goto nextSequence;
+ }
+ }
+ goto nextEvent;
+ }
+ if (eventPtr->xany.type == CreateNotify
+ && eventPtr->xcreatewindow.parent != window) {
+ goto nextSequence;
+ } else if (eventPtr->xany.window != window) {
+ goto nextSequence;
+ }
+
+ /*
+ * Note: it's important for the keysym check to go before the
+ * modifier check, so we can ignore unwanted modifier keys before
+ * choking on the modifier check.
+ */
+
+ if ((patPtr->detail.clientData != 0)
+ && (patPtr->detail.clientData != detailPtr->clientData)) {
+ /*
+ * The detail appears not to match. However, if the event is a
+ * KeyPress for a modifier key then just ignore the event.
+ * Otherwise event sequences like "aD" never match because the
+ * shift key goes down between the "a" and the "D".
+ */
+
+ if (eventPtr->xany.type == KeyPress) {
+ for (i = 0; i < dispPtr->numModKeyCodes; i++) {
+ if (dispPtr->modKeyCodes[i] == eventPtr->xkey.keycode) {
+ goto nextEvent;
+ }
+ }
+ }
+ goto nextSequence;
+ }
+ flags = flagArray[eventPtr->type];
+ if (flags & KEY_BUTTON_MOTION_VIRTUAL) {
+ state = eventPtr->xkey.state;
+ } else if (flags & CROSSING) {
+ state = eventPtr->xcrossing.state;
+ } else {
+ state = 0;
+ }
+ if (patPtr->needMods != 0) {
+ modMask = patPtr->needMods;
+ if ((modMask & META_MASK) && (dispPtr->metaModMask != 0)) {
+ modMask = (modMask & ~META_MASK) | dispPtr->metaModMask;
+ }
+ if ((modMask & ALT_MASK) && (dispPtr->altModMask != 0)) {
+ modMask = (modMask & ~ALT_MASK) | dispPtr->altModMask;
+ }
+
+ if ((state & META_MASK) && (dispPtr->metaModMask != 0)) {
+ state = (state & ~META_MASK) | dispPtr->metaModMask;
+ }
+ if ((state & ALT_MASK) && (dispPtr->altModMask != 0)) {
+ state = (state & ~ALT_MASK) | dispPtr->altModMask;
+ }
+
+ if ((state & modMask) != modMask) {
+ goto nextSequence;
+ }
+ }
+ if (psPtr->flags & PAT_NEARBY) {
+ XEvent *firstPtr = &bindPtr->eventRing[bindPtr->curEvent];
+ int timeDiff;
+
+ timeDiff = (Time) firstPtr->xkey.time - eventPtr->xkey.time;
+ if ((firstPtr->xkey.x_root
+ < (eventPtr->xkey.x_root - NEARBY_PIXELS))
+ || (firstPtr->xkey.x_root
+ > (eventPtr->xkey.x_root + NEARBY_PIXELS))
+ || (firstPtr->xkey.y_root
+ < (eventPtr->xkey.y_root - NEARBY_PIXELS))
+ || (firstPtr->xkey.y_root
+ > (eventPtr->xkey.y_root + NEARBY_PIXELS))
+ || (timeDiff > NEARBY_MS)) {
+ goto nextSequence;
+ }
+ }
+ patPtr++;
+ patCount--;
+ nextEvent:
+ if (eventPtr == bindPtr->eventRing) {
+ eventPtr = &bindPtr->eventRing[EVENT_BUFFER_SIZE-1];
+ detailPtr = &bindPtr->detailRing[EVENT_BUFFER_SIZE-1];
+ } else {
+ eventPtr--;
+ detailPtr--;
+ }
+ ringCount--;
+ }
+
+ matchPtr = psPtr;
+ sourcePtr = psPtr;
+
+ if (objectPtr != NULL) {
+ int iVirt;
+ VirtualOwners *voPtr;
+ PatternTableKey key;
+
+ /*
+ * The sequence matches the physical constraints. Is this object
+ * interested in any of the virtual events that correspond to this
+ * sequence?
+ */
+
+ voPtr = psPtr->voPtr;
+
+ memset(&key, 0, sizeof(key));
+ key.object = *objectPtr;
+ key.type = VirtualEvent;
+ key.detail.clientData = 0;
+
+ for (iVirt = 0; iVirt < voPtr->numOwners; iVirt++) {
+ Tcl_HashEntry *hPtr = voPtr->owners[iVirt];
+
+ key.detail.name = (Tk_Uid) Tcl_GetHashKey(hPtr->tablePtr,
+ hPtr);
+ hPtr = Tcl_FindHashEntry(&bindPtr->patternTable,
+ (char *) &key);
+ if (hPtr != NULL) {
+ /*
+ * This tag is interested in this virtual event and its
+ * corresponding physical event is a good match with the
+ * virtual event's definition.
+ */
+
+ PatSeq *virtMatchPtr = Tcl_GetHashValue(hPtr);
+
+ if ((virtMatchPtr->numPats != 1)
+ || (virtMatchPtr->nextSeqPtr != NULL)) {
+ Tcl_Panic("MatchPattern: badly constructed virtual event");
+ }
+ sourcePtr = virtMatchPtr;
+ goto match;
+ }
+ }
+
+ /*
+ * The physical event matches a virtual event's definition, but
+ * the tag isn't interested in it.
+ */
+
+ goto nextSequence;
+ }
+ match:
+
+ /*
+ * This sequence matches. If we've already got another match, pick
+ * whichever is most specific. Detail is most important, then
+ * needMods.
+ */
+
+ if (bestPtr != NULL) {
+ TkPattern *patPtr2;
+
+ if (matchPtr->numPats != bestPtr->numPats) {
+ if (bestPtr->numPats > matchPtr->numPats) {
+ goto nextSequence;
+ } else {
+ goto newBest;
+ }
+ }
+ for (i = 0, patPtr = matchPtr->pats, patPtr2 = bestPtr->pats;
+ i < matchPtr->numPats; i++, patPtr++, patPtr2++) {
+ if (patPtr->detail.clientData != patPtr2->detail.clientData) {
+ if (patPtr->detail.clientData == 0) {
+ goto nextSequence;
+ } else {
+ goto newBest;
+ }
+ }
+ if (patPtr->needMods != patPtr2->needMods) {
+ if ((patPtr->needMods & patPtr2->needMods)
+ == patPtr->needMods) {
+ goto nextSequence;
+ } else if ((patPtr->needMods & patPtr2->needMods)
+ == patPtr2->needMods) {
+ goto newBest;
+ }
+ }
+ }
+
+ /*
+ * Tie goes to current best pattern.
+ *
+ * (1) For virtual vs. virtual, the least recently defined virtual
+ * wins, because virtuals are examined in order of definition.
+ * This order is _not_ guaranteed in the documentation.
+ *
+ * (2) For virtual vs. physical, the physical wins because all the
+ * physicals are examined before the virtuals. This order is
+ * guaranteed in the documentation.
+ *
+ * (3) For physical vs. physical pattern, the most recently
+ * defined physical wins, because physicals are examined in
+ * reverse order of definition. This order is guaranteed in the
+ * documentation.
+ */
+
+ goto nextSequence;
+ }
+ newBest:
+ bestPtr = matchPtr;
+ bestSourcePtr = sourcePtr;
+
+ nextSequence:
+ continue;
+ }
+
+ *sourcePtrPtr = bestSourcePtr;
+ return bestPtr;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * ExpandPercents --
+ *
+ * Given a command and an event, produce a new command by replacing %
+ * constructs in the original command with information from the X event.
+ *
+ * Results:
+ * The new expanded command is appended to the dynamic string given by
+ * dsPtr.
+ *
+ * Side effects:
+ * None.
+ *
+ *--------------------------------------------------------------
+ */
+
+static void
+ExpandPercents(
+ TkWindow *winPtr, /* Window where event occurred: needed to get
+ * input context. */
+ const char *before, /* Command containing percent expressions to
+ * be replaced. */
+ XEvent *eventPtr, /* X event containing information to be used
+ * in % replacements. */
+ KeySym keySym, /* KeySym: only relevant for KeyPress and
+ * KeyRelease events). */
+ unsigned int scriptCount, /* The number of script-based binding patterns
+ * matched so far for this event. */
+ Tcl_DString *dsPtr) /* Dynamic string in which to append new
+ * command. */
+{
+ int spaceNeeded, cvtFlags; /* Used to substitute string as proper Tcl
+ * list element. */
+ int number, flags, length;
+#define NUM_SIZE 40
+ const char *string;
+ Tcl_DString buf;
+ char numStorage[NUM_SIZE+1];
+
+ Tcl_DStringInit(&buf);
+
+ if (eventPtr->type < TK_LASTEVENT) {
+ flags = flagArray[eventPtr->type];
+ } else {
+ flags = 0;
+ }
+
+ while (1) {
+ /*
+ * Find everything up to the next % character and append it to the
+ * result string.
+ */
+
+ for (string = before; (*string != 0) && (*string != '%'); string++) {
+ /* Empty loop body. */
+ }
+ if (string != before) {
+ Tcl_DStringAppend(dsPtr, before, (int) (string-before));
+ before = string;
+ }
+ if (*before == 0) {
+ break;
+ }
+
+ /*
+ * There's a percent sequence here. Process it.
+ */
+
+ number = 0;
+ string = "??";
+ switch (before[1]) {
+ case '#':
+ number = eventPtr->xany.serial;
+ goto doNumber;
+ case 'a':
+ if (flags & CONFIG) {
+ TkpPrintWindowId(numStorage, eventPtr->xconfigure.above);
+ string = numStorage;
+ }
+ goto doString;
+ case 'b':
+ if (flags & BUTTON) {
+ number = eventPtr->xbutton.button;
+ goto doNumber;
+ }
+ goto doString;
+ case 'c':
+ if (flags & EXPOSE) {
+ number = eventPtr->xexpose.count;
+ goto doNumber;
+ }
+ goto doString;
+ case 'd':
+ if (flags & (CROSSING|FOCUS)) {
+ if (flags & FOCUS) {
+ number = eventPtr->xfocus.detail;
+ } else {
+ number = eventPtr->xcrossing.detail;
+ }
+ string = TkFindStateString(notifyDetail, number);
+ } else if (flags & CONFIGREQ) {
+ if (eventPtr->xconfigurerequest.value_mask & CWStackMode) {
+ string = TkFindStateString(configureRequestDetail,
+ eventPtr->xconfigurerequest.detail);
+ } else {
+ string = "";
+ }
+ } else if (flags & VIRTUAL) {
+ XVirtualEvent *vePtr = (XVirtualEvent *) eventPtr;
+
+ if (vePtr->user_data != NULL) {
+ string = Tcl_GetString(vePtr->user_data);
+ } else {
+ string = "";
+ }
+ }
+ goto doString;
+ case 'f':
+ if (flags & CROSSING) {
+ number = eventPtr->xcrossing.focus;
+ goto doNumber;
+ }
+ goto doString;
+ case 'h':
+ if (flags & EXPOSE) {
+ number = eventPtr->xexpose.height;
+ } else if (flags & CONFIG) {
+ number = eventPtr->xconfigure.height;
+ } else if (flags & CREATE) {
+ number = eventPtr->xcreatewindow.height;
+ } else if (flags & CONFIGREQ) {
+ number = eventPtr->xconfigurerequest.height;
+ } else if (flags & RESIZEREQ) {
+ number = eventPtr->xresizerequest.height;
+ } else {
+ goto doString;
+ }
+ goto doNumber;
+ case 'i':
+ if (flags & CREATE) {
+ TkpPrintWindowId(numStorage, eventPtr->xcreatewindow.window);
+ } else if (flags & CONFIGREQ) {
+ TkpPrintWindowId(numStorage,
+ eventPtr->xconfigurerequest.window);
+ } else if (flags & MAPREQ) {
+ TkpPrintWindowId(numStorage, eventPtr->xmaprequest.window);
+ } else {
+ TkpPrintWindowId(numStorage, eventPtr->xany.window);
+ }
+ string = numStorage;
+ goto doString;
+ case 'k':
+ if ((flags & KEY) && (eventPtr->type != MouseWheelEvent)) {
+ number = eventPtr->xkey.keycode;
+ goto doNumber;
+ }
+ goto doString;
+ case 'm':
+ if (flags & CROSSING) {
+ number = eventPtr->xcrossing.mode;
+ string = TkFindStateString(notifyMode, number);
+ } else if (flags & FOCUS) {
+ number = eventPtr->xfocus.mode;
+ string = TkFindStateString(notifyMode, number);
+ }
+ goto doString;
+ case 'o':
+ if (flags & CREATE) {
+ number = eventPtr->xcreatewindow.override_redirect;
+ } else if (flags & MAP) {
+ number = eventPtr->xmap.override_redirect;
+ } else if (flags & REPARENT) {
+ number = eventPtr->xreparent.override_redirect;
+ } else if (flags & CONFIG) {
+ number = eventPtr->xconfigure.override_redirect;
+ } else {
+ goto doString;
+ }
+ goto doNumber;
+ case 'p':
+ if (flags & CIRC) {
+ string = TkFindStateString(circPlace,
+ eventPtr->xcirculate.place);
+ } else if (flags & CIRCREQ) {
+ string = TkFindStateString(circPlace,
+ eventPtr->xcirculaterequest.place);
+ }
+ goto doString;
+ case 's':
+ if (flags & KEY_BUTTON_MOTION_VIRTUAL) {
+ number = eventPtr->xkey.state;
+ goto doNumber;
+ } else if (flags & CROSSING) {
+ number = eventPtr->xcrossing.state;
+ goto doNumber;
+ } else if (flags & PROP) {
+ string = TkFindStateString(propNotify,
+ eventPtr->xproperty.state);
+ } else if (flags & VISIBILITY) {
+ string = TkFindStateString(visNotify,
+ eventPtr->xvisibility.state);
+ }
+ goto doString;
+ case 't':
+ if (flags & KEY_BUTTON_MOTION_VIRTUAL) {
+ number = (int) eventPtr->xkey.time;
+ } else if (flags & CROSSING) {
+ number = (int) eventPtr->xcrossing.time;
+ } else if (flags & PROP) {
+ number = (int) eventPtr->xproperty.time;
+ } else {
+ goto doString;
+ }
+ goto doNumber;
+ case 'v':
+ number = eventPtr->xconfigurerequest.value_mask;
+ goto doNumber;
+ case 'w':
+ if (flags & EXPOSE) {
+ number = eventPtr->xexpose.width;
+ } else if (flags & CONFIG) {
+ number = eventPtr->xconfigure.width;
+ } else if (flags & CREATE) {
+ number = eventPtr->xcreatewindow.width;
+ } else if (flags & CONFIGREQ) {
+ number = eventPtr->xconfigurerequest.width;
+ } else if (flags & RESIZEREQ) {
+ number = eventPtr->xresizerequest.width;
+ } else {
+ goto doString;
+ }
+ goto doNumber;
+ case 'x':
+ if (flags & KEY_BUTTON_MOTION_VIRTUAL) {
+ number = eventPtr->xkey.x;
+ } else if (flags & CROSSING) {
+ number = eventPtr->xcrossing.x;
+ } else if (flags & EXPOSE) {
+ number = eventPtr->xexpose.x;
+ } else if (flags & (CREATE|CONFIG|GRAVITY)) {
+ number = eventPtr->xcreatewindow.x;
+ } else if (flags & REPARENT) {
+ number = eventPtr->xreparent.x;
+ } else if (flags & CREATE) {
+ number = eventPtr->xcreatewindow.x;
+ } else if (flags & CONFIGREQ) {
+ number = eventPtr->xconfigurerequest.x;
+ } else {
+ goto doString;
+ }
+ goto doNumber;
+ case 'y':
+ if (flags & KEY_BUTTON_MOTION_VIRTUAL) {
+ number = eventPtr->xkey.y;
+ } else if (flags & EXPOSE) {
+ number = eventPtr->xexpose.y;
+ } else if (flags & (CREATE|CONFIG|GRAVITY)) {
+ number = eventPtr->xcreatewindow.y;
+ } else if (flags & REPARENT) {
+ number = eventPtr->xreparent.y;
+ } else if (flags & CROSSING) {
+ number = eventPtr->xcrossing.y;
+ } else if (flags & CREATE) {
+ number = eventPtr->xcreatewindow.y;
+ } else if (flags & CONFIGREQ) {
+ number = eventPtr->xconfigurerequest.y;
+ } else {
+ goto doString;
+ }
+ goto doNumber;
+ case 'A':
+ if ((flags & KEY) && (eventPtr->type != MouseWheelEvent)) {
+ Tcl_DStringFree(&buf);
+ string = TkpGetString(winPtr, eventPtr, &buf);
+ }
+ goto doString;
+ case 'B':
+ if (flags & CREATE) {
+ number = eventPtr->xcreatewindow.border_width;
+ } else if (flags & CONFIGREQ) {
+ number = eventPtr->xconfigurerequest.border_width;
+ } else if (flags & CONFIG) {
+ number = eventPtr->xconfigure.border_width;
+ } else {
+ goto doString;
+ }
+ goto doNumber;
+ case 'D':
+ /*
+ * This is used only by the MouseWheel event.
+ */
+
+ if ((flags & KEY) && (eventPtr->type == MouseWheelEvent)) {
+ number = eventPtr->xkey.keycode;
+ goto doNumber;
+ }
+ goto doString;
+ case 'E':
+ number = (int) eventPtr->xany.send_event;
+ goto doNumber;
+ case 'K':
+ if ((flags & KEY) && (eventPtr->type != MouseWheelEvent)) {
+ const char *name = TkKeysymToString(keySym);
+
+ if (name != NULL) {
+ string = name;
+ }
+ }
+ goto doString;
+ case 'M':
+ number = scriptCount;
+ goto doNumber;
+ case 'N':
+ if ((flags & KEY) && (eventPtr->type != MouseWheelEvent)) {
+ number = (int) keySym;
+ goto doNumber;
+ }
+ goto doString;
+ case 'P':
+ if (flags & PROP) {
+ string = Tk_GetAtomName((Tk_Window) winPtr,
+ eventPtr->xproperty.atom);
+ }
+ goto doString;
+ case 'R':
+ if (flags & KEY_BUTTON_MOTION_CROSSING) {
+ TkpPrintWindowId(numStorage, eventPtr->xkey.root);
+ string = numStorage;
+ }
+ goto doString;
+ case 'S':
+ if (flags & KEY_BUTTON_MOTION_CROSSING) {
+ TkpPrintWindowId(numStorage, eventPtr->xkey.subwindow);
+ string = numStorage;
+ }
+ goto doString;
+ case 'T':
+ number = eventPtr->type;
+ goto doNumber;
+ case 'W': {
+ Tk_Window tkwin;
+
+ tkwin = Tk_IdToWindow(eventPtr->xany.display,
+ eventPtr->xany.window);
+ if (tkwin != NULL) {
+ string = Tk_PathName(tkwin);
+ } else {
+ string = "??";
+ }
+ goto doString;
+ }
+ case 'X':
+ if (flags & KEY_BUTTON_MOTION_CROSSING) {
+
+ number = eventPtr->xkey.x_root;
+ Tk_IdToWindow(eventPtr->xany.display,
+ eventPtr->xany.window);
+ goto doNumber;
+ }
+ goto doString;
+ case 'Y':
+ if (flags & KEY_BUTTON_MOTION_CROSSING) {
+
+ number = eventPtr->xkey.y_root;
+ Tk_IdToWindow(eventPtr->xany.display,
+ eventPtr->xany.window);
+ goto doNumber;
+ }
+ goto doString;
+ default:
+ numStorage[0] = before[1];
+ numStorage[1] = '\0';
+ string = numStorage;
+ goto doString;
+ }
+
+ doNumber:
+ sprintf(numStorage, "%d", number);
+ string = numStorage;
+
+ doString:
+ spaceNeeded = Tcl_ScanElement(string, &cvtFlags);
+ length = Tcl_DStringLength(dsPtr);
+ Tcl_DStringSetLength(dsPtr, length + spaceNeeded);
+ spaceNeeded = Tcl_ConvertElement(string,
+ Tcl_DStringValue(dsPtr) + length,
+ cvtFlags | TCL_DONT_USE_BRACES);
+ Tcl_DStringSetLength(dsPtr, length + spaceNeeded);
+ before += 2;
+ }
+ Tcl_DStringFree(&buf);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ChangeScreen --
+ *
+ * This function is invoked whenever the current screen changes in an
+ * application. It invokes a Tcl command named "tk::ScreenChanged",
+ * passing it the screen name as argument. tk::ScreenChanged does things
+ * like making the tk::Priv variable point to an array for the current
+ * display.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Depends on what tk::ScreenChanged does. If an error occurs then
+ * bgerror will be invoked.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+ChangeScreen(
+ Tcl_Interp *interp, /* Interpreter in which to invoke command. */
+ char *dispName, /* Name of new display. */
+ int screenIndex) /* Index of new screen. */
+{
+ Tcl_Obj *cmdObj = Tcl_ObjPrintf("::tk::ScreenChanged %s.%d",
+ dispName, screenIndex);
+ int code;
+
+ Tcl_IncrRefCount(cmdObj);
+ code = Tcl_EvalObjEx(interp, cmdObj, TCL_EVAL_GLOBAL);
+ if (code != TCL_OK) {
+ Tcl_AddErrorInfo(interp,
+ "\n (changing screen in event binding)");
+ Tcl_BackgroundException(interp, code);
+ }
+ Tcl_DecrRefCount(cmdObj);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_EventCmd --
+ *
+ * This function is invoked to process the "event" Tcl command. It is
+ * used to define and generate events.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * See the user documentation.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tk_EventObjCmd(
+ ClientData clientData, /* Main window associated with interpreter. */
+ Tcl_Interp *interp, /* Current interpreter. */
+ int objc, /* Number of arguments. */
+ Tcl_Obj *const objv[]) /* Argument objects. */
+{
+ int index, i;
+ char *name;
+ const char *event;
+ Tk_Window tkwin = clientData;
+ TkBindInfo bindInfo = ((TkWindow *) tkwin)->mainPtr->bindInfo;
+ VirtualEventTable *vetPtr = &bindInfo->virtualEventTable;
+ static const char *const optionStrings[] = {
+ "add", "delete", "generate", "info",
+ NULL
+ };
+ enum options {
+ EVENT_ADD, EVENT_DELETE, EVENT_GENERATE, EVENT_INFO
+ };
+
+
+ if (objc < 2) {
+ Tcl_WrongNumArgs(interp, 1, objv, "option ?arg?");
+ return TCL_ERROR;
+ }
+ if (Tcl_GetIndexFromObjStruct(interp, objv[1], optionStrings,
+ sizeof(char *), "option", 0, &index) != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ switch ((enum options) index) {
+ case EVENT_ADD:
+ if (objc < 4) {
+ Tcl_WrongNumArgs(interp, 2, objv,
+ "virtual sequence ?sequence ...?");
+ return TCL_ERROR;
+ }
+ name = Tcl_GetString(objv[2]);
+ for (i = 3; i < objc; i++) {
+ event = Tcl_GetString(objv[i]);
+ if (CreateVirtualEvent(interp, vetPtr, name, event) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ }
+ break;
+ case EVENT_DELETE:
+ if (objc < 3) {
+ Tcl_WrongNumArgs(interp, 2, objv, "virtual ?sequence ...?");
+ return TCL_ERROR;
+ }
+ name = Tcl_GetString(objv[2]);
+ if (objc == 3) {
+ return DeleteVirtualEvent(interp, vetPtr, name, NULL);
+ }
+ for (i = 3; i < objc; i++) {
+ event = Tcl_GetString(objv[i]);
+ if (DeleteVirtualEvent(interp, vetPtr, name, event) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ }
+ break;
+ case EVENT_GENERATE:
+ if (objc < 4) {
+ Tcl_WrongNumArgs(interp, 2, objv,
+ "window event ?-option value ...?");
+ return TCL_ERROR;
+ }
+ return HandleEventGenerate(interp, tkwin, objc - 2, objv + 2);
+ case EVENT_INFO:
+ if (objc == 2) {
+ GetAllVirtualEvents(interp, vetPtr);
+ return TCL_OK;
+ } else if (objc == 3) {
+ return GetVirtualEvent(interp, vetPtr, objv[2]);
+ } else {
+ Tcl_WrongNumArgs(interp, 2, objv, "?virtual?");
+ return TCL_ERROR;
+ }
+ }
+ return TCL_OK;
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * InitVirtualEventTable --
+ *
+ * Given storage for a virtual event table, set up the fields to prepare
+ * a new domain in which virtual events may be defined.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * *vetPtr is now initialized.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+static void
+InitVirtualEventTable(
+ VirtualEventTable *vetPtr) /* Pointer to virtual event table. Memory is
+ * supplied by the caller. */
+{
+ Tcl_InitHashTable(&vetPtr->patternTable,
+ sizeof(PatternTableKey) / sizeof(int));
+ Tcl_InitHashTable(&vetPtr->nameTable, TCL_ONE_WORD_KEYS);
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * DeleteVirtualEventTable --
+ *
+ * Delete the contents of a virtual event table. The caller is
+ * responsible for freeing any memory used by the table itself.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Memory is freed.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+static void
+DeleteVirtualEventTable(
+ VirtualEventTable *vetPtr) /* The virtual event table to delete. */
+{
+ Tcl_HashEntry *hPtr;
+ Tcl_HashSearch search;
+ PatSeq *psPtr, *nextPtr;
+
+ hPtr = Tcl_FirstHashEntry(&vetPtr->patternTable, &search);
+ for ( ; hPtr != NULL; hPtr = Tcl_NextHashEntry(&search)) {
+ psPtr = Tcl_GetHashValue(hPtr);
+ for ( ; psPtr != NULL; psPtr = nextPtr) {
+ nextPtr = psPtr->nextSeqPtr;
+ ckfree(psPtr->voPtr);
+ ckfree(psPtr);
+ }
+ }
+ Tcl_DeleteHashTable(&vetPtr->patternTable);
+
+ hPtr = Tcl_FirstHashEntry(&vetPtr->nameTable, &search);
+ for ( ; hPtr != NULL; hPtr = Tcl_NextHashEntry(&search)) {
+ ckfree(Tcl_GetHashValue(hPtr));
+ }
+ Tcl_DeleteHashTable(&vetPtr->nameTable);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * CreateVirtualEvent --
+ *
+ * Add a new definition for a virtual event. If the virtual event is
+ * already defined, the new definition augments those that already exist.
+ *
+ * Results:
+ * The return value is TCL_ERROR if an error occured while creating the
+ * virtual binding. In this case, an error message will be left in the
+ * interp's result. If all went well then the return value is TCL_OK.
+ *
+ * Side effects:
+ * The virtual event may cause future calls to Tk_BindEvent to behave
+ * differently than they did previously.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+CreateVirtualEvent(
+ Tcl_Interp *interp, /* Used for error reporting. */
+ VirtualEventTable *vetPtr, /* Table in which to augment virtual event. */
+ char *virtString, /* Name of new virtual event. */
+ const char *eventString) /* String describing physical event that
+ * triggers virtual event. */
+{
+ PatSeq *psPtr;
+ int dummy;
+ Tcl_HashEntry *vhPtr;
+ unsigned long eventMask;
+ PhysicalsOwned *poPtr;
+ VirtualOwners *voPtr;
+ Tk_Uid virtUid;
+
+ virtUid = GetVirtualEventUid(interp, virtString);
+ if (virtUid == NULL) {
+ return TCL_ERROR;
+ }
+
+ /*
+ * Find/create physical event
+ */
+
+ psPtr = FindSequence(interp, &vetPtr->patternTable, NULL, eventString,
+ 1, 0, &eventMask);
+ if (psPtr == NULL) {
+ return TCL_ERROR;
+ }
+
+ /*
+ * Find/create virtual event.
+ */
+
+ vhPtr = Tcl_CreateHashEntry(&vetPtr->nameTable, virtUid, &dummy);
+
+ /*
+ * Make virtual event own the physical event.
+ */
+
+ poPtr = Tcl_GetHashValue(vhPtr);
+ if (poPtr == NULL) {
+ poPtr = ckalloc(sizeof(PhysicalsOwned));
+ poPtr->numOwned = 0;
+ } else {
+ /*
+ * See if this virtual event is already defined for this physical
+ * event and just return if it is.
+ */
+
+ int i;
+
+ for (i = 0; i < poPtr->numOwned; i++) {
+ if (poPtr->patSeqs[i] == psPtr) {
+ return TCL_OK;
+ }
+ }
+ poPtr = ckrealloc(poPtr, sizeof(PhysicalsOwned)
+ + poPtr->numOwned * sizeof(PatSeq *));
+ }
+ Tcl_SetHashValue(vhPtr, poPtr);
+ poPtr->patSeqs[poPtr->numOwned] = psPtr;
+ poPtr->numOwned++;
+
+ /*
+ * Make physical event so it can trigger the virtual event.
+ */
+
+ voPtr = psPtr->voPtr;
+ if (voPtr == NULL) {
+ voPtr = ckalloc(sizeof(VirtualOwners));
+ voPtr->numOwners = 0;
+ } else {
+ voPtr = ckrealloc(voPtr, sizeof(VirtualOwners)
+ + voPtr->numOwners * sizeof(Tcl_HashEntry *));
+ }
+ psPtr->voPtr = voPtr;
+ voPtr->owners[voPtr->numOwners] = vhPtr;
+ voPtr->numOwners++;
+
+ return TCL_OK;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * DeleteVirtualEvent --
+ *
+ * Remove the definition of a given virtual event. If the event string is
+ * NULL, all definitions of the virtual event will be removed.
+ * Otherwise, just the specified definition of the virtual event will be
+ * removed.
+ *
+ * Results:
+ * The result is a standard Tcl return value. If an error occurs then the
+ * interp's result will contain an error message. It is not an error to
+ * attempt to delete a virtual event that does not exist or a definition
+ * that does not exist.
+ *
+ * Side effects:
+ * The virtual event given by virtString may be removed from the virtual
+ * event table.
+ *
+ *--------------------------------------------------------------
+ */
+
+static int
+DeleteVirtualEvent(
+ Tcl_Interp *interp, /* Used for error reporting. */
+ VirtualEventTable *vetPtr, /* Table in which to delete event. */
+ char *virtString, /* String describing event sequence that
+ * triggers binding. */
+ const char *eventString) /* The event sequence that should be deleted,
+ * or NULL to delete all event sequences for
+ * the entire virtual event. */
+{
+ int iPhys;
+ Tk_Uid virtUid;
+ Tcl_HashEntry *vhPtr;
+ PhysicalsOwned *poPtr;
+ PatSeq *eventPSPtr;
+
+ virtUid = GetVirtualEventUid(interp, virtString);
+ if (virtUid == NULL) {
+ return TCL_ERROR;
+ }
+
+ vhPtr = Tcl_FindHashEntry(&vetPtr->nameTable, virtUid);
+ if (vhPtr == NULL) {
+ return TCL_OK;
+ }
+ poPtr = Tcl_GetHashValue(vhPtr);
+
+ eventPSPtr = NULL;
+ if (eventString != NULL) {
+ unsigned long eventMask;
+
+ /*
+ * Delete only the specific physical event associated with the virtual
+ * event. If the physical event doesn't already exist, or the virtual
+ * event doesn't own that physical event, return w/o doing anything.
+ */
+
+ eventPSPtr = FindSequence(interp, &vetPtr->patternTable, NULL,
+ eventString, 0, 0, &eventMask);
+ if (eventPSPtr == NULL) {
+ const char *string = Tcl_GetString(Tcl_GetObjResult(interp));
+
+ return (string[0] != '\0') ? TCL_ERROR : TCL_OK;
+ }
+ }
+
+ for (iPhys = poPtr->numOwned; --iPhys >= 0; ) {
+ PatSeq *psPtr = poPtr->patSeqs[iPhys];
+
+ if ((eventPSPtr == NULL) || (psPtr == eventPSPtr)) {
+ int iVirt;
+ VirtualOwners *voPtr;
+
+ /*
+ * Remove association between this physical event and the given
+ * virtual event that it triggers.
+ */
+
+ voPtr = psPtr->voPtr;
+ for (iVirt = 0; iVirt < voPtr->numOwners; iVirt++) {
+ if (voPtr->owners[iVirt] == vhPtr) {
+ break;
+ }
+ }
+ if (iVirt == voPtr->numOwners) {
+ Tcl_Panic("DeleteVirtualEvent: couldn't find owner");
+ }
+ voPtr->numOwners--;
+ if (voPtr->numOwners == 0) {
+ /*
+ * Removed last reference to this physical event, so remove it
+ * from physical->virtual map.
+ */
+
+ PatSeq *prevPtr = Tcl_GetHashValue(psPtr->hPtr);
+
+ if (prevPtr == psPtr) {
+ if (psPtr->nextSeqPtr == NULL) {
+ Tcl_DeleteHashEntry(psPtr->hPtr);
+ } else {
+ Tcl_SetHashValue(psPtr->hPtr,
+ psPtr->nextSeqPtr);
+ }
+ } else {
+ for ( ; ; prevPtr = prevPtr->nextSeqPtr) {
+ if (prevPtr == NULL) {
+ Tcl_Panic("DeleteVirtualEvent couldn't find on hash chain");
+ }
+ if (prevPtr->nextSeqPtr == psPtr) {
+ prevPtr->nextSeqPtr = psPtr->nextSeqPtr;
+ break;
+ }
+ }
+ }
+ ckfree(psPtr->voPtr);
+ ckfree(psPtr);
+ } else {
+ /*
+ * This physical event still triggers some other virtual
+ * event(s). Consolidate the list of virtual owners for this
+ * physical event so it no longer triggers the given virtual
+ * event.
+ */
+
+ voPtr->owners[iVirt] = voPtr->owners[voPtr->numOwners];
+ }
+
+ /*
+ * Now delete the virtual event's reference to the physical event.
+ */
+
+ poPtr->numOwned--;
+ if (eventPSPtr != NULL && poPtr->numOwned != 0) {
+ /*
+ * Just deleting this one physical event. Consolidate list of
+ * owned physical events and return.
+ */
+
+ poPtr->patSeqs[iPhys] = poPtr->patSeqs[poPtr->numOwned];
+ return TCL_OK;
+ }
+ }
+ }
+
+ if (poPtr->numOwned == 0) {
+ /*
+ * All the physical events for this virtual event were deleted, either
+ * because there was only one associated physical event or because the
+ * caller was deleting the entire virtual event. Now the virtual event
+ * itself should be deleted.
+ */
+
+ ckfree(poPtr);
+ Tcl_DeleteHashEntry(vhPtr);
+ }
+ return TCL_OK;
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * GetVirtualEvent --
+ *
+ * Return the list of physical events that can invoke the given virtual
+ * event.
+ *
+ * Results:
+ * The return value is TCL_OK and the interp's result is filled with the
+ * string representation of the physical events associated with the
+ * virtual event; if there are no physical events for the given virtual
+ * event, the interp's result is filled with and empty string. If the
+ * virtual event string is improperly formed, then TCL_ERROR is returned
+ * and an error message is left in the interp's result.
+ *
+ * Side effects:
+ * None.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+static int
+GetVirtualEvent(
+ Tcl_Interp *interp, /* Interpreter for reporting. */
+ VirtualEventTable *vetPtr, /* Table in which to look for event. */
+ Tcl_Obj *virtName) /* String describing virtual event. */
+{
+ Tcl_HashEntry *vhPtr;
+ int iPhys;
+ PhysicalsOwned *poPtr;
+ Tk_Uid virtUid;
+ Tcl_Obj *resultObj;
+
+ virtUid = GetVirtualEventUid(interp, Tcl_GetString(virtName));
+ if (virtUid == NULL) {
+ return TCL_ERROR;
+ }
+
+ vhPtr = Tcl_FindHashEntry(&vetPtr->nameTable, virtUid);
+ if (vhPtr == NULL) {
+ return TCL_OK;
+ }
+
+ resultObj = Tcl_NewObj();
+ poPtr = Tcl_GetHashValue(vhPtr);
+ for (iPhys = 0; iPhys < poPtr->numOwned; iPhys++) {
+ Tcl_ListObjAppendElement(NULL, resultObj,
+ GetPatternObj(poPtr->patSeqs[iPhys]));
+ }
+ Tcl_SetObjResult(interp, resultObj);
+
+ return TCL_OK;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * GetAllVirtualEvents --
+ *
+ * Return a list that contains the names of all the virtual event
+ * defined.
+ *
+ * Results:
+ * There is no return value. The interp's result is modified to hold a
+ * Tcl list with one entry for each virtual event in nameTable.
+ *
+ * Side effects:
+ * None.
+ *
+ *--------------------------------------------------------------
+ */
+
+static void
+GetAllVirtualEvents(
+ Tcl_Interp *interp, /* Interpreter returning result. */
+ VirtualEventTable *vetPtr) /* Table containing events. */
+{
+ Tcl_HashEntry *hPtr;
+ Tcl_HashSearch search;
+ Tcl_Obj *resultObj;
+
+ resultObj = Tcl_NewObj();
+ hPtr = Tcl_FirstHashEntry(&vetPtr->nameTable, &search);
+ for ( ; hPtr != NULL; hPtr = Tcl_NextHashEntry(&search)) {
+ Tcl_ListObjAppendElement(NULL, resultObj, Tcl_ObjPrintf(
+ "<<%s>>", (char *) Tcl_GetHashKey(hPtr->tablePtr, hPtr)));
+ }
+ Tcl_SetObjResult(interp, resultObj);
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * HandleEventGenerate --
+ *
+ * Helper function for the "event generate" command. Generate and process
+ * an XEvent, constructed from information parsed from the event
+ * description string and its optional arguments.
+ *
+ * argv[0] contains name of the target window.
+ * argv[1] contains pattern string for one event (e.g, <Control-v>).
+ * argv[2..argc-1] contains -field/option pairs for specifying additional
+ * detail in the generated event.
+ *
+ * Either virtual or physical events can be generated this way. The event
+ * description string must contain the specification for only one event.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * When constructing the event,
+ * event.xany.serial is filled with the current X serial number.
+ * event.xany.window is filled with the target window.
+ * event.xany.display is filled with the target window's display.
+ * Any other fields in eventPtr which are not specified by the pattern
+ * string or the optional arguments, are set to 0.
+ *
+ * The event may be handled sychronously or asynchronously, depending on
+ * the value specified by the optional "-when" option. The default
+ * setting is synchronous.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+static int
+HandleEventGenerate(
+ 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. */
+{
+ union {XEvent general; XVirtualEvent virtual;} event;
+ const char *p;
+ const char *name, *windowName;
+ int count, flags, synch, i, number, warp;
+ Tcl_QueuePosition pos;
+ TkPattern pat;
+ Tk_Window tkwin, tkwin2;
+ TkWindow *mainPtr;
+ unsigned long eventMask;
+ Tcl_Obj *userDataObj;
+
+ static const char *const fieldStrings[] = {
+ "-when", "-above", "-borderwidth", "-button",
+ "-count", "-data", "-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_DATA, 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_GetString(objv[0]);
+ if (!windowName[0]) {
+ tkwin = mainWin;
+ } else if (NameToWindow(interp, mainWin, objv[0], &tkwin) != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ mainPtr = (TkWindow *) mainWin;
+ if ((tkwin == NULL)
+ || (mainPtr->mainPtr != ((TkWindow *) tkwin)->mainPtr)) {
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "window id \"%s\" doesn't exist in this application",
+ Tcl_GetString(objv[0])));
+ Tcl_SetErrorCode(interp, "TK", "LOOKUP", "WINDOW",
+ Tcl_GetString(objv[0]), NULL);
+ return TCL_ERROR;
+ }
+
+ name = Tcl_GetString(objv[1]);
+
+ p = name;
+ eventMask = 0;
+ userDataObj = NULL;
+ count = ParseEventDescription(interp, &p, &pat, &eventMask);
+ if (count == 0) {
+ return TCL_ERROR;
+ }
+ if (count != 1) {
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "Double or Triple modifier not allowed", -1));
+ Tcl_SetErrorCode(interp, "TK", "EVENT", "BAD_MODIFIER", NULL);
+ return TCL_ERROR;
+ }
+ if (*p != '\0') {
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "only one event specification allowed", -1));
+ Tcl_SetErrorCode(interp, "TK", "EVENT", "MULTIPLE", NULL);
+ return TCL_ERROR;
+ }
+
+ memset(&event, 0, sizeof(event));
+ event.general.xany.type = pat.eventType;
+ event.general.xany.serial = NextRequest(Tk_Display(tkwin));
+ event.general.xany.send_event = False;
+ if (windowName[0]) {
+ event.general.xany.window = Tk_WindowId(tkwin);
+ } else {
+ event.general.xany.window =
+ RootWindow(Tk_Display(tkwin), Tk_ScreenNumber(tkwin));
+ }
+ event.general.xany.display = Tk_Display(tkwin);
+
+ flags = flagArray[event.general.xany.type];
+ if (flags & DESTROY) {
+ /*
+ * Event DestroyNotify should be generated by destroying the window.
+ */
+
+ Tk_DestroyWindow(tkwin);
+ return TCL_OK;
+ }
+ if (flags & KEY_BUTTON_MOTION_VIRTUAL) {
+ event.general.xkey.state = pat.needMods;
+ if ((flags & KEY) && (event.general.xany.type != MouseWheelEvent)) {
+ TkpSetKeycodeAndState(tkwin, pat.detail.keySym, &event.general);
+ } else if (flags & BUTTON) {
+ event.general.xbutton.button = pat.detail.button;
+ } else if (flags & VIRTUAL) {
+ event.virtual.name = pat.detail.name;
+ }
+ }
+ if (flags & (CREATE|UNMAP|MAP|REPARENT|CONFIG|GRAVITY|CIRC)) {
+ event.general.xcreatewindow.window = event.general.xany.window;
+ }
+
+ if (flags & KEY_BUTTON_MOTION_CROSSING) {
+ event.general.xkey.x_root = -1;
+ event.general.xkey.y_root = -1;
+ }
+
+ if (event.general.xany.type == FocusIn
+ || event.general.xany.type == FocusOut) {
+ event.general.xany.send_event = GENERATED_FOCUS_EVENT_MAGIC;
+ }
+
+ /*
+ * Process the remaining arguments to fill in additional fields of the
+ * event.
+ */
+
+ synch = 1;
+ warp = 0;
+ pos = TCL_QUEUE_TAIL;
+ for (i = 2; i < objc; i += 2) {
+ Tcl_Obj *optionPtr, *valuePtr;
+ int index;
+
+ optionPtr = objv[i];
+ valuePtr = objv[i + 1];
+
+ if (Tcl_GetIndexFromObjStruct(interp, optionPtr, fieldStrings,
+ sizeof(char *), "option", TCL_EXACT, &index) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (objc & 1) {
+ /*
+ * This test occurs after Tcl_GetIndexFromObj() so that "event
+ * generate <Button> -xyz" will return the error message that
+ * "-xyz" is a bad option, rather than that the value for "-xyz"
+ * is missing.
+ */
+
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "value for \"%s\" missing", Tcl_GetString(optionPtr)));
+ Tcl_SetErrorCode(interp, "TK", "EVENT", "MISSING_VALUE", NULL);
+ return TCL_ERROR;
+ }
+
+ switch ((enum field) index) {
+ case EVENT_WARP:
+ if (Tcl_GetBooleanFromObj(interp, valuePtr, &warp) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (!(flags & KEY_BUTTON_MOTION_VIRTUAL)) {
+ goto badopt;
+ }
+ break;
+ case EVENT_WHEN:
+ pos = (Tcl_QueuePosition) TkFindStateNumObj(interp, optionPtr,
+ queuePosition, valuePtr);
+ if ((int) pos < -1) {
+ return TCL_ERROR;
+ }
+ synch = 0;
+ if ((int) pos == -1) {
+ synch = 1;
+ }
+ break;
+ case EVENT_ABOVE:
+ if (NameToWindow(interp, tkwin, valuePtr, &tkwin2) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (flags & CONFIG) {
+ event.general.xconfigure.above = Tk_WindowId(tkwin2);
+ } else {
+ goto badopt;
+ }
+ break;
+ case EVENT_BORDER:
+ if (Tk_GetPixelsFromObj(interp,tkwin,valuePtr,&number) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (flags & (CREATE|CONFIG)) {
+ event.general.xcreatewindow.border_width = number;
+ } else {
+ goto badopt;
+ }
+ break;
+ case EVENT_BUTTON:
+ if (Tcl_GetIntFromObj(interp, valuePtr, &number) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (flags & BUTTON) {
+ event.general.xbutton.button = number;
+ } else {
+ goto badopt;
+ }
+ break;
+ case EVENT_COUNT:
+ if (Tcl_GetIntFromObj(interp, valuePtr, &number) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (flags & EXPOSE) {
+ event.general.xexpose.count = number;
+ } else {
+ goto badopt;
+ }
+ break;
+ case EVENT_DATA:
+ if (flags & VIRTUAL) {
+ /*
+ * Do not increment reference count until after parsing
+ * completes and we know that the event generation is really
+ * going to happen.
+ */
+
+ userDataObj = valuePtr;
+ } else {
+ goto badopt;
+ }
+ break;
+ case EVENT_DELTA:
+ if (Tcl_GetIntFromObj(interp, valuePtr, &number) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if ((flags & KEY) && (event.general.xkey.type == MouseWheelEvent)) {
+ event.general.xkey.keycode = number;
+ } else {
+ goto badopt;
+ }
+ break;
+ case EVENT_DETAIL:
+ number = TkFindStateNumObj(interp, optionPtr, notifyDetail,
+ valuePtr);
+ if (number < 0) {
+ return TCL_ERROR;
+ }
+ if (flags & FOCUS) {
+ event.general.xfocus.detail = number;
+ } else if (flags & CROSSING) {
+ event.general.xcrossing.detail = number;
+ } else {
+ goto badopt;
+ }
+ break;
+ case EVENT_FOCUS:
+ if (Tcl_GetBooleanFromObj(interp, valuePtr, &number) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (flags & CROSSING) {
+ event.general.xcrossing.focus = number;
+ } else {
+ goto badopt;
+ }
+ break;
+ case EVENT_HEIGHT:
+ if (Tk_GetPixelsFromObj(interp, tkwin, valuePtr,
+ &number) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (flags & EXPOSE) {
+ event.general.xexpose.height = number;
+ } else if (flags & CONFIG) {
+ event.general.xconfigure.height = number;
+ } else {
+ goto badopt;
+ }
+ break;
+ case EVENT_KEYCODE:
+ if (Tcl_GetIntFromObj(interp, valuePtr, &number) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if ((flags & KEY) && (event.general.xkey.type != MouseWheelEvent)) {
+ event.general.xkey.keycode = number;
+ } else {
+ goto badopt;
+ }
+ break;
+ case EVENT_KEYSYM: {
+ KeySym keysym;
+ const char *value;
+
+ value = Tcl_GetString(valuePtr);
+ keysym = TkStringToKeysym(value);
+ if (keysym == NoSymbol) {
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "unknown keysym \"%s\"", value));
+ Tcl_SetErrorCode(interp, "TK", "LOOKUP", "KEYSYM", value,
+ NULL);
+ return TCL_ERROR;
+ }
+
+ TkpSetKeycodeAndState(tkwin, keysym, &event.general);
+ if (event.general.xkey.keycode == 0) {
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "no keycode for keysym \"%s\"", value));
+ Tcl_SetErrorCode(interp, "TK", "LOOKUP", "KEYCODE", value,
+ NULL);
+ return TCL_ERROR;
+ }
+ if (!(flags & KEY)
+ || (event.general.xkey.type == MouseWheelEvent)) {
+ goto badopt;
+ }
+ break;
+ }
+ case EVENT_MODE:
+ number = TkFindStateNumObj(interp,optionPtr,notifyMode,valuePtr);
+ if (number < 0) {
+ return TCL_ERROR;
+ }
+ if (flags & CROSSING) {
+ event.general.xcrossing.mode = number;
+ } else if (flags & FOCUS) {
+ event.general.xfocus.mode = number;
+ } else {
+ goto badopt;
+ }
+ break;
+ case EVENT_OVERRIDE:
+ if (Tcl_GetBooleanFromObj(interp, valuePtr, &number) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (flags & CREATE) {
+ event.general.xcreatewindow.override_redirect = number;
+ } else if (flags & MAP) {
+ event.general.xmap.override_redirect = number;
+ } else if (flags & REPARENT) {
+ event.general.xreparent.override_redirect = number;
+ } else if (flags & CONFIG) {
+ event.general.xconfigure.override_redirect = number;
+ } else {
+ goto badopt;
+ }
+ break;
+ case EVENT_PLACE:
+ number = TkFindStateNumObj(interp, optionPtr, circPlace, valuePtr);
+ if (number < 0) {
+ return TCL_ERROR;
+ }
+ if (flags & CIRC) {
+ event.general.xcirculate.place = number;
+ } else {
+ goto badopt;
+ }
+ break;
+ case EVENT_ROOT:
+ if (NameToWindow(interp, tkwin, valuePtr, &tkwin2) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (flags & KEY_BUTTON_MOTION_CROSSING) {
+ event.general.xkey.root = Tk_WindowId(tkwin2);
+ } else {
+ goto badopt;
+ }
+ break;
+ case EVENT_ROOTX:
+ if (Tk_GetPixelsFromObj(interp,tkwin,valuePtr,&number) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (flags & KEY_BUTTON_MOTION_CROSSING) {
+ event.general.xkey.x_root = number;
+ } else {
+ goto badopt;
+ }
+ break;
+ case EVENT_ROOTY:
+ if (Tk_GetPixelsFromObj(interp,tkwin,valuePtr,&number) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (flags & KEY_BUTTON_MOTION_CROSSING) {
+ event.general.xkey.y_root = number;
+ } else {
+ goto badopt;
+ }
+ break;
+ case EVENT_SEND: {
+ const char *value;
+
+ value = Tcl_GetString(valuePtr);
+ 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.general.xany.send_event = number;
+ break;
+ }
+ case EVENT_SERIAL:
+ if (Tcl_GetIntFromObj(interp, valuePtr, &number) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ event.general.xany.serial = number;
+ break;
+ case EVENT_STATE:
+ if (flags & KEY_BUTTON_MOTION_CROSSING) {
+ if (Tcl_GetIntFromObj(interp, valuePtr, &number) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (flags & KEY_BUTTON_MOTION_VIRTUAL) {
+ event.general.xkey.state = number;
+ } else {
+ event.general.xcrossing.state = number;
+ }
+ } else if (flags & VISIBILITY) {
+ number = TkFindStateNumObj(interp, optionPtr, visNotify,
+ valuePtr);
+ if (number < 0) {
+ return TCL_ERROR;
+ }
+ event.general.xvisibility.state = number;
+ } else {
+ goto badopt;
+ }
+ break;
+ case EVENT_SUBWINDOW:
+ if (NameToWindow(interp, tkwin, valuePtr, &tkwin2) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (flags & KEY_BUTTON_MOTION_CROSSING) {
+ event.general.xkey.subwindow = Tk_WindowId(tkwin2);
+ } else {
+ goto badopt;
+ }
+ break;
+ case EVENT_TIME:
+ if (Tcl_GetIntFromObj(interp, valuePtr, &number) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (flags & KEY_BUTTON_MOTION_CROSSING) {
+ event.general.xkey.time = (Time) number;
+ } else if (flags & PROP) {
+ event.general.xproperty.time = (Time) number;
+ } else {
+ goto badopt;
+ }
+ break;
+ case EVENT_WIDTH:
+ if (Tk_GetPixelsFromObj(interp,tkwin,valuePtr,&number) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (flags & EXPOSE) {
+ event.general.xexpose.width = number;
+ } else if (flags & (CREATE|CONFIG)) {
+ event.general.xcreatewindow.width = number;
+ } else {
+ goto badopt;
+ }
+ break;
+ case EVENT_WINDOW:
+ if (NameToWindow(interp, tkwin, valuePtr, &tkwin2) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (flags & (CREATE|UNMAP|MAP|REPARENT|CONFIG|GRAVITY|CIRC)) {
+ event.general.xcreatewindow.window = Tk_WindowId(tkwin2);
+ } else {
+ goto badopt;
+ }
+ break;
+ case EVENT_X:
+ if (Tk_GetPixelsFromObj(interp,tkwin,valuePtr,&number) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (flags & KEY_BUTTON_MOTION_CROSSING) {
+ event.general.xkey.x = number;
+
+ /*
+ * Only modify rootx as well if it hasn't been changed.
+ */
+
+ if (event.general.xkey.x_root == -1) {
+ int rootX, rootY;
+
+ Tk_GetRootCoords(tkwin, &rootX, &rootY);
+ event.general.xkey.x_root = rootX + number;
+ }
+ } else if (flags & EXPOSE) {
+ event.general.xexpose.x = number;
+ } else if (flags & (CREATE|CONFIG|GRAVITY)) {
+ event.general.xcreatewindow.x = number;
+ } else if (flags & REPARENT) {
+ event.general.xreparent.x = number;
+ } else {
+ goto badopt;
+ }
+ break;
+ case EVENT_Y:
+ if (Tk_GetPixelsFromObj(interp,tkwin,valuePtr,&number) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (flags & KEY_BUTTON_MOTION_CROSSING) {
+ event.general.xkey.y = number;
+
+ /*
+ * Only modify rooty as well if it hasn't been changed.
+ */
+
+ if (event.general.xkey.y_root == -1) {
+ int rootX, rootY;
+
+ Tk_GetRootCoords(tkwin, &rootX, &rootY);
+ event.general.xkey.y_root = rootY + number;
+ }
+ } else if (flags & EXPOSE) {
+ event.general.xexpose.y = number;
+ } else if (flags & (CREATE|CONFIG|GRAVITY)) {
+ event.general.xcreatewindow.y = number;
+ } else if (flags & REPARENT) {
+ event.general.xreparent.y = number;
+ } else {
+ goto badopt;
+ }
+ break;
+ }
+ continue;
+
+ badopt:
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "%s event doesn't accept \"%s\" option",
+ name, Tcl_GetString(optionPtr)));
+ Tcl_SetErrorCode(interp, "TK", "EVENT", "BAD_OPTION", NULL);
+ return TCL_ERROR;
+ }
+
+ /*
+ * Don't generate events for windows that don't exist yet.
+ */
+
+ if (!event.general.xany.window) {
+ goto done;
+ }
+
+ if (userDataObj != NULL) {
+
+ /*
+ * Must be virtual event to set that variable to non-NULL. Now we want
+ * to install the object into the event. Note that we must incr the
+ * refcount before firing it into the low-level event subsystem; the
+ * refcount will be decremented once the event has been processed.
+ */
+
+ event.virtual.user_data = userDataObj;
+ Tcl_IncrRefCount(userDataObj);
+ }
+
+ /*
+ * Now we have constructed the event, inject it into the event handling
+ * code.
+ */
+
+ if (synch != 0) {
+ Tk_HandleEvent(&event.general);
+ } else {
+ Tk_QueueWindowEvent(&event.general, pos);
+ }
+
+ /*
+ * We only allow warping if the window is mapped.
+ */
+
+ if ((warp != 0) && Tk_IsMapped(tkwin)) {
+ TkDisplay *dispPtr = TkGetDisplay(event.general.xmotion.display);
+
+ if (!(dispPtr->flags & TK_DISPLAY_IN_WARP)) {
+ Tcl_DoWhenIdle(DoWarp, dispPtr);
+ dispPtr->flags |= TK_DISPLAY_IN_WARP;
+ }
+ dispPtr->warpWindow = Tk_IdToWindow(Tk_Display(mainWin),
+ event.general.xmotion.window);
+ dispPtr->warpMainwin = mainWin;
+ dispPtr->warpX = event.general.xmotion.x;
+ dispPtr->warpY = event.general.xmotion.y;
+ }
+
+ done:
+ Tcl_ResetResult(interp);
+ return TCL_OK;
+}
+
+static int
+NameToWindow(
+ 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. */
+{
+ const char *name = Tcl_GetString(objPtr);
+ Tk_Window tkwin;
+
+ if (name[0] == '.') {
+ tkwin = Tk_NameToWindow(interp, name, mainWin);
+ if (tkwin == NULL) {
+ return TCL_ERROR;
+ }
+ } else {
+ Window id;
+
+ /*
+ * Check for the winPtr being valid, even if it looks ok to
+ * TkpScanWindowId. [Bug #411307]
+ */
+
+ if (TkpScanWindowId(NULL, name, &id) != TCL_OK) {
+ goto badWindow;
+ }
+ tkwin = Tk_IdToWindow(Tk_Display(mainWin), id);
+ if (tkwin == NULL) {
+ goto badWindow;
+ }
+ }
+ *tkwinPtr = tkwin;
+ return TCL_OK;
+
+ badWindow:
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "bad window name/identifier \"%s\"", name));
+ Tcl_SetErrorCode(interp, "TK", "LOOKUP", "WINDOW_ID", name, NULL);
+ return TCL_ERROR;
+}
+
+/*
+ *-------------------------------------------------------------------------
+ *
+ * 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)
+{
+ TkDisplay *dispPtr = clientData;
+
+ /*
+ * DoWarp was scheduled only if the window was mapped. It needs to be
+ * still mapped at the time the present idle callback is executed. Also
+ * one needs to guard against window destruction in the meantime.
+ * Finally, the case warpWindow == NULL is special in that it means
+ * the whole screen.
+ */
+
+ if ((dispPtr->warpWindow == NULL) ||
+ (Tk_IsMapped(dispPtr->warpWindow)
+ && (Tk_WindowId(dispPtr->warpWindow) != None))) {
+ TkpWarpPointer(dispPtr);
+ XForceScreenSaver(dispPtr->display, ScreenSaverReset);
+ }
+ dispPtr->flags &= ~TK_DISPLAY_IN_WARP;
+}
+
+/*
+ *-------------------------------------------------------------------------
+ *
+ * GetVirtualEventUid --
+ *
+ * Determine if the given string is in the proper format for a virtual
+ * event.
+ *
+ * Results:
+ * The return value is NULL if the virtual event string was not in the
+ * proper format. In this case, an error message will be left in the
+ * interp's result. Otherwise the return value is a Tk_Uid that
+ * represents the virtual event.
+ *
+ * Side effects:
+ * None.
+ *
+ *-------------------------------------------------------------------------
+ */
+
+static Tk_Uid
+GetVirtualEventUid(
+ Tcl_Interp *interp,
+ char *virtString)
+{
+ Tk_Uid uid;
+ size_t length;
+
+ length = strlen(virtString);
+
+ if (length < 5 || virtString[0] != '<' || virtString[1] != '<' ||
+ virtString[length - 2] != '>' || virtString[length - 1] != '>') {
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "virtual event \"%s\" is badly formed", virtString));
+ Tcl_SetErrorCode(interp, "TK", "EVENT", "VIRTUAL", "MALFORMED", NULL);
+ return NULL;
+ }
+ virtString[length - 2] = '\0';
+ uid = Tk_GetUid(virtString + 2);
+ virtString[length - 2] = '>';
+
+ return uid;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * FindSequence --
+ *
+ * Find the entry in the pattern table that corresponds to a particular
+ * pattern string, and return a pointer to that entry.
+ *
+ * Results:
+ * The return value is normally a pointer to the PatSeq in patternTable
+ * that corresponds to eventString. If an error was found while parsing
+ * eventString, or if "create" is 0 and no pattern sequence previously
+ * existed, then NULL is returned and the interp's result contains a
+ * message describing the problem. If no pattern sequence previously
+ * existed for eventString, then a new one is created with a NULL command
+ * field. In a successful return, *maskPtr is filled in with a mask of
+ * the event types on which the pattern sequence depends.
+ *
+ * Side effects:
+ * A new pattern sequence may be allocated.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static PatSeq *
+FindSequence(
+ Tcl_Interp *interp, /* Interpreter to use for error reporting. */
+ Tcl_HashTable *patternTablePtr,
+ /* Table to use for lookup. */
+ ClientData object, /* For binding table, token for object with
+ * which binding is associated. For virtual
+ * event table, NULL. */
+ const char *eventString, /* String description of pattern to match on.
+ * See user documentation for details. */
+ int create, /* 0 means don't create the entry if it
+ * doesn't already exist. Non-zero means
+ * create. */
+ int allowVirtual, /* 0 means that virtual events are not allowed
+ * in the sequence. Non-zero otherwise. */
+ unsigned long *maskPtr) /* *maskPtr is filled in with the event types
+ * on which this pattern sequence depends. */
+{
+ TkPattern pats[EVENT_BUFFER_SIZE];
+ int numPats, virtualFound;
+ const char *p;
+ TkPattern *patPtr;
+ PatSeq *psPtr;
+ Tcl_HashEntry *hPtr;
+ int flags, count, isNew;
+ size_t sequenceSize;
+ unsigned long eventMask;
+ PatternTableKey key;
+
+ /*
+ *-------------------------------------------------------------
+ * Step 1: parse the pattern string to produce an array of Patterns. The
+ * array is generated backwards, so that the lowest-indexed pattern
+ * corresponds to the last event that must occur.
+ *-------------------------------------------------------------
+ */
+
+ p = eventString;
+ flags = 0;
+ eventMask = 0;
+ virtualFound = 0;
+
+ patPtr = &pats[EVENT_BUFFER_SIZE-1];
+ for (numPats = 0; numPats < EVENT_BUFFER_SIZE; numPats++, patPtr--) {
+ while (isspace(UCHAR(*p))) {
+ p++;
+ }
+ if (*p == '\0') {
+ break;
+ }
+
+ count = ParseEventDescription(interp, &p, patPtr, &eventMask);
+ if (count == 0) {
+ return NULL;
+ }
+
+ if (eventMask & VirtualEventMask) {
+ if (allowVirtual == 0) {
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "virtual event not allowed in definition of another virtual event",
+ -1));
+ Tcl_SetErrorCode(interp, "TK", "EVENT", "VIRTUAL", "INNER",
+ NULL);
+ return NULL;
+ }
+ virtualFound = 1;
+ }
+
+ /*
+ * Replicate events for DOUBLE, TRIPLE, QUADRUPLE.
+ */
+
+ while ((count-- > 1) && (numPats < EVENT_BUFFER_SIZE-1)) {
+ flags |= PAT_NEARBY;
+ patPtr[-1] = patPtr[0];
+ patPtr--;
+ numPats++;
+ }
+ }
+
+ /*
+ *-------------------------------------------------------------
+ * Step 2: find the sequence in the binding table if it exists, and add a
+ * new sequence to the table if it doesn't.
+ *-------------------------------------------------------------
+ */
+
+ if (numPats == 0) {
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "no events specified in binding", -1));
+ Tcl_SetErrorCode(interp, "TK", "EVENT", "NO_EVENTS", NULL);
+ return NULL;
+ }
+ if ((numPats > 1) && (virtualFound != 0)) {
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "virtual events may not be composed", -1));
+ Tcl_SetErrorCode(interp, "TK", "EVENT", "VIRTUAL", "COMPOSITION",
+ NULL);
+ return NULL;
+ }
+
+ patPtr = &pats[EVENT_BUFFER_SIZE-numPats];
+ memset(&key, 0, sizeof(key));
+ key.object = object;
+ key.type = patPtr->eventType;
+ key.detail = patPtr->detail;
+ hPtr = Tcl_CreateHashEntry(patternTablePtr, (char *) &key, &isNew);
+ sequenceSize = numPats*sizeof(TkPattern);
+ if (!isNew) {
+ for (psPtr = Tcl_GetHashValue(hPtr); psPtr != NULL;
+ psPtr = psPtr->nextSeqPtr) {
+ if ((numPats == psPtr->numPats)
+ && ((flags & PAT_NEARBY) == (psPtr->flags & PAT_NEARBY))
+ && (memcmp(patPtr, psPtr->pats, sequenceSize) == 0)) {
+ goto done;
+ }
+ }
+ }
+ if (!create) {
+ if (isNew) {
+ 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 = ckalloc(sizeof(PatSeq) + (numPats-1)*sizeof(TkPattern));
+ psPtr->numPats = numPats;
+ psPtr->script = NULL;
+ psPtr->flags = flags;
+ psPtr->nextSeqPtr = Tcl_GetHashValue(hPtr);
+ psPtr->hPtr = hPtr;
+ psPtr->voPtr = NULL;
+ psPtr->nextObjPtr = NULL;
+ Tcl_SetHashValue(hPtr, psPtr);
+
+ memcpy(psPtr->pats, patPtr, sequenceSize);
+
+ done:
+ *maskPtr = eventMask;
+ return psPtr;
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * ParseEventDescription --
+ *
+ * Fill Pattern buffer with information about event from event string.
+ *
+ * Results:
+ * Leaves error message in interp and returns 0 if there was an error due
+ * to a badly formed event string. Returns 1 if proper event was
+ * specified, 2 if Double modifier was used in event string, or 3 if
+ * Triple was used.
+ *
+ * Side effects:
+ * On exit, eventStringPtr points to rest of event string (after the
+ * closing '>', so that this function can be called repeatedly to parse
+ * all the events in the entire sequence.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+static int
+ParseEventDescription(
+ Tcl_Interp *interp, /* For error messages. */
+ const char **eventStringPtr,/* On input, holds a pointer to start of event
+ * string. On exit, gets pointer to rest of
+ * string after parsed event. */
+ TkPattern *patPtr, /* Filled with the pattern parsed from the
+ * event string. */
+ unsigned long *eventMaskPtr)/* Filled with event mask of matched event. */
+{
+ char *p;
+ unsigned long eventMask;
+ int count, eventFlags;
+#define FIELD_SIZE 48
+ char field[FIELD_SIZE];
+ Tcl_HashEntry *hPtr;
+ Tcl_DString copy;
+
+ Tcl_DStringInit(&copy);
+ p = Tcl_DStringAppend(&copy, *eventStringPtr, -1);
+
+ patPtr->eventType = -1;
+ patPtr->needMods = 0;
+ patPtr->detail.clientData = 0;
+
+ eventMask = 0;
+ count = 1;
+
+ /*
+ * Handle simple ASCII characters.
+ */
+
+ if (*p != '<') {
+ char string[2];
+
+ patPtr->eventType = KeyPress;
+ eventMask = KeyPressMask;
+ string[0] = *p;
+ string[1] = 0;
+ patPtr->detail.keySym = TkStringToKeysym(string);
+ if (patPtr->detail.keySym == NoSymbol) {
+ if (isprint(UCHAR(*p))) {
+ patPtr->detail.keySym = *p;
+ } else {
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "bad ASCII character 0x%x", UCHAR(*p)));
+ Tcl_SetErrorCode(interp, "TK", "EVENT", "BAD_CHAR", NULL);
+ count = 0;
+ goto done;
+ }
+ }
+ p++;
+ goto end;
+ }
+
+ /*
+ * A fancier event description. This can be either a virtual event or a
+ * physical event.
+ *
+ * A virtual event description consists of:
+ *
+ * 1. double open angle brackets.
+ * 2. virtual event name.
+ * 3. double close angle brackets.
+ *
+ * A physical event description consists of:
+ *
+ * 1. open angle bracket.
+ * 2. any number of modifiers, each followed by spaces or dashes.
+ * 3. an optional event name.
+ * 4. an option button or keysym name. Either this or item 3 *must* be
+ * present; if both are present then they are separated by spaces or
+ * dashes.
+ * 5. a close angle bracket.
+ */
+
+ p++;
+ if (*p == '<') {
+ /*
+ * This is a virtual event: soak up all the characters up to the next
+ * '>'.
+ */
+
+ char *field = p + 1;
+
+ p = strchr(field, '>');
+ if (p == field) {
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "virtual event \"<<>>\" is badly formed", -1));
+ Tcl_SetErrorCode(interp, "TK", "EVENT", "VIRTUAL", "MALFORMED",
+ NULL);
+ count = 0;
+ goto done;
+ }
+ if ((p == NULL) || (p[1] != '>')) {
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "missing \">\" in virtual binding", -1));
+ Tcl_SetErrorCode(interp, "TK", "EVENT", "VIRTUAL", "MALFORMED",
+ NULL);
+ count = 0;
+ goto done;
+ }
+ *p = '\0';
+ patPtr->eventType = VirtualEvent;
+ eventMask = VirtualEventMask;
+ patPtr->detail.name = Tk_GetUid(field);
+ *p = '>';
+
+ p += 2;
+ goto end;
+ }
+
+ while (1) {
+ ModInfo *modPtr;
+
+ p = GetField(p, field, FIELD_SIZE);
+ if (*p == '>') {
+ /*
+ * This solves the problem of, e.g., <Control-M> being
+ * misinterpreted as Control + Meta + missing keysym instead of
+ * Control + KeyPress + M.
+ */
+
+ break;
+ }
+ hPtr = Tcl_FindHashEntry(&modTable, field);
+ if (hPtr == NULL) {
+ break;
+ }
+ modPtr = Tcl_GetHashValue(hPtr);
+ patPtr->needMods |= modPtr->mask;
+ if (modPtr->flags & MULT_CLICKS) {
+ int i = modPtr->flags & MULT_CLICKS;
+
+ count = 2;
+ while (i >>= 1) {
+ count++;
+ }
+ }
+ while ((*p == '-') || isspace(UCHAR(*p))) {
+ p++;
+ }
+ }
+
+ eventFlags = 0;
+ hPtr = Tcl_FindHashEntry(&eventTable, field);
+ if (hPtr != NULL) {
+ const EventInfo *eiPtr = Tcl_GetHashValue(hPtr);
+
+ patPtr->eventType = eiPtr->type;
+ eventFlags = flagArray[eiPtr->type];
+ eventMask = eiPtr->eventMask;
+ while ((*p == '-') || isspace(UCHAR(*p))) {
+ p++;
+ }
+ p = GetField(p, field, FIELD_SIZE);
+ }
+ if (*field != '\0') {
+ if ((*field >= '1') && (*field <= '5') && (field[1] == '\0')) {
+ if (eventFlags == 0) {
+ patPtr->eventType = ButtonPress;
+ eventMask = ButtonPressMask;
+ } else if (eventFlags & KEY) {
+ goto getKeysym;
+ } else if (!(eventFlags & BUTTON)) {
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "specified button \"%s\" for non-button event",
+ field));
+ Tcl_SetErrorCode(interp, "TK", "EVENT", "NON_BUTTON", NULL);
+ count = 0;
+ goto done;
+ }
+ patPtr->detail.button = (*field - '0');
+ } else {
+
+ getKeysym:
+ patPtr->detail.keySym = TkStringToKeysym(field);
+ if (patPtr->detail.keySym == NoSymbol) {
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "bad event type or keysym \"%s\"", field));
+ Tcl_SetErrorCode(interp, "TK", "LOOKUP", "KEYSYM", field,
+ NULL);
+ count = 0;
+ goto done;
+ }
+ if (eventFlags == 0) {
+ patPtr->eventType = KeyPress;
+ eventMask = KeyPressMask;
+ } else if (!(eventFlags & KEY)) {
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "specified keysym \"%s\" for non-key event", field));
+ Tcl_SetErrorCode(interp, "TK", "EVENT", "NON_KEY", NULL);
+ count = 0;
+ goto done;
+ }
+ }
+ } else if (eventFlags == 0) {
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "no event type or button # or keysym", -1));
+ Tcl_SetErrorCode(interp, "TK", "EVENT", "UNMODIFIABLE", NULL);
+ count = 0;
+ goto done;
+ }
+
+ while ((*p == '-') || isspace(UCHAR(*p))) {
+ p++;
+ }
+ if (*p != '>') {
+ while (*p != '\0') {
+ p++;
+ if (*p == '>') {
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "extra characters after detail in binding", -1));
+ Tcl_SetErrorCode(interp, "TK", "EVENT", "PAST_DETAIL", NULL);
+ count = 0;
+ goto done;
+ }
+ }
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "missing \">\" in binding", -1));
+ Tcl_SetErrorCode(interp, "TK", "EVENT", "MALFORMED", NULL);
+ count = 0;
+ goto done;
+ }
+ p++;
+
+ end:
+ *eventStringPtr += (p - Tcl_DStringValue(&copy));
+ *eventMaskPtr |= eventMask;
+ done:
+ Tcl_DStringFree(&copy);
+ return count;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * GetField --
+ *
+ * Used to parse pattern descriptions. Copies up to size characters from
+ * p to copy, stopping at end of string, space, "-", ">", or whenever
+ * size is exceeded.
+ *
+ * Results:
+ * The return value is a pointer to the character just after the last one
+ * copied (usually "-" or space or ">", but could be anything if size was
+ * exceeded). Also places NULL-terminated string (up to size character,
+ * including NULL), at copy.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static char *
+GetField(
+ char *p, /* Pointer to part of pattern. */
+ char *copy, /* Place to copy field. */
+ int size) /* Maximum number of characters to copy. */
+{
+ while ((*p != '\0') && !isspace(UCHAR(*p)) && (*p != '>')
+ && (*p != '-') && (size > 1)) {
+ *copy = *p;
+ p++;
+ copy++;
+ size--;
+ }
+ *copy = '\0';
+ return p;
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * GetPatternObj --
+ *
+ * Produce a string version of the given event, for displaying to the
+ * user.
+ *
+ * Results:
+ * The string is returned as a Tcl_Obj.
+ *
+ * Side effects:
+ * It is the caller's responsibility to arrange for the object to be
+ * released; it starts with a refCount of zero.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+static Tcl_Obj *
+GetPatternObj(
+ PatSeq *psPtr)
+{
+ TkPattern *patPtr;
+ int patsLeft, needMods;
+ const ModInfo *modPtr;
+ const EventInfo *eiPtr;
+ Tcl_Obj *patternObj = Tcl_NewObj();
+
+ /*
+ * The order of the patterns in the sequence is backwards from the order
+ * in which they must be output.
+ */
+
+ for (patsLeft = psPtr->numPats, patPtr = &psPtr->pats[psPtr->numPats - 1];
+ patsLeft > 0; patsLeft--, patPtr--) {
+ /*
+ * Check for simple case of an ASCII character.
+ */
+
+ if ((patPtr->eventType == KeyPress)
+ && !(psPtr->flags & PAT_NEARBY)
+ && (patPtr->needMods == 0)
+ && (patPtr->detail.keySym < 128)
+ && isprint(UCHAR(patPtr->detail.keySym))
+ && (patPtr->detail.keySym != '<')
+ && (patPtr->detail.keySym != ' ')) {
+ char c = (char) patPtr->detail.keySym;
+
+ Tcl_AppendToObj(patternObj, &c, 1);
+ continue;
+ }
+
+ /*
+ * Check for virtual event.
+ */
+
+ if (patPtr->eventType == VirtualEvent) {
+ Tcl_AppendPrintfToObj(patternObj, "<<%s>>", patPtr->detail.name);
+ continue;
+ }
+
+ /*
+ * It's a more general event specification. First check for "Double",
+ * "Triple", "Quadruple", then modifiers, then event type, then keysym
+ * or button detail.
+ */
+
+ Tcl_AppendToObj(patternObj, "<", 1);
+
+ if ((psPtr->flags & PAT_NEARBY) && (patsLeft > 1)
+ && (memcmp(patPtr, patPtr-1, sizeof(TkPattern)) == 0)) {
+ patsLeft--;
+ patPtr--;
+ if ((patsLeft > 1) &&
+ (memcmp(patPtr, patPtr-1, sizeof(TkPattern)) == 0)) {
+ patsLeft--;
+ patPtr--;
+ if ((patsLeft > 1) &&
+ (memcmp(patPtr, patPtr-1, sizeof(TkPattern)) == 0)) {
+ patsLeft--;
+ patPtr--;
+ Tcl_AppendToObj(patternObj, "Quadruple-", 10);
+ } else {
+ Tcl_AppendToObj(patternObj, "Triple-", 7);
+ }
+ } else {
+ Tcl_AppendToObj(patternObj, "Double-", 7);
+ }
+ }
+
+ for (needMods = patPtr->needMods, modPtr = modArray;
+ needMods != 0; modPtr++) {
+ if (modPtr->mask & needMods) {
+ needMods &= ~modPtr->mask;
+ Tcl_AppendPrintfToObj(patternObj, "%s-", modPtr->name);
+ }
+ }
+
+ for (eiPtr = eventArray; eiPtr->name != NULL; eiPtr++) {
+ if (eiPtr->type == patPtr->eventType) {
+ Tcl_AppendToObj(patternObj, eiPtr->name, -1);
+ if (patPtr->detail.clientData != 0) {
+ Tcl_AppendToObj(patternObj, "-", 1);
+ }
+ break;
+ }
+ }
+
+ if (patPtr->detail.clientData != 0) {
+ if ((patPtr->eventType == KeyPress)
+ || (patPtr->eventType == KeyRelease)) {
+ const char *string = TkKeysymToString(patPtr->detail.keySym);
+
+ if (string != NULL) {
+ Tcl_AppendToObj(patternObj, string, -1);
+ }
+ } else {
+ Tcl_AppendPrintfToObj(patternObj, "%d", patPtr->detail.button);
+ }
+ }
+
+ Tcl_AppendToObj(patternObj, ">", 1);
+ }
+
+ return patternObj;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkStringToKeysym --
+ *
+ * This function finds the keysym associated with a given keysym name.
+ *
+ * Results:
+ * The return value is the keysym that corresponds to name, or NoSymbol
+ * if there is no such keysym.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+KeySym
+TkStringToKeysym(
+ const char *name) /* Name of a keysym. */
+{
+#ifdef REDO_KEYSYM_LOOKUP
+ Tcl_HashEntry *hPtr = Tcl_FindHashEntry(&keySymTable, name);
+
+ if (hPtr != NULL) {
+ return (KeySym) Tcl_GetHashValue(hPtr);
+ }
+ if (strlen(name) == 1) {
+ KeySym keysym = (KeySym) (unsigned char) name[0];
+
+ if (TkKeysymToString(keysym) != NULL) {
+ return keysym;
+ }
+ }
+#endif /* REDO_KEYSYM_LOOKUP */
+ return XStringToKeysym(name);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkKeysymToString --
+ *
+ * This function finds the keysym name associated with a given keysym.
+ *
+ * Results:
+ * The return value is a pointer to a static string containing the name
+ * of the given keysym, or NULL if there is no known name.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+const char *
+TkKeysymToString(
+ KeySym keysym)
+{
+#ifdef REDO_KEYSYM_LOOKUP
+ Tcl_HashEntry *hPtr = Tcl_FindHashEntry(&nameTable, (char *)keysym);
+
+ if (hPtr != NULL) {
+ return Tcl_GetHashValue(hPtr);
+ }
+#endif /* REDO_KEYSYM_LOOKUP */
+
+ return XKeysymToString(keysym);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkpGetBindingXEvent --
+ *
+ * This function returns the XEvent associated with the currently
+ * executing binding. This function can only be invoked while a binding
+ * is executing.
+ *
+ * Results:
+ * Returns a pointer to the XEvent that caused the current binding code
+ * to be run.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+XEvent *
+TkpGetBindingXEvent(
+ Tcl_Interp *interp) /* Interpreter. */
+{
+ TkWindow *winPtr = (TkWindow *) Tk_MainWindow(interp);
+ BindingTable *bindPtr = winPtr->mainPtr->bindingTable;
+
+ return &(bindPtr->eventRing[bindPtr->curEvent]);
+}
+
+/*
+ * Local Variables:
+ * mode: c
+ * c-basic-offset: 4
+ * fill-column: 78
+ * End:
+ */
diff --git a/tk8.6/generic/tkBitmap.c b/tk8.6/generic/tkBitmap.c
new file mode 100644
index 0000000..88f3e2b
--- /dev/null
+++ b/tk8.6/generic/tkBitmap.c
@@ -0,0 +1,1205 @@
+/*
+ * tkBitmap.c --
+ *
+ * This file maintains a database of read-only bitmaps for the Tk
+ * toolkit. This allows bitmaps to be shared between widgets and also
+ * avoids interactions with the X server.
+ *
+ * Copyright (c) 1990-1994 The Regents of the University of California.
+ * Copyright (c) 1994-1998 Sun Microsystems, Inc.
+ *
+ * See the file "license.terms" for information on usage and redistribution of
+ * this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ */
+
+#include "tkInt.h"
+
+/*
+ * The includes below are for pre-defined bitmaps.
+ *
+ * Platform-specific issue: Windows complains when the bitmaps are included,
+ * because an array of characters is being initialized with integers as
+ * elements. For lint purposes, the following pragmas temporarily turn off
+ * that warning message.
+ */
+
+#if defined(_MSC_VER)
+#pragma warning (disable : 4305)
+#endif
+
+#include "error.xbm"
+#include "gray12.xbm"
+#include "gray25.xbm"
+#include "gray50.xbm"
+#include "gray75.xbm"
+#include "hourglass.xbm"
+#include "info.xbm"
+#include "questhead.xbm"
+#include "question.xbm"
+#include "warning.xbm"
+
+#if defined(_MSC_VER)
+#pragma warning (default : 4305)
+#endif
+
+/*
+ * One of the following data structures exists for each bitmap that is
+ * currently in use. Each structure is indexed with both "idTable" and
+ * "nameTable".
+ */
+
+typedef struct TkBitmap {
+ Pixmap bitmap; /* X identifier for bitmap. None means this
+ * bitmap was created by Tk_DefineBitmap and
+ * it isn't currently in use. */
+ int width, height; /* Dimensions of bitmap. */
+ Display *display; /* Display for which bitmap is valid. */
+ int screenNum; /* Screen on which bitmap is valid. */
+ int resourceRefCount; /* Number of active uses of this bitmap (each
+ * active use corresponds to a call to
+ * Tk_AllocBitmapFromObj or Tk_GetBitmap). If
+ * this count is 0, then this TkBitmap
+ * structure is no longer valid and it isn't
+ * present in nameTable: it is being kept
+ * around only because there are objects
+ * referring to it. The structure is freed
+ * when resourceRefCount and objRefCount are
+ * both 0. */
+ int objRefCount; /* Number of Tcl_Obj's that reference this
+ * structure. */
+ Tcl_HashEntry *nameHashPtr; /* Entry in nameTable for this structure
+ * (needed when deleting). */
+ Tcl_HashEntry *idHashPtr; /* Entry in idTable for this structure (needed
+ * when deleting). */
+ struct TkBitmap *nextPtr; /* Points to the next TkBitmap structure with
+ * the same name. All bitmaps with the same
+ * name (but different displays or screens)
+ * are chained together off a single entry in
+ * nameTable. */
+} TkBitmap;
+
+/*
+ * Used in bitmapDataTable, stored in the TkDisplay structure, to map between
+ * in-core data about a bitmap to its TkBitmap structure.
+ */
+
+typedef struct {
+ const char *source; /* Bitmap bits. */
+ int width, height; /* Dimensions of bitmap. */
+} DataKey;
+
+typedef struct ThreadSpecificData {
+ int initialized; /* 0 means table below needs initializing. */
+ Tcl_HashTable predefBitmapTable;
+ /* Hash table created by Tk_DefineBitmap to
+ * map from a name to a collection of in-core
+ * data about a bitmap. The table is indexed
+ * by the address of the data for the bitmap,
+ * and the entries contain pointers to
+ * TkPredefBitmap structures. */
+} ThreadSpecificData;
+static Tcl_ThreadDataKey dataKey;
+
+/*
+ * Forward declarations for functions defined in this file:
+ */
+
+static void BitmapInit(TkDisplay *dispPtr);
+static void DupBitmapObjProc(Tcl_Obj *srcObjPtr,
+ Tcl_Obj *dupObjPtr);
+static void FreeBitmap(TkBitmap *bitmapPtr);
+static void FreeBitmapObj(Tcl_Obj *objPtr);
+static void FreeBitmapObjProc(Tcl_Obj *objPtr);
+static TkBitmap * GetBitmap(Tcl_Interp *interp, Tk_Window tkwin,
+ const char *name);
+static TkBitmap * GetBitmapFromObj(Tk_Window tkwin, Tcl_Obj *objPtr);
+static void InitBitmapObj(Tcl_Obj *objPtr);
+
+/*
+ * The following structure defines the implementation of the "bitmap" Tcl
+ * object, which maps a string bitmap name to a TkBitmap object. The ptr1
+ * field of the Tcl_Obj points to a TkBitmap object.
+ */
+
+const Tcl_ObjType tkBitmapObjType = {
+ "bitmap", /* name */
+ FreeBitmapObjProc, /* freeIntRepProc */
+ DupBitmapObjProc, /* dupIntRepProc */
+ NULL, /* updateStringProc */
+ NULL /* setFromAnyProc */
+};
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_AllocBitmapFromObj --
+ *
+ * Given a Tcl_Obj *, map the value to a corresponding Pixmap structure
+ * based on the tkwin given.
+ *
+ * Results:
+ * The return value is the X identifer for the desired bitmap (i.e. a
+ * Pixmap with a single plane), unless string couldn't be parsed
+ * correctly. In this case, None is returned and an error message is left
+ * in the interp's result. The caller should never modify the bitmap that
+ * is returned, and should eventually call Tk_FreeBitmapFromObj when the
+ * bitmap is no longer needed.
+ *
+ * Side effects:
+ * The bitmap is added to an internal database with a reference count.
+ * For each call to this function, there should eventually be a call to
+ * Tk_FreeBitmapFromObj, so that the database can be cleaned up when
+ * bitmaps aren't needed anymore.
+ *
+ *----------------------------------------------------------------------
+ */
+
+Pixmap
+Tk_AllocBitmapFromObj(
+ Tcl_Interp *interp, /* Interp for error results. This may be
+ * NULL. */
+ Tk_Window tkwin, /* Need the screen the bitmap is used on.*/
+ Tcl_Obj *objPtr) /* Object describing bitmap; see manual entry
+ * for legal syntax of string value. */
+{
+ TkBitmap *bitmapPtr;
+
+ if (objPtr->typePtr != &tkBitmapObjType) {
+ InitBitmapObj(objPtr);
+ }
+ bitmapPtr = objPtr->internalRep.twoPtrValue.ptr1;
+
+ /*
+ * If the object currently points to a TkBitmap, see if it's the one we
+ * want. If so, increment its reference count and return.
+ */
+
+ if (bitmapPtr != NULL) {
+ if (bitmapPtr->resourceRefCount == 0) {
+ /*
+ * This is a stale reference: it refers to a TkBitmap that's no
+ * longer in use. Clear the reference.
+ */
+
+ FreeBitmapObj(objPtr);
+ bitmapPtr = NULL;
+ } else if ((Tk_Display(tkwin) == bitmapPtr->display)
+ && (Tk_ScreenNumber(tkwin) == bitmapPtr->screenNum)) {
+ bitmapPtr->resourceRefCount++;
+ return bitmapPtr->bitmap;
+ }
+ }
+
+ /*
+ * The object didn't point to the TkBitmap that we wanted. Search the list
+ * of TkBitmaps with the same name to see if one of the others is the
+ * right one.
+ */
+
+ if (bitmapPtr != NULL) {
+ TkBitmap *firstBitmapPtr = Tcl_GetHashValue(bitmapPtr->nameHashPtr);
+
+ FreeBitmapObj(objPtr);
+ for (bitmapPtr = firstBitmapPtr; bitmapPtr != NULL;
+ bitmapPtr = bitmapPtr->nextPtr) {
+ if ((Tk_Display(tkwin) == bitmapPtr->display) &&
+ (Tk_ScreenNumber(tkwin) == bitmapPtr->screenNum)) {
+ bitmapPtr->resourceRefCount++;
+ bitmapPtr->objRefCount++;
+ objPtr->internalRep.twoPtrValue.ptr1 = bitmapPtr;
+ return bitmapPtr->bitmap;
+ }
+ }
+ }
+
+ /*
+ * Still no luck. Call GetBitmap to allocate a new TkBitmap object.
+ */
+
+ bitmapPtr = GetBitmap(interp, tkwin, Tcl_GetString(objPtr));
+ objPtr->internalRep.twoPtrValue.ptr1 = bitmapPtr;
+ if (bitmapPtr == NULL) {
+ return None;
+ }
+ bitmapPtr->objRefCount++;
+ return bitmapPtr->bitmap;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_GetBitmap --
+ *
+ * Given a string describing a bitmap, locate (or create if necessary) a
+ * bitmap that fits the description.
+ *
+ * Results:
+ * The return value is the X identifer for the desired bitmap (i.e. a
+ * Pixmap with a single plane), unless string couldn't be parsed
+ * correctly. In this case, None is returned and an error message is left
+ * in the interp's result. The caller should never modify the bitmap that
+ * is returned, and should eventually call Tk_FreeBitmap when the bitmap
+ * is no longer needed.
+ *
+ * Side effects:
+ * The bitmap is added to an internal database with a reference count.
+ * For each call to this function, there should eventually be a call to
+ * Tk_FreeBitmap, so that the database can be cleaned up when bitmaps
+ * aren't needed anymore.
+ *
+ *----------------------------------------------------------------------
+ */
+
+Pixmap
+Tk_GetBitmap(
+ Tcl_Interp *interp, /* Interpreter to use for error reporting,
+ * this may be NULL. */
+ Tk_Window tkwin, /* Window in which bitmap will be used. */
+ const char *string) /* Description of bitmap. See manual entry for
+ * details on legal syntax. */
+{
+ TkBitmap *bitmapPtr = GetBitmap(interp, tkwin, string);
+
+ if (bitmapPtr == NULL) {
+ return None;
+ }
+ return bitmapPtr->bitmap;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * GetBitmap --
+ *
+ * Given a string describing a bitmap, locate (or create if necessary) a
+ * bitmap that fits the description. This routine returns the internal
+ * data structure for the bitmap. This avoids extra hash table lookups in
+ * Tk_AllocBitmapFromObj.
+ *
+ * Results:
+ * The return value is the X identifer for the desired bitmap (i.e. a
+ * Pixmap with a single plane), unless string couldn't be parsed
+ * correctly. In this case, None is returned and an error message is left
+ * in the interp's result. The caller should never modify the bitmap that
+ * is returned, and should eventually call Tk_FreeBitmap when the bitmap
+ * is no longer needed.
+ *
+ * Side effects:
+ * The bitmap is added to an internal database with a reference count.
+ * For each call to this function, 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(
+ Tcl_Interp *interp, /* Interpreter to use for error reporting,
+ * this may be NULL. */
+ Tk_Window tkwin, /* Window in which bitmap will be used. */
+ const char *string) /* Description of bitmap. See manual entry for
+ * details on legal syntax. */
+{
+ Tcl_HashEntry *nameHashPtr, *predefHashPtr;
+ TkBitmap *bitmapPtr, *existingBitmapPtr;
+ TkPredefBitmap *predefPtr;
+ Pixmap bitmap;
+ int isNew, width = 0, height = 0, dummy2;
+ TkDisplay *dispPtr = ((TkWindow *) tkwin)->dispPtr;
+ ThreadSpecificData *tsdPtr =
+ Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
+
+ if (!dispPtr->bitmapInit) {
+ BitmapInit(dispPtr);
+ }
+
+ nameHashPtr = Tcl_CreateHashEntry(&dispPtr->bitmapNameTable, string,
+ &isNew);
+ if (!isNew) {
+ existingBitmapPtr = Tcl_GetHashValue(nameHashPtr);
+ for (bitmapPtr = existingBitmapPtr; bitmapPtr != NULL;
+ bitmapPtr = bitmapPtr->nextPtr) {
+ if ((Tk_Display(tkwin) == bitmapPtr->display) &&
+ (Tk_ScreenNumber(tkwin) == bitmapPtr->screenNum)) {
+ bitmapPtr->resourceRefCount++;
+ return bitmapPtr;
+ }
+ }
+ } else {
+ existingBitmapPtr = NULL;
+ }
+
+ /*
+ * No suitable bitmap exists. Create a new bitmap from the information
+ * contained in the string. If the string starts with "@" then the rest of
+ * the string is a file name containing the bitmap. Otherwise the string
+ * must refer to a bitmap defined by a call to Tk_DefineBitmap.
+ */
+
+ if (*string == '@') { /* INTL: ISO char */
+ Tcl_DString buffer;
+ int result;
+
+ if (Tcl_IsSafe(interp)) {
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "can't specify bitmap with '@' in a safe interpreter",
+ -1));
+ Tcl_SetErrorCode(interp, "TK", "SAFE", "BITMAP_FILE", NULL);
+ goto error;
+ }
+
+ /*
+ * Note that we need to cast away the const from the string because
+ * Tcl_TranslateFileName is non-const, even though it doesn't modify
+ * the string.
+ */
+
+ string = Tcl_TranslateFileName(interp, (char *) string + 1, &buffer);
+ if (string == NULL) {
+ goto error;
+ }
+ result = TkReadBitmapFile(Tk_Display(tkwin),
+ RootWindowOfScreen(Tk_Screen(tkwin)), string,
+ (unsigned int *) &width, (unsigned int *) &height,
+ &bitmap, &dummy2, &dummy2);
+ if (result != BitmapSuccess) {
+ if (interp != NULL) {
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "error reading bitmap file \"%s\"", string));
+ Tcl_SetErrorCode(interp, "TK", "BITMAP", "FILE_ERROR", NULL);
+ }
+ Tcl_DStringFree(&buffer);
+ goto error;
+ }
+ Tcl_DStringFree(&buffer);
+ } else {
+ predefHashPtr = Tcl_FindHashEntry(&tsdPtr->predefBitmapTable, string);
+ if (predefHashPtr == NULL) {
+ /*
+ * The following platform specific call allows the user to define
+ * bitmaps that may only exist during run time. If it returns None
+ * nothing was found and we return the error.
+ */
+
+ bitmap = TkpGetNativeAppBitmap(Tk_Display(tkwin), string,
+ &width, &height);
+
+ if (bitmap == None) {
+ if (interp != NULL) {
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "bitmap \"%s\" not defined", string));
+ Tcl_SetErrorCode(interp, "TK", "LOOKUP", "BITMAP", string,
+ NULL);
+ }
+ goto error;
+ }
+ } else {
+ predefPtr = Tcl_GetHashValue(predefHashPtr);
+ width = predefPtr->width;
+ height = predefPtr->height;
+ if (predefPtr->native) {
+ bitmap = TkpCreateNativeBitmap(Tk_Display(tkwin),
+ predefPtr->source);
+ if (bitmap == None) {
+ Tcl_Panic("native bitmap creation failed");
+ }
+ } else {
+ bitmap = XCreateBitmapFromData(Tk_Display(tkwin),
+ RootWindowOfScreen(Tk_Screen(tkwin)),
+ predefPtr->source, (unsigned)width, (unsigned)height);
+ }
+ }
+ }
+
+ /*
+ * Add information about this bitmap to our database.
+ */
+
+ bitmapPtr = ckalloc(sizeof(TkBitmap));
+ bitmapPtr->bitmap = bitmap;
+ bitmapPtr->width = width;
+ bitmapPtr->height = height;
+ bitmapPtr->display = Tk_Display(tkwin);
+ bitmapPtr->screenNum = Tk_ScreenNumber(tkwin);
+ bitmapPtr->resourceRefCount = 1;
+ bitmapPtr->objRefCount = 0;
+ bitmapPtr->nameHashPtr = nameHashPtr;
+ bitmapPtr->idHashPtr = Tcl_CreateHashEntry(&dispPtr->bitmapIdTable,
+ (char *) bitmap, &isNew);
+ if (!isNew) {
+ Tcl_Panic("bitmap already registered in Tk_GetBitmap");
+ }
+ bitmapPtr->nextPtr = existingBitmapPtr;
+ Tcl_SetHashValue(nameHashPtr, bitmapPtr);
+ Tcl_SetHashValue(bitmapPtr->idHashPtr, bitmapPtr);
+ return bitmapPtr;
+
+ error:
+ if (isNew) {
+ Tcl_DeleteHashEntry(nameHashPtr);
+ }
+ return NULL;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_DefineBitmap --
+ *
+ * This function associates a textual name with a binary bitmap
+ * description, so that the name may be used to refer to the bitmap in
+ * future calls to Tk_GetBitmap.
+ *
+ * Results:
+ * A standard Tcl result. If an error occurs then TCL_ERROR is returned
+ * and a message is left in the interp's result.
+ *
+ * Side effects:
+ * "Name" is entered into the bitmap table and may be used from here on
+ * to refer to the given bitmap.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tk_DefineBitmap(
+ Tcl_Interp *interp, /* Interpreter to use for error reporting. */
+ const char *name, /* Name to use for bitmap. Must not already be
+ * defined as a bitmap. */
+ const void *source, /* Address of bits for bitmap. */
+ int width, /* Width of bitmap. */
+ int height) /* Height of bitmap. */
+{
+ int isNew;
+ Tcl_HashEntry *predefHashPtr;
+ TkPredefBitmap *predefPtr;
+ ThreadSpecificData *tsdPtr =
+ Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
+
+ /*
+ * Initialize the Bitmap module if not initialized already for this
+ * thread. Since the current TkDisplay structure cannot be introspected
+ * from here, pass a NULL pointer to BitmapInit, which will know to
+ * initialize only the data in the ThreadSpecificData structure for the
+ * current thread.
+ */
+
+ if (!tsdPtr->initialized) {
+ BitmapInit(NULL);
+ }
+
+ predefHashPtr = Tcl_CreateHashEntry(&tsdPtr->predefBitmapTable,
+ name, &isNew);
+ if (!isNew) {
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "bitmap \"%s\" is already defined", name));
+ Tcl_SetErrorCode(interp, "TK", "BITMAP", "EXISTS", NULL);
+ return TCL_ERROR;
+ }
+ predefPtr = ckalloc(sizeof(TkPredefBitmap));
+ predefPtr->source = source;
+ predefPtr->width = width;
+ predefPtr->height = height;
+ predefPtr->native = 0;
+ Tcl_SetHashValue(predefHashPtr, predefPtr);
+ return TCL_OK;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * Tk_NameOfBitmap --
+ *
+ * Given a bitmap, return a textual string identifying the bitmap.
+ *
+ * Results:
+ * The return value is the string name associated with bitmap.
+ *
+ * Side effects:
+ * None.
+ *
+ *--------------------------------------------------------------
+ */
+
+const char *
+Tk_NameOfBitmap(
+ Display *display, /* Display for which bitmap was allocated. */
+ Pixmap bitmap) /* Bitmap whose name is wanted. */
+{
+ Tcl_HashEntry *idHashPtr;
+ TkBitmap *bitmapPtr;
+ TkDisplay *dispPtr = TkGetDisplay(display);
+
+ if (dispPtr == NULL || !dispPtr->bitmapInit) {
+ unknown:
+ Tcl_Panic("Tk_NameOfBitmap received unknown bitmap argument");
+ }
+
+ idHashPtr = Tcl_FindHashEntry(&dispPtr->bitmapIdTable, (char *) bitmap);
+ if (idHashPtr == NULL) {
+ goto unknown;
+ }
+ bitmapPtr = Tcl_GetHashValue(idHashPtr);
+ return bitmapPtr->nameHashPtr->key.string;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * Tk_SizeOfBitmap --
+ *
+ * Given a bitmap managed by this module, returns the width and height of
+ * the bitmap.
+ *
+ * Results:
+ * The words at *widthPtr and *heightPtr are filled in with the
+ * dimenstions of bitmap.
+ *
+ * Side effects:
+ * If bitmap isn't managed by this module then the function panics..
+ *
+ *--------------------------------------------------------------
+ */
+
+void
+Tk_SizeOfBitmap(
+ Display *display, /* Display for which bitmap was allocated. */
+ Pixmap bitmap, /* Bitmap whose size is wanted. */
+ int *widthPtr, /* Store bitmap width here. */
+ int *heightPtr) /* Store bitmap height here. */
+{
+ Tcl_HashEntry *idHashPtr;
+ TkBitmap *bitmapPtr;
+ TkDisplay *dispPtr = TkGetDisplay(display);
+
+ if (!dispPtr->bitmapInit) {
+ unknownBitmap:
+ Tcl_Panic("Tk_SizeOfBitmap received unknown bitmap argument");
+ }
+
+ idHashPtr = Tcl_FindHashEntry(&dispPtr->bitmapIdTable, (char *) bitmap);
+ if (idHashPtr == NULL) {
+ goto unknownBitmap;
+ }
+ bitmapPtr = Tcl_GetHashValue(idHashPtr);
+ *widthPtr = bitmapPtr->width;
+ *heightPtr = bitmapPtr->height;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * FreeBitmap --
+ *
+ * This function 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(
+ 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 = 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(bitmapPtr);
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_FreeBitmap --
+ *
+ * This function is called to release a bitmap allocated by Tk_GetBitmap
+ * or TkGetBitmapFromData.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The reference count associated with bitmap is decremented, and it is
+ * officially deallocated if no-one is using it anymore.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tk_FreeBitmap(
+ Display *display, /* Display for which bitmap was allocated. */
+ Pixmap bitmap) /* Bitmap to be released. */
+{
+ Tcl_HashEntry *idHashPtr;
+ TkDisplay *dispPtr = TkGetDisplay(display);
+
+ if (!dispPtr->bitmapInit) {
+ Tcl_Panic("Tk_FreeBitmap called before Tk_GetBitmap");
+ }
+
+ idHashPtr = Tcl_FindHashEntry(&dispPtr->bitmapIdTable, (char *) bitmap);
+ if (idHashPtr == NULL) {
+ Tcl_Panic("Tk_FreeBitmap received unknown bitmap argument");
+ }
+ FreeBitmap(Tcl_GetHashValue(idHashPtr));
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_FreeBitmapFromObj --
+ *
+ * This function 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(
+ 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, FreeBitmapObj --
+ *
+ * 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(
+ Tcl_Obj *objPtr) /* The object we are releasing. */
+{
+ FreeBitmapObj(objPtr);
+ objPtr->typePtr = NULL;
+}
+
+static void
+FreeBitmapObj(
+ Tcl_Obj *objPtr) /* The object we are releasing. */
+{
+ TkBitmap *bitmapPtr = objPtr->internalRep.twoPtrValue.ptr1;
+
+ if (bitmapPtr != NULL) {
+ bitmapPtr->objRefCount--;
+ if ((bitmapPtr->objRefCount == 0)
+ && (bitmapPtr->resourceRefCount == 0)) {
+ ckfree(bitmapPtr);
+ }
+ objPtr->internalRep.twoPtrValue.ptr1 = 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(
+ Tcl_Obj *srcObjPtr, /* The object we are copying from. */
+ Tcl_Obj *dupObjPtr) /* The object we are copying to. */
+{
+ TkBitmap *bitmapPtr = srcObjPtr->internalRep.twoPtrValue.ptr1;
+
+ dupObjPtr->typePtr = srcObjPtr->typePtr;
+ dupObjPtr->internalRep.twoPtrValue.ptr1 = bitmapPtr;
+
+ if (bitmapPtr != NULL) {
+ bitmapPtr->objRefCount++;
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_GetBitmapFromData --
+ *
+ * Given a description of the bits for a bitmap, make a bitmap that has
+ * the given properties. *** NOTE: this function is obsolete and really
+ * shouldn't be used anymore. ***
+ *
+ * Results:
+ * The return value is the X identifer for the desired bitmap (a
+ * one-plane Pixmap), unless it couldn't be created properly. In this
+ * case, None is returned and an error message is left in the interp's
+ * result. The caller should never modify the bitmap that is returned,
+ * and should eventually call Tk_FreeBitmap when the bitmap is no longer
+ * needed.
+ *
+ * Side effects:
+ * The bitmap is added to an internal database with a reference count.
+ * For each call to this function, there should eventually be a call to
+ * Tk_FreeBitmap, so that the database can be cleaned up when bitmaps
+ * aren't needed anymore.
+ *
+ *----------------------------------------------------------------------
+ */
+
+ /* ARGSUSED */
+Pixmap
+Tk_GetBitmapFromData(
+ Tcl_Interp *interp, /* Interpreter to use for error reporting. */
+ Tk_Window tkwin, /* Window in which bitmap will be used. */
+ const void *source, /* Bitmap data for bitmap shape. */
+ int width, int height) /* Dimensions of bitmap. */
+{
+ DataKey nameKey;
+ Tcl_HashEntry *dataHashPtr;
+ int isNew;
+ char string[16 + TCL_INTEGER_SPACE];
+ char *name;
+ TkDisplay *dispPtr = ((TkWindow *) tkwin)->dispPtr;
+ ThreadSpecificData *tsdPtr =
+ Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
+
+ if (!tsdPtr->initialized) {
+ BitmapInit(dispPtr);
+ }
+
+ nameKey.source = source;
+ nameKey.width = width;
+ nameKey.height = height;
+ dataHashPtr = Tcl_CreateHashEntry(&dispPtr->bitmapDataTable,
+ (char *) &nameKey, &isNew);
+ if (!isNew) {
+ name = Tcl_GetHashValue(dataHashPtr);
+ } else {
+ dispPtr->bitmapAutoNumber++;
+ sprintf(string, "_tk%d", dispPtr->bitmapAutoNumber);
+ name = string;
+ Tcl_SetHashValue(dataHashPtr, name);
+ if (Tk_DefineBitmap(interp, name, source, width, height) != TCL_OK) {
+ Tcl_DeleteHashEntry(dataHashPtr);
+ return TCL_ERROR;
+ }
+ }
+ return Tk_GetBitmap(interp, tkwin, name);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_GetBitmapFromObj --
+ *
+ * Returns the bitmap referred to by a Tcl object. The bitmap must
+ * already have been allocated via a call to Tk_AllocBitmapFromObj or
+ * Tk_GetBitmap.
+ *
+ * Results:
+ * Returns the Pixmap that matches the tkwin and the string rep of
+ * objPtr.
+ *
+ * Side effects:
+ * If the object is not already a bitmap, the conversion will free any
+ * old internal representation.
+ *
+ *----------------------------------------------------------------------
+ */
+
+Pixmap
+Tk_GetBitmapFromObj(
+ 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(
+ Tk_Window tkwin, /* Window in which the bitmap will be used. */
+ Tcl_Obj *objPtr) /* The object that describes the desired
+ * bitmap. */
+{
+ TkBitmap *bitmapPtr;
+ Tcl_HashEntry *hashPtr;
+ TkDisplay *dispPtr = ((TkWindow *) tkwin)->dispPtr;
+
+ if (objPtr->typePtr != &tkBitmapObjType) {
+ InitBitmapObj(objPtr);
+ }
+
+ bitmapPtr = objPtr->internalRep.twoPtrValue.ptr1;
+ if (bitmapPtr != NULL) {
+ if ((bitmapPtr->resourceRefCount > 0)
+ && (Tk_Display(tkwin) == bitmapPtr->display)) {
+ return bitmapPtr;
+ }
+ hashPtr = bitmapPtr->nameHashPtr;
+ FreeBitmapObj(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 = Tcl_GetHashValue(hashPtr); bitmapPtr != NULL;
+ bitmapPtr = bitmapPtr->nextPtr) {
+ if (Tk_Display(tkwin) == bitmapPtr->display) {
+ objPtr->internalRep.twoPtrValue.ptr1 = bitmapPtr;
+ bitmapPtr->objRefCount++;
+ return bitmapPtr;
+ }
+ }
+
+ error:
+ Tcl_Panic("GetBitmapFromObj called with non-existent bitmap!");
+ /*
+ * The following code isn't reached; it's just there to please compilers.
+ */
+ return NULL;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * InitBitmapObj --
+ *
+ * Bookeeping function 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(
+ Tcl_Obj *objPtr) /* The object to convert. */
+{
+ const Tcl_ObjType *typePtr;
+
+ /*
+ * Free the old internalRep before setting the new one.
+ */
+
+ Tcl_GetString(objPtr);
+ typePtr = objPtr->typePtr;
+ if ((typePtr != NULL) && (typePtr->freeIntRepProc != NULL)) {
+ typePtr->freeIntRepProc(objPtr);
+ }
+ objPtr->typePtr = &tkBitmapObjType;
+ objPtr->internalRep.twoPtrValue.ptr1 = NULL;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * BitmapInit --
+ *
+ * Initializes hash tables used by this module. Initializes tables stored
+ * in TkDisplay structure if a TkDisplay pointer is passed in. Also
+ * initializes the thread-local data in the current thread's
+ * ThreadSpecificData structure.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Read the code.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+BitmapInit(
+ TkDisplay *dispPtr) /* TkDisplay structure encapsulating
+ * thread-specific data used by this module,
+ * or NULL if unavailable. */
+{
+ Tcl_Interp *dummy;
+ ThreadSpecificData *tsdPtr =
+ Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
+
+ /*
+ * First initialize the data in the ThreadSpecificData strucuture, if
+ * needed.
+ */
+
+ if (!tsdPtr->initialized) {
+ tsdPtr->initialized = 1;
+ dummy = Tcl_CreateInterp();
+ Tcl_InitHashTable(&tsdPtr->predefBitmapTable, TCL_STRING_KEYS);
+
+ Tk_DefineBitmap(dummy, "error", error_bits,
+ error_width, error_height);
+ Tk_DefineBitmap(dummy, "gray75", gray75_bits,
+ gray75_width, gray75_height);
+ Tk_DefineBitmap(dummy, "gray50", gray50_bits,
+ gray50_width, gray50_height);
+ Tk_DefineBitmap(dummy, "gray25", gray25_bits,
+ gray25_width, gray25_height);
+ Tk_DefineBitmap(dummy, "gray12", gray12_bits,
+ gray12_width, gray12_height);
+ Tk_DefineBitmap(dummy, "hourglass", hourglass_bits,
+ hourglass_width, hourglass_height);
+ Tk_DefineBitmap(dummy, "info", info_bits,
+ info_width, info_height);
+ Tk_DefineBitmap(dummy, "questhead", questhead_bits,
+ questhead_width, questhead_height);
+ Tk_DefineBitmap(dummy, "question", question_bits,
+ question_width, question_height);
+ Tk_DefineBitmap(dummy, "warning", warning_bits,
+ warning_width, warning_height);
+
+ TkpDefineNativeBitmaps();
+ Tcl_DeleteInterp(dummy);
+ }
+
+ /*
+ * Was a valid TkDisplay pointer passed? If so, initialize the Bitmap
+ * module tables in that structure.
+ */
+
+ if (dispPtr != NULL) {
+ dispPtr->bitmapInit = 1;
+ Tcl_InitHashTable(&dispPtr->bitmapNameTable, TCL_STRING_KEYS);
+ Tcl_InitHashTable(&dispPtr->bitmapDataTable,
+ sizeof(DataKey) / sizeof(int));
+
+ /*
+ * The call below is tricky: can't use sizeof(IdKey) because it gets
+ * padded with extra unpredictable bytes on some 64-bit machines.
+ */
+
+ /*
+ * The comment above doesn't make sense...
+ */
+
+ Tcl_InitHashTable(&dispPtr->bitmapIdTable, TCL_ONE_WORD_KEYS);
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkReadBitmapFile --
+ *
+ * Loads a bitmap image in X bitmap format into the specified drawable.
+ * This is equivelent to the XReadBitmapFile in X.
+ *
+ * Results:
+ * Sets the size, hotspot, and bitmap on success.
+ *
+ * Side effects:
+ * Creates a new bitmap from the file data.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TkReadBitmapFile(
+ Display *display,
+ Drawable d,
+ const char *filename,
+ unsigned int *width_return,
+ unsigned int *height_return,
+ Pixmap *bitmap_return,
+ int *x_hot_return,
+ int *y_hot_return)
+{
+ char *data;
+
+ data = TkGetBitmapData(NULL, NULL, filename,
+ (int *) width_return, (int *) height_return, x_hot_return,
+ y_hot_return);
+ if (data == NULL) {
+ return BitmapFileInvalid;
+ }
+
+ *bitmap_return = XCreateBitmapFromData(display, d, data, *width_return,
+ *height_return);
+ ckfree(data);
+ return BitmapSuccess;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkDebugBitmap --
+ *
+ * This function 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(
+ Tk_Window tkwin, /* The window in which the bitmap will be used
+ * (not currently used). */
+ const 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 = Tcl_GetHashValue(hashPtr);
+ if (bitmapPtr == NULL) {
+ Tcl_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 function 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(void)
+{
+ ThreadSpecificData *tsdPtr =
+ Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
+
+ return &tsdPtr->predefBitmapTable;
+}
+
+/*
+ * Local Variables:
+ * mode: c
+ * c-basic-offset: 4
+ * fill-column: 78
+ * End:
+ */
diff --git a/tk8.6/generic/tkBusy.c b/tk8.6/generic/tkBusy.c
new file mode 100644
index 0000000..b36d453
--- /dev/null
+++ b/tk8.6/generic/tkBusy.c
@@ -0,0 +1,932 @@
+/*
+ * tkBusy.c --
+ *
+ * This file provides functions that implement busy for Tk.
+ *
+ * Copyright 1993-1998 Lucent Technologies, Inc.
+ *
+ * The "busy" command was created by George Howlett. Adapted for
+ * integration into Tk by Jos Decoster and Donal K. Fellows.
+ *
+ * See the file "license.terms" for information on usage and redistribution of
+ * this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ */
+
+#include "tkInt.h"
+#include "tkBusy.h"
+#include "default.h"
+
+/*
+ * Things about the busy system that may be configured. Note that currently on
+ * OSX/Aqua, that's nothing at all.
+ */
+
+static const Tk_OptionSpec busyOptionSpecs[] = {
+#ifndef MAC_OSX_TK
+ {TK_OPTION_CURSOR, "-cursor", "cursor", "Cursor",
+ DEF_BUSY_CURSOR, -1, Tk_Offset(Busy, cursor),
+ TK_OPTION_NULL_OK, 0, 0},
+#endif
+ {TK_OPTION_END, NULL, NULL, NULL, NULL, 0, 0, 0, 0, 0}
+};
+
+/*
+ * Forward declarations of functions defined in this file.
+ */
+
+static void BusyEventProc(ClientData clientData,
+ XEvent *eventPtr);
+static void BusyGeometryProc(ClientData clientData,
+ Tk_Window tkwin);
+static void BusyCustodyProc(ClientData clientData,
+ Tk_Window tkwin);
+static int ConfigureBusy(Tcl_Interp *interp, Busy *busyPtr,
+ int objc, Tcl_Obj *const objv[]);
+static Busy * CreateBusy(Tcl_Interp *interp, Tk_Window tkRef);
+static void DestroyBusy(void *dataPtr);
+static void DoConfigureNotify(Tk_FakeWin *winPtr);
+static inline Tk_Window FirstChild(Tk_Window parent);
+static Busy * GetBusy(Tcl_Interp *interp,
+ Tcl_HashTable *busyTablePtr,
+ Tcl_Obj *const windowObj);
+static int HoldBusy(Tcl_HashTable *busyTablePtr,
+ Tcl_Interp *interp, Tcl_Obj *const windowObj,
+ int configObjc, Tcl_Obj *const configObjv[]);
+static void MakeTransparentWindowExist(Tk_Window tkwin,
+ Window parent);
+static inline Tk_Window NextChild(Tk_Window tkwin);
+static void RefWinEventProc(ClientData clientData,
+ register XEvent *eventPtr);
+static inline void SetWindowInstanceData(Tk_Window tkwin,
+ ClientData instanceData);
+
+/*
+ * The "busy" geometry manager definition.
+ */
+
+static Tk_GeomMgr busyMgrInfo = {
+ "busy", /* Name of geometry manager used by winfo */
+ BusyGeometryProc, /* Procedure to for new geometry requests */
+ BusyCustodyProc, /* Procedure when window is taken away */
+};
+
+/*
+ * Helper functions, need to check if a Tcl/Tk alternative already exists.
+ */
+
+static inline Tk_Window
+FirstChild(
+ Tk_Window parent)
+{
+ struct TkWindow *parentPtr = (struct TkWindow *) parent;
+
+ return (Tk_Window) parentPtr->childList;
+}
+
+static inline Tk_Window
+NextChild(
+ Tk_Window tkwin)
+{
+ struct TkWindow *winPtr = (struct TkWindow *) tkwin;
+
+ if (winPtr == NULL) {
+ return NULL;
+ }
+ return (Tk_Window) winPtr->nextPtr;
+}
+
+static inline void
+SetWindowInstanceData(
+ Tk_Window tkwin,
+ ClientData instanceData)
+{
+ struct TkWindow *winPtr = (struct TkWindow *) tkwin;
+
+ winPtr->instanceData = instanceData;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * BusyCustodyProc --
+ *
+ * This procedure is invoked when the busy window has been stolen by
+ * another geometry manager. The information and memory associated with
+ * the busy window is released. I don't know why anyone would try to pack
+ * a busy window, but this should keep everything sane, if it is.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The Busy structure is freed at the next idle point.
+ *
+ *----------------------------------------------------------------------
+ */
+
+/* ARGSUSED */
+static void
+BusyCustodyProc(
+ ClientData clientData, /* Information about the busy window. */
+ Tk_Window tkwin) /* Not used. */
+{
+ Busy *busyPtr = clientData;
+
+ Tk_DeleteEventHandler(busyPtr->tkBusy, StructureNotifyMask, BusyEventProc,
+ busyPtr);
+ TkpHideBusyWindow(busyPtr);
+ busyPtr->tkBusy = NULL;
+ Tcl_EventuallyFree(busyPtr, (Tcl_FreeProc *)DestroyBusy);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * BusyGeometryProc --
+ *
+ * This procedure is invoked by Tk_GeometryRequest for busy windows.
+ * Busy windows never request geometry, so it's unlikely that this
+ * function will ever be called;it exists simply as a place holder for
+ * the GeomProc in the Geometry Manager structure.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+/* ARGSUSED */
+static void
+BusyGeometryProc(
+ ClientData clientData, /* Information about window that got new
+ * preferred geometry. */
+ Tk_Window tkwin) /* Other Tk-related information about the
+ * window. */
+{
+ /* Should never get here */
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * DoConfigureNotify --
+ *
+ * Generate a ConfigureNotify event describing the current configuration
+ * of a window.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * An event is generated and processed by Tk_HandleEvent.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+DoConfigureNotify(
+ Tk_FakeWin *winPtr) /* Window whose configuration was just
+ * changed. */
+{
+ XEvent event;
+
+ event.type = ConfigureNotify;
+ event.xconfigure.serial = LastKnownRequestProcessed(winPtr->display);
+ event.xconfigure.send_event = False;
+ event.xconfigure.display = winPtr->display;
+ event.xconfigure.event = winPtr->window;
+ event.xconfigure.window = winPtr->window;
+ event.xconfigure.x = winPtr->changes.x;
+ event.xconfigure.y = winPtr->changes.y;
+ event.xconfigure.width = winPtr->changes.width;
+ event.xconfigure.height = winPtr->changes.height;
+ event.xconfigure.border_width = winPtr->changes.border_width;
+ if (winPtr->changes.stack_mode == Above) {
+ event.xconfigure.above = winPtr->changes.sibling;
+ } else {
+ event.xconfigure.above = None;
+ }
+ event.xconfigure.override_redirect = winPtr->atts.override_redirect;
+ Tk_HandleEvent(&event);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * RefWinEventProc --
+ *
+ * This procedure is invoked by the Tk dispatcher for the following
+ * events on the reference window. If the reference and parent windows
+ * are the same, only the first event is important.
+ *
+ * 1) ConfigureNotify The reference window has been resized or
+ * moved. Move and resize the busy window to be
+ * the same size and position of the reference
+ * window.
+ *
+ * 2) DestroyNotify The reference window was destroyed. Destroy
+ * the busy window and the free resources used.
+ *
+ * 3) MapNotify The reference window was (re)shown. Map the
+ * busy window again.
+ *
+ * 4) UnmapNotify The reference window was hidden. Unmap the
+ * busy window.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * When the reference window gets deleted, internal structures get
+ * cleaned up. When it gets resized, the busy window is resized
+ * accordingly. If it's displayed, the busy window is displayed. And when
+ * it's hidden, the busy window is unmapped.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+RefWinEventProc(
+ ClientData clientData, /* Busy window record */
+ register XEvent *eventPtr) /* Event which triggered call to routine */
+{
+ register Busy *busyPtr = clientData;
+
+ switch (eventPtr->type) {
+ case ReparentNotify:
+ case DestroyNotify:
+ /*
+ * Arrange for the busy structure to be removed at a proper time.
+ */
+
+ Tcl_EventuallyFree(busyPtr, (Tcl_FreeProc *)DestroyBusy);
+ break;
+
+ case ConfigureNotify:
+ if ((busyPtr->width != Tk_Width(busyPtr->tkRef)) ||
+ (busyPtr->height != Tk_Height(busyPtr->tkRef)) ||
+ (busyPtr->x != Tk_X(busyPtr->tkRef)) ||
+ (busyPtr->y != Tk_Y(busyPtr->tkRef))) {
+ int x, y;
+
+ busyPtr->width = Tk_Width(busyPtr->tkRef);
+ busyPtr->height = Tk_Height(busyPtr->tkRef);
+ busyPtr->x = Tk_X(busyPtr->tkRef);
+ busyPtr->y = Tk_Y(busyPtr->tkRef);
+
+ x = y = 0;
+
+ if (busyPtr->tkParent != busyPtr->tkRef) {
+ Tk_Window tkwin;
+
+ for (tkwin = busyPtr->tkRef; (tkwin != NULL) &&
+ (!Tk_IsTopLevel(tkwin)); tkwin = Tk_Parent(tkwin)) {
+ if (tkwin == busyPtr->tkParent) {
+ break;
+ }
+ x += Tk_X(tkwin) + Tk_Changes(tkwin)->border_width;
+ y += Tk_Y(tkwin) + Tk_Changes(tkwin)->border_width;
+ }
+ }
+ if (busyPtr->tkBusy != NULL) {
+ Tk_MoveResizeWindow(busyPtr->tkBusy, x, y, busyPtr->width,
+ busyPtr->height);
+ TkpShowBusyWindow(busyPtr);
+ }
+ }
+ break;
+
+ case MapNotify:
+ if (busyPtr->tkParent != busyPtr->tkRef) {
+ TkpShowBusyWindow(busyPtr);
+ }
+ break;
+
+ case UnmapNotify:
+ if (busyPtr->tkParent != busyPtr->tkRef) {
+ TkpHideBusyWindow(busyPtr);
+ }
+ break;
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * DestroyBusy --
+ *
+ * This procedure is called from the Tk event dispatcher. It releases X
+ * resources and memory used by the busy window and updates the internal
+ * hash table.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Memory and resources are released and the Tk event handler is removed.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+DestroyBusy(
+ void *data) /* Busy window structure record */
+{
+ register Busy *busyPtr = data;
+
+ if (busyPtr->hashPtr != NULL) {
+ Tcl_DeleteHashEntry(busyPtr->hashPtr);
+ }
+ Tk_DeleteEventHandler(busyPtr->tkRef, StructureNotifyMask,
+ RefWinEventProc, busyPtr);
+
+ if (busyPtr->tkBusy != NULL) {
+ Tk_FreeConfigOptions(data, busyPtr->optionTable, busyPtr->tkBusy);
+ Tk_DeleteEventHandler(busyPtr->tkBusy, StructureNotifyMask,
+ BusyEventProc, busyPtr);
+ Tk_ManageGeometry(busyPtr->tkBusy, NULL, busyPtr);
+ Tk_DestroyWindow(busyPtr->tkBusy);
+ }
+ ckfree(data);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * BusyEventProc --
+ *
+ * This procedure is invoked by the Tk dispatcher for events on the busy
+ * window itself. We're only concerned with destroy events.
+ *
+ * It might be necessary (someday) to watch resize events. Right now, I
+ * don't think there's any point in it.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * When a busy window is destroyed, all internal structures associated
+ * with it released at the next idle point.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+BusyEventProc(
+ ClientData clientData, /* Busy window record */
+ XEvent *eventPtr) /* Event which triggered call to routine */
+{
+ Busy *busyPtr = clientData;
+
+ if (eventPtr->type == DestroyNotify) {
+ busyPtr->tkBusy = NULL;
+ Tcl_EventuallyFree(busyPtr, (Tcl_FreeProc *)DestroyBusy);
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * MakeTransparentWindowExist --
+ *
+ * Similar to Tk_MakeWindowExist but instead creates a transparent window
+ * to block for user events from sibling windows.
+ *
+ * Differences from Tk_MakeWindowExist.
+ *
+ * 1. This is always a "busy" window. There's never a platform-specific
+ * class procedure to execute instead.
+ * 2. The window is transparent and never will contain children, so
+ * colormap information is irrelevant.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * When the procedure returns, the internal window associated with tkwin
+ * is guaranteed to exist. This may require the window's ancestors to be
+ * created too.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+MakeTransparentWindowExist(
+ Tk_Window tkwin, /* Token for window. */
+ Window parent) /* Parent window. */
+{
+ TkWindow *winPtr = (TkWindow *) tkwin;
+ Tcl_HashEntry *hPtr;
+ int notUsed;
+ TkDisplay *dispPtr;
+
+ if (winPtr->window != None) {
+ return; /* Window already exists. */
+ }
+
+ /*
+ * Create a transparent window and put it on top.
+ */
+
+ TkpMakeTransparentWindowExist(tkwin, parent);
+
+ if (winPtr->window == None) {
+ return; /* Platform didn't make Window. */
+ }
+
+ dispPtr = winPtr->dispPtr;
+ hPtr = Tcl_CreateHashEntry(&dispPtr->winTable, (char *) winPtr->window,
+ &notUsed);
+ Tcl_SetHashValue(hPtr, winPtr);
+ winPtr->dirtyAtts = 0;
+ winPtr->dirtyChanges = 0;
+
+ if (!(winPtr->flags & TK_TOP_HIERARCHY)) {
+ TkWindow *winPtr2;
+
+ /*
+ * If any siblings higher up in the stacking order have already been
+ * created then move this window to its rightful position in the
+ * stacking order.
+ *
+ * NOTE: this code ignores any changes anyone might have made to the
+ * sibling and stack_mode field of the window's attributes, so it
+ * really isn't safe for these to be manipulated except by calling
+ * Tk_RestackWindow.
+ */
+
+ for (winPtr2 = winPtr->nextPtr; winPtr2 != NULL;
+ winPtr2 = winPtr2->nextPtr) {
+ if ((winPtr2->window != None) &&
+ !(winPtr2->flags & (TK_TOP_HIERARCHY|TK_REPARENTED))) {
+ XWindowChanges changes;
+
+ changes.sibling = winPtr2->window;
+ changes.stack_mode = Below;
+ XConfigureWindow(winPtr->display, winPtr->window,
+ CWSibling | CWStackMode, &changes);
+ break;
+ }
+ }
+ }
+
+ /*
+ * Issue a ConfigureNotify event if there were deferred configuration
+ * changes (but skip it if the window is being deleted; the
+ * ConfigureNotify event could cause problems if we're being called from
+ * Tk_DestroyWindow under some conditions).
+ */
+
+ if ((winPtr->flags & TK_NEED_CONFIG_NOTIFY)
+ && !(winPtr->flags & TK_ALREADY_DEAD)) {
+ winPtr->flags &= ~TK_NEED_CONFIG_NOTIFY;
+ DoConfigureNotify((Tk_FakeWin *) tkwin);
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * CreateBusy --
+ *
+ * Creates a child transparent window that obscures its parent window
+ * thereby effectively blocking device events. The size and position of
+ * the busy window is exactly that of the reference window.
+ *
+ * We want to create sibling to the window to be blocked. If the busy
+ * window is a child of the window to be blocked, Enter/Leave events can
+ * sneak through. Futhermore under WIN32, messages of transparent windows
+ * are sent directly to the parent. The only exception to this are
+ * toplevels, since we can't make a sibling. Fortunately, toplevel
+ * windows rarely receive events that need blocking.
+ *
+ * Results:
+ * Returns a pointer to the new busy window structure.
+ *
+ * Side effects:
+ * When the busy window is eventually displayed, it will screen device
+ * events (in the area of the reference window) from reaching its parent
+ * window and its children. User feed back can be achieved by changing
+ * the cursor.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static Busy *
+CreateBusy(
+ Tcl_Interp *interp, /* Interpreter to report error to */
+ Tk_Window tkRef) /* Window hosting the busy window */
+{
+ Busy *busyPtr;
+ int length, x, y;
+ const char *fmt;
+ char *name;
+ Tk_Window tkBusy, tkChild, tkParent;
+ Window parent;
+ Tk_FakeWin *winPtr;
+
+ busyPtr = ckalloc(sizeof(Busy));
+ x = y = 0;
+ length = strlen(Tk_Name(tkRef));
+ name = ckalloc(length + 6);
+ if (Tk_IsTopLevel(tkRef)) {
+ fmt = "_Busy"; /* Child */
+ tkParent = tkRef;
+ } else {
+ Tk_Window tkwin;
+
+ fmt = "%s_Busy"; /* Sibling */
+ tkParent = Tk_Parent(tkRef);
+ for (tkwin = tkRef; (tkwin != NULL) && !Tk_IsTopLevel(tkwin);
+ tkwin = Tk_Parent(tkwin)) {
+ if (tkwin == tkParent) {
+ break;
+ }
+ x += Tk_X(tkwin) + Tk_Changes(tkwin)->border_width;
+ y += Tk_Y(tkwin) + Tk_Changes(tkwin)->border_width;
+ }
+ }
+ for (tkChild = FirstChild(tkParent); tkChild != NULL;
+ tkChild = NextChild(tkChild)) {
+ Tk_MakeWindowExist(tkChild);
+ }
+ sprintf(name, fmt, Tk_Name(tkRef));
+ tkBusy = Tk_CreateWindow(interp, tkParent, name, NULL);
+ ckfree(name);
+
+ if (tkBusy == NULL) {
+ return NULL;
+ }
+ Tk_MakeWindowExist(tkRef);
+ busyPtr->display = Tk_Display(tkRef);
+ busyPtr->interp = interp;
+ busyPtr->tkRef = tkRef;
+ busyPtr->tkParent = tkParent;
+ busyPtr->tkBusy = tkBusy;
+ busyPtr->width = Tk_Width(tkRef);
+ busyPtr->height = Tk_Height(tkRef);
+ busyPtr->x = Tk_X(tkRef);
+ busyPtr->y = Tk_Y(tkRef);
+ busyPtr->cursor = None;
+ Tk_SetClass(tkBusy, "Busy");
+ busyPtr->optionTable = Tk_CreateOptionTable(interp, busyOptionSpecs);
+ if (Tk_InitOptions(interp, (char *) busyPtr, busyPtr->optionTable,
+ tkBusy) != TCL_OK) {
+ Tk_DestroyWindow(tkBusy);
+ return NULL;
+ }
+ SetWindowInstanceData(tkBusy, busyPtr);
+ winPtr = (Tk_FakeWin *) tkRef;
+
+ TkpCreateBusy(winPtr, tkRef, &parent, tkParent, busyPtr);
+
+ MakeTransparentWindowExist(tkBusy, parent);
+
+ Tk_MoveResizeWindow(tkBusy, x, y, busyPtr->width, busyPtr->height);
+
+ /*
+ * Only worry if the busy window is destroyed.
+ */
+
+ Tk_CreateEventHandler(tkBusy, StructureNotifyMask, BusyEventProc,
+ busyPtr);
+
+ /*
+ * Indicate that the busy window's geometry is being managed. This will
+ * also notify us if the busy window is ever packed.
+ */
+
+ Tk_ManageGeometry(tkBusy, &busyMgrInfo, busyPtr);
+ if (busyPtr->cursor != None) {
+ Tk_DefineCursor(tkBusy, busyPtr->cursor);
+ }
+
+ /*
+ * Track the reference window to see if it is resized or destroyed.
+ */
+
+ Tk_CreateEventHandler(tkRef, StructureNotifyMask, RefWinEventProc,
+ busyPtr);
+ return busyPtr;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ConfigureBusy --
+ *
+ * This procedure is called from the Tk event dispatcher. It releases X
+ * resources and memory used by the busy window and updates the internal
+ * hash table.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Memory and resources are released and the Tk event handler is removed.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+ConfigureBusy(
+ Tcl_Interp *interp,
+ Busy *busyPtr,
+ int objc,
+ Tcl_Obj *const objv[])
+{
+ Tk_Cursor oldCursor = busyPtr->cursor;
+
+ if (Tk_SetOptions(interp, (char *) busyPtr, busyPtr->optionTable, objc,
+ objv, busyPtr->tkBusy, NULL, NULL) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (busyPtr->cursor != oldCursor) {
+ if (busyPtr->cursor == None) {
+ Tk_UndefineCursor(busyPtr->tkBusy);
+ } else {
+ Tk_DefineCursor(busyPtr->tkBusy, busyPtr->cursor);
+ }
+ }
+
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * GetBusy --
+ *
+ * Returns the busy window structure associated with the reference
+ * window, keyed by its path name. The clientData argument is the main
+ * window of the interpreter, used to search for the reference window in
+ * its own window hierarchy.
+ *
+ * Results:
+ * If path name represents a reference window with a busy window, a
+ * pointer to the busy window structure is returned. Otherwise, NULL is
+ * returned and an error message is left in interp->result.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static Busy *
+GetBusy(
+ Tcl_Interp *interp, /* Interpreter to look up main window of. */
+ Tcl_HashTable *busyTablePtr,/* Busy hash table */
+ Tcl_Obj *const windowObj) /* Path name of parent window */
+{
+ Tcl_HashEntry *hPtr;
+ Tk_Window tkwin;
+
+ if (TkGetWindowFromObj(interp, Tk_MainWindow(interp), windowObj,
+ &tkwin) != TCL_OK) {
+ return NULL;
+ }
+ hPtr = Tcl_FindHashEntry(busyTablePtr, (char *) tkwin);
+ if (hPtr == NULL) {
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "can't find busy window \"%s\"", Tcl_GetString(windowObj)));
+ Tcl_SetErrorCode(interp, "TK", "LOOKUP", "BUSY",
+ Tcl_GetString(windowObj), NULL);
+ return NULL;
+ }
+ return Tcl_GetHashValue(hPtr);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * HoldBusy --
+ *
+ * Creates (if necessary) and maps a busy window, thereby preventing
+ * device events from being be received by the parent window and its
+ * children.
+ *
+ * Results:
+ * Returns a standard TCL result. If path name represents a busy window,
+ * it is unmapped and TCL_OK is returned. Otherwise, TCL_ERROR is
+ * returned and an error message is left in interp->result.
+ *
+ * Side effects:
+ * The busy window is created and displayed, blocking events from the
+ * parent window and its children.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+HoldBusy(
+ Tcl_HashTable *busyTablePtr,/* Busy hash table. */
+ Tcl_Interp *interp, /* Interpreter to report errors to. */
+ Tcl_Obj *const windowObj, /* Window name. */
+ int configObjc, /* Option pairs. */
+ Tcl_Obj *const configObjv[])
+{
+ Tk_Window tkwin;
+ Tcl_HashEntry *hPtr;
+ Busy *busyPtr;
+ int isNew, result;
+
+ if (TkGetWindowFromObj(interp, Tk_MainWindow(interp), windowObj,
+ &tkwin) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ hPtr = Tcl_CreateHashEntry(busyTablePtr, (char *) tkwin, &isNew);
+ if (isNew) {
+ busyPtr = CreateBusy(interp, tkwin);
+ if (busyPtr == NULL) {
+ return TCL_ERROR;
+ }
+ Tcl_SetHashValue(hPtr, busyPtr);
+ busyPtr->hashPtr = hPtr;
+ } else {
+ busyPtr = Tcl_GetHashValue(hPtr);
+ }
+
+ busyPtr->tablePtr = busyTablePtr;
+ result = ConfigureBusy(interp, busyPtr, configObjc, configObjv);
+
+ /*
+ * Don't map the busy window unless the reference window is also currently
+ * displayed.
+ */
+
+ if (Tk_IsMapped(busyPtr->tkRef)) {
+ TkpShowBusyWindow(busyPtr);
+ } else {
+ TkpHideBusyWindow(busyPtr);
+ }
+ return result;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_BusyObjCmd --
+ *
+ * This function is invoked to process the "tk busy" 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_BusyObjCmd(
+ 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 = clientData;
+ Tcl_HashTable *busyTablePtr = &((TkWindow *) tkwin)->mainPtr->busyTable;
+ Busy *busyPtr;
+ Tcl_Obj *objPtr;
+ int index, result = TCL_OK;
+ static const char *const optionStrings[] = {
+ "cget", "configure", "current", "forget", "hold", "status", NULL
+ };
+ enum options {
+ BUSY_CGET, BUSY_CONFIGURE, BUSY_CURRENT, BUSY_FORGET, BUSY_HOLD,
+ BUSY_STATUS
+ };
+
+ if (objc < 2) {
+ Tcl_WrongNumArgs(interp, 1, objv, "options ?arg arg ...?");
+ return TCL_ERROR;
+ }
+
+ /*
+ * [tk busy <window>] command shortcut.
+ */
+
+ if (Tcl_GetString(objv[1])[0] == '.') {
+ if (objc%2 == 1) {
+ Tcl_WrongNumArgs(interp, 1, objv, "window ?option value ...?");
+ return TCL_ERROR;
+ }
+ return HoldBusy(busyTablePtr, interp, objv[1], objc-2, objv+2);
+ }
+
+ if (Tcl_GetIndexFromObjStruct(interp, objv[1], optionStrings,
+ sizeof(char *), "option", 0, &index) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ switch ((enum options) index) {
+ case BUSY_CGET:
+ if (objc != 4) {
+ Tcl_WrongNumArgs(interp, 2, objv, "window option");
+ return TCL_ERROR;
+ }
+ busyPtr = GetBusy(interp, busyTablePtr, objv[2]);
+ if (busyPtr == NULL) {
+ return TCL_ERROR;
+ }
+ Tcl_Preserve(busyPtr);
+ objPtr = Tk_GetOptionValue(interp, (char *) busyPtr,
+ busyPtr->optionTable, objv[3], busyPtr->tkBusy);
+ if (objPtr == NULL) {
+ result = TCL_ERROR;
+ } else {
+ Tcl_SetObjResult(interp, objPtr);
+ }
+ Tcl_Release(busyPtr);
+ return result;
+
+ case BUSY_CONFIGURE:
+ if (objc < 3) {
+ Tcl_WrongNumArgs(interp, 2, objv, "window ?option? ?value ...?");
+ return TCL_ERROR;
+ }
+ busyPtr = GetBusy(interp, busyTablePtr, objv[2]);
+ if (busyPtr == NULL) {
+ return TCL_ERROR;
+ }
+ Tcl_Preserve(busyPtr);
+ if (objc <= 4) {
+ objPtr = Tk_GetOptionInfo(interp, (char *) busyPtr,
+ busyPtr->optionTable, (objc == 4) ? objv[3] : NULL,
+ busyPtr->tkBusy);
+ if (objPtr == NULL) {
+ result = TCL_ERROR;
+ } else {
+ Tcl_SetObjResult(interp, objPtr);
+ }
+ } else {
+ result = ConfigureBusy(interp, busyPtr, objc-3, objv+3);
+ }
+ Tcl_Release(busyPtr);
+ return result;
+
+ case BUSY_CURRENT: {
+ Tcl_HashEntry *hPtr;
+ Tcl_HashSearch cursor;
+ const char *pattern = (objc == 3 ? Tcl_GetString(objv[2]) : NULL);
+
+ objPtr = Tcl_NewObj();
+ for (hPtr = Tcl_FirstHashEntry(busyTablePtr, &cursor); hPtr != NULL;
+ hPtr = Tcl_NextHashEntry(&cursor)) {
+ busyPtr = Tcl_GetHashValue(hPtr);
+ if (pattern == NULL ||
+ Tcl_StringMatch(Tk_PathName(busyPtr->tkRef), pattern)) {
+ Tcl_ListObjAppendElement(interp, objPtr,
+ TkNewWindowObj(busyPtr->tkRef));
+ }
+ }
+ Tcl_SetObjResult(interp, objPtr);
+ return TCL_OK;
+ }
+
+ case BUSY_FORGET:
+ if (objc != 3) {
+ Tcl_WrongNumArgs(interp, 2, objv, "window");
+ return TCL_ERROR;
+ }
+ busyPtr = GetBusy(interp, busyTablePtr, objv[2]);
+ if (busyPtr == NULL) {
+ return TCL_ERROR;
+ }
+ TkpHideBusyWindow(busyPtr);
+ Tcl_EventuallyFree(busyPtr, (Tcl_FreeProc *)DestroyBusy);
+ return TCL_OK;
+
+ case BUSY_HOLD:
+ if (objc < 3 || objc%2 != 1) {
+ Tcl_WrongNumArgs(interp, 2, objv, "window ?option value ...?");
+ return TCL_ERROR;
+ }
+ return HoldBusy(busyTablePtr, interp, objv[2], objc-3, objv+3);
+
+ case BUSY_STATUS:
+ if (objc != 3) {
+ Tcl_WrongNumArgs(interp, 2, objv, "window");
+ return TCL_ERROR;
+ }
+ Tcl_SetObjResult(interp, Tcl_NewBooleanObj(
+ GetBusy(interp, busyTablePtr, objv[2]) != NULL));
+ return TCL_OK;
+ }
+
+ Tcl_Panic("unhandled option: %d", index);
+ return TCL_ERROR; /* Unreachable */
+}
+
+/*
+ * Local Variables:
+ * mode: c
+ * c-basic-offset: 4
+ * fill-column: 78
+ * End:
+ */
diff --git a/tk8.6/generic/tkBusy.h b/tk8.6/generic/tkBusy.h
new file mode 100644
index 0000000..9e6b69b
--- /dev/null
+++ b/tk8.6/generic/tkBusy.h
@@ -0,0 +1,41 @@
+/*
+ * tkBusy.h --
+ *
+ * This file defines the type of the structure describing a busy window.
+ *
+ * Copyright 1993-1998 Lucent Technologies, Inc.
+ *
+ * The "busy" command was created by George Howlett. Adapted for
+ * integration into Tk by Jos Decoster and Donal K. Fellows.
+ *
+ * See the file "license.terms" for information on usage and redistribution of
+ * this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ */
+
+typedef struct Busy {
+ Display *display; /* Display of busy window */
+ Tcl_Interp *interp; /* Interpreter where "busy" command was
+ * created. It's used to key the searches in
+ * the window hierarchy. See the "windows"
+ * command. */
+ Tk_Window tkBusy; /* Busy window: Transparent window used to
+ * block delivery of events to windows
+ * underneath it. */
+ Tk_Window tkParent; /* Parent window of the busy window. It may be
+ * the reference window (if the reference is a
+ * toplevel) or a mutual ancestor of the
+ * reference window */
+ Tk_Window tkRef; /* Reference window of the busy window. It is
+ * used to manage the size and position of the
+ * busy window. */
+ int x, y; /* Position of the reference window */
+ int width, height; /* Size of the reference window. Retained to
+ * know if the reference window has been
+ * reconfigured to a new size. */
+ int menuBar; /* Menu bar flag. */
+ Tk_Cursor cursor; /* Cursor for the busy window. */
+ Tcl_HashEntry *hashPtr; /* Used the delete the busy window entry out
+ * of the global hash table. */
+ Tcl_HashTable *tablePtr;
+ Tk_OptionTable optionTable;
+} Busy;
diff --git a/tk8.6/generic/tkButton.c b/tk8.6/generic/tkButton.c
new file mode 100644
index 0000000..b7e314e
--- /dev/null
+++ b/tk8.6/generic/tkButton.c
@@ -0,0 +1,1878 @@
+/*
+ * tkButton.c --
+ *
+ * This module implements a collection of button-like widgets for the Tk
+ * toolkit. The widgets implemented include buttons, checkbuttons,
+ * radiobuttons, and labels.
+ *
+ * Copyright (c) 1990-1994 The Regents of the University of California.
+ * Copyright (c) 1994-1998 Sun Microsystems, Inc.
+ *
+ * See the file "license.terms" for information on usage and redistribution of
+ * this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ */
+
+#include "tkInt.h"
+#include "tkButton.h"
+#include "default.h"
+
+typedef struct ThreadSpecificData {
+ int defaultsInitialized;
+} ThreadSpecificData;
+static Tcl_ThreadDataKey dataKey;
+
+/*
+ * Class names for buttons, indexed by one of the type values defined in
+ * tkButton.h.
+ */
+
+static const char *const classNames[] = {"Label", "Button", "Checkbutton", "Radiobutton"};
+
+/*
+ * The following table defines the legal values for the -default option. It is
+ * used together with the "enum defaultValue" declaration in tkButton.h.
+ */
+
+static const char *const defaultStrings[] = {
+ "active", "disabled", "normal", 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 const char *const stateStrings[] = {
+ "active", "disabled", "normal", NULL
+};
+
+/*
+ * The following table defines the legal values for the -compound option.
+ * It is used with the "enum compound" declaration in tkButton.h
+ */
+
+static const char *const compoundStrings[] = {
+ "bottom", "center", "left", "none", "right", "top", NULL
+};
+
+char tkDefButtonHighlightWidth[TCL_INTEGER_SPACE] = DEF_BUTTON_HIGHLIGHT_WIDTH;
+char tkDefButtonPadx[TCL_INTEGER_SPACE] = DEF_BUTTON_PADX;
+char tkDefButtonPady[TCL_INTEGER_SPACE] = DEF_BUTTON_PADY;
+char tkDefButtonBorderWidth[TCL_INTEGER_SPACE] = DEF_BUTTON_BORDER_WIDTH;
+char tkDefLabelHighlightWidth[TCL_INTEGER_SPACE] = DEF_LABEL_HIGHLIGHT_WIDTH;
+char tkDefLabelPadx[TCL_INTEGER_SPACE] = DEF_LABCHKRAD_PADX;
+char tkDefLabelPady[TCL_INTEGER_SPACE] = DEF_LABCHKRAD_PADY;
+
+/*
+ * Information used for parsing configuration options. There is a
+ * separate table for each of the four widget classes.
+ */
+
+static const Tk_OptionSpec labelOptionSpecs[] = {
+ {TK_OPTION_BORDER, "-activebackground", "activeBackground", "Foreground",
+ DEF_BUTTON_ACTIVE_BG_COLOR, -1, Tk_Offset(TkButton, activeBorder),
+ 0, 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, 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, DEF_BUTTON_BG_MONO, 0},
+ {TK_OPTION_SYNONYM, "-bd", NULL, NULL,
+ NULL, 0, -1, 0, "-borderwidth", 0},
+ {TK_OPTION_SYNONYM, "-bg", NULL, NULL,
+ NULL, 0, -1, 0, "-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",
+ tkDefButtonBorderWidth, Tk_Offset(TkButton, borderWidthPtr),
+ Tk_Offset(TkButton, borderWidth), 0, 0, 0},
+ {TK_OPTION_STRING_TABLE, "-compound", "compound", "Compound",
+ DEF_BUTTON_COMPOUND, -1, Tk_Offset(TkButton, compound), 0,
+ compoundStrings, 0},
+ {TK_OPTION_CURSOR, "-cursor", "cursor", "Cursor",
+ DEF_BUTTON_CURSOR, -1, Tk_Offset(TkButton, cursor),
+ TK_OPTION_NULL_OK, 0, 0},
+ {TK_OPTION_COLOR, "-disabledforeground", "disabledForeground",
+ "DisabledForeground", DEF_BUTTON_DISABLED_FG_COLOR,
+ -1, Tk_Offset(TkButton, disabledFg), TK_OPTION_NULL_OK,
+ (ClientData) DEF_BUTTON_DISABLED_FG_MONO, 0},
+ {TK_OPTION_SYNONYM, "-fg", "foreground", NULL,
+ NULL, 0, -1, 0, "-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", tkDefLabelHighlightWidth,
+ 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",
+ tkDefLabelPadx, Tk_Offset(TkButton, padXPtr),
+ Tk_Offset(TkButton, padX), 0, 0, 0},
+ {TK_OPTION_PIXELS, "-pady", "padY", "Pad",
+ tkDefLabelPady, 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, 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, NULL, NULL, NULL, NULL, 0, 0, 0, 0, 0}
+};
+
+static const Tk_OptionSpec buttonOptionSpecs[] = {
+ {TK_OPTION_BORDER, "-activebackground", "activeBackground", "Foreground",
+ DEF_BUTTON_ACTIVE_BG_COLOR, -1, Tk_Offset(TkButton, activeBorder),
+ 0, 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, 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, DEF_BUTTON_BG_MONO, 0},
+ {TK_OPTION_SYNONYM, "-bd", NULL, NULL,
+ NULL, 0, -1, 0, "-borderwidth", 0},
+ {TK_OPTION_SYNONYM, "-bg", NULL, NULL,
+ NULL, 0, -1, 0, "-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",
+ tkDefButtonBorderWidth, Tk_Offset(TkButton, borderWidthPtr),
+ Tk_Offset(TkButton, borderWidth), 0, 0, 0},
+ {TK_OPTION_STRING, "-command", "command", "Command",
+ DEF_BUTTON_COMMAND, Tk_Offset(TkButton, commandPtr), -1,
+ TK_OPTION_NULL_OK, 0, 0},
+ {TK_OPTION_STRING_TABLE, "-compound", "compound", "Compound",
+ DEF_BUTTON_COMPOUND, -1, Tk_Offset(TkButton, compound), 0,
+ compoundStrings, 0},
+ {TK_OPTION_CURSOR, "-cursor", "cursor", "Cursor",
+ DEF_BUTTON_CURSOR, -1, Tk_Offset(TkButton, cursor),
+ TK_OPTION_NULL_OK, 0, 0},
+ {TK_OPTION_STRING_TABLE, "-default", "default", "Default",
+ DEF_BUTTON_DEFAULT, -1, Tk_Offset(TkButton, defaultState),
+ 0, 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", NULL,
+ NULL, 0, -1, 0, "-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", tkDefButtonHighlightWidth,
+ Tk_Offset(TkButton, highlightWidthPtr),
+ Tk_Offset(TkButton, highlightWidth), 0, 0, 0},
+ {TK_OPTION_STRING, "-image", "image", "Image",
+ DEF_BUTTON_IMAGE, Tk_Offset(TkButton, imagePtr), -1,
+ TK_OPTION_NULL_OK, 0, 0},
+ {TK_OPTION_JUSTIFY, "-justify", "justify", "Justify",
+ DEF_BUTTON_JUSTIFY, -1, Tk_Offset(TkButton, justify), 0, 0, 0},
+ {TK_OPTION_RELIEF, "-overrelief", "overRelief", "OverRelief",
+ DEF_BUTTON_OVER_RELIEF, -1, Tk_Offset(TkButton, overRelief),
+ TK_OPTION_NULL_OK, 0, 0},
+ {TK_OPTION_PIXELS, "-padx", "padX", "Pad",
+ tkDefButtonPadx, Tk_Offset(TkButton, padXPtr),
+ Tk_Offset(TkButton, padX), 0, 0, 0},
+ {TK_OPTION_PIXELS, "-pady", "padY", "Pad",
+ tkDefButtonPady, Tk_Offset(TkButton, padYPtr),
+ Tk_Offset(TkButton, padY), 0, 0, 0},
+ {TK_OPTION_RELIEF, "-relief", "relief", "Relief",
+ DEF_BUTTON_RELIEF, -1, Tk_Offset(TkButton, relief),
+ 0, 0, 0},
+ {TK_OPTION_INT, "-repeatdelay", "repeatDelay", "RepeatDelay",
+ DEF_BUTTON_REPEAT_DELAY, -1, Tk_Offset(TkButton, repeatDelay),
+ 0, 0, 0},
+ {TK_OPTION_INT, "-repeatinterval", "repeatInterval", "RepeatInterval",
+ DEF_BUTTON_REPEAT_INTERVAL, -1, Tk_Offset(TkButton, repeatInterval),
+ 0, 0, 0},
+ {TK_OPTION_STRING_TABLE, "-state", "state", "State",
+ DEF_BUTTON_STATE, -1, Tk_Offset(TkButton, state),
+ 0, 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, NULL, NULL, NULL, NULL, 0, -1, 0, 0, 0}
+};
+
+static const Tk_OptionSpec checkbuttonOptionSpecs[] = {
+ {TK_OPTION_BORDER, "-activebackground", "activeBackground", "Foreground",
+ DEF_BUTTON_ACTIVE_BG_COLOR, -1, Tk_Offset(TkButton, activeBorder),
+ 0, 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, 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, DEF_BUTTON_BG_MONO, 0},
+ {TK_OPTION_SYNONYM, "-bd", NULL, NULL,
+ NULL, 0, -1, 0, "-borderwidth", 0},
+ {TK_OPTION_SYNONYM, "-bg", NULL, NULL,
+ NULL, 0, -1, 0, "-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",
+ tkDefButtonBorderWidth, Tk_Offset(TkButton, borderWidthPtr),
+ Tk_Offset(TkButton, borderWidth), 0, 0, 0},
+ {TK_OPTION_STRING, "-command", "command", "Command",
+ DEF_BUTTON_COMMAND, Tk_Offset(TkButton, commandPtr), -1,
+ TK_OPTION_NULL_OK, 0, 0},
+ {TK_OPTION_STRING_TABLE, "-compound", "compound", "Compound",
+ DEF_BUTTON_COMPOUND, -1, Tk_Offset(TkButton, compound), 0,
+ compoundStrings, 0},
+ {TK_OPTION_CURSOR, "-cursor", "cursor", "Cursor",
+ DEF_BUTTON_CURSOR, -1, Tk_Offset(TkButton, cursor),
+ TK_OPTION_NULL_OK, 0, 0},
+ {TK_OPTION_COLOR, "-disabledforeground", "disabledForeground",
+ "DisabledForeground", DEF_BUTTON_DISABLED_FG_COLOR,
+ -1, Tk_Offset(TkButton, disabledFg), TK_OPTION_NULL_OK,
+ (ClientData) DEF_BUTTON_DISABLED_FG_MONO, 0},
+ {TK_OPTION_SYNONYM, "-fg", "foreground", NULL,
+ NULL, 0, -1, 0, "-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", tkDefButtonHighlightWidth,
+ Tk_Offset(TkButton, highlightWidthPtr),
+ Tk_Offset(TkButton, highlightWidth), 0, 0, 0},
+ {TK_OPTION_STRING, "-image", "image", "Image",
+ DEF_BUTTON_IMAGE, Tk_Offset(TkButton, imagePtr), -1,
+ TK_OPTION_NULL_OK, 0, 0},
+ {TK_OPTION_BOOLEAN, "-indicatoron", "indicatorOn", "IndicatorOn",
+ DEF_BUTTON_INDICATOR, -1, Tk_Offset(TkButton, indicatorOn), 0, 0, 0},
+ {TK_OPTION_JUSTIFY, "-justify", "justify", "Justify",
+ DEF_BUTTON_JUSTIFY, -1, Tk_Offset(TkButton, justify), 0, 0, 0},
+ {TK_OPTION_RELIEF, "-offrelief", "offRelief", "OffRelief",
+ DEF_BUTTON_RELIEF, -1, Tk_Offset(TkButton, offRelief), 0, 0, 0},
+ {TK_OPTION_STRING, "-offvalue", "offValue", "Value",
+ DEF_BUTTON_OFF_VALUE, Tk_Offset(TkButton, offValuePtr), -1, 0, 0, 0},
+ {TK_OPTION_STRING, "-onvalue", "onValue", "Value",
+ DEF_BUTTON_ON_VALUE, Tk_Offset(TkButton, onValuePtr), -1, 0, 0, 0},
+ {TK_OPTION_RELIEF, "-overrelief", "overRelief", "OverRelief",
+ DEF_BUTTON_OVER_RELIEF, -1, Tk_Offset(TkButton, overRelief),
+ TK_OPTION_NULL_OK, 0, 0},
+ {TK_OPTION_PIXELS, "-padx", "padX", "Pad",
+ tkDefLabelPadx, Tk_Offset(TkButton, padXPtr),
+ Tk_Offset(TkButton, padX), 0, 0, 0},
+ {TK_OPTION_PIXELS, "-pady", "padY", "Pad",
+ tkDefLabelPady, 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, 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, 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_STRING, "-tristateimage", "tristateImage", "TristateImage",
+ DEF_BUTTON_IMAGE, Tk_Offset(TkButton, tristateImagePtr), -1,
+ TK_OPTION_NULL_OK, 0, 0},
+ {TK_OPTION_STRING, "-tristatevalue", "tristateValue", "TristateValue",
+ DEF_BUTTON_TRISTATE_VALUE, Tk_Offset(TkButton, tristateValuePtr), -1, 0, 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, NULL, NULL, NULL, NULL, 0, -1, 0, 0, 0}
+};
+
+static const Tk_OptionSpec radiobuttonOptionSpecs[] = {
+ {TK_OPTION_BORDER, "-activebackground", "activeBackground", "Foreground",
+ DEF_BUTTON_ACTIVE_BG_COLOR, -1, Tk_Offset(TkButton, activeBorder),
+ 0, 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, 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, DEF_BUTTON_BG_MONO, 0},
+ {TK_OPTION_SYNONYM, "-bd", NULL, NULL,
+ NULL, 0, -1, 0, "-borderwidth", 0},
+ {TK_OPTION_SYNONYM, "-bg", NULL, NULL,
+ NULL, 0, -1, 0, "-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",
+ tkDefButtonBorderWidth, Tk_Offset(TkButton, borderWidthPtr),
+ Tk_Offset(TkButton, borderWidth), 0, 0, 0},
+ {TK_OPTION_STRING, "-command", "command", "Command",
+ DEF_BUTTON_COMMAND, Tk_Offset(TkButton, commandPtr), -1,
+ TK_OPTION_NULL_OK, 0, 0},
+ {TK_OPTION_STRING_TABLE, "-compound", "compound", "Compound",
+ DEF_BUTTON_COMPOUND, -1, Tk_Offset(TkButton, compound), 0,
+ compoundStrings, 0},
+ {TK_OPTION_CURSOR, "-cursor", "cursor", "Cursor",
+ DEF_BUTTON_CURSOR, -1, Tk_Offset(TkButton, cursor),
+ TK_OPTION_NULL_OK, 0, 0},
+ {TK_OPTION_COLOR, "-disabledforeground", "disabledForeground",
+ "DisabledForeground", DEF_BUTTON_DISABLED_FG_COLOR,
+ -1, Tk_Offset(TkButton, disabledFg), TK_OPTION_NULL_OK,
+ (ClientData) DEF_BUTTON_DISABLED_FG_MONO, 0},
+ {TK_OPTION_SYNONYM, "-fg", "foreground", NULL,
+ NULL, 0, -1, 0, "-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", tkDefButtonHighlightWidth,
+ Tk_Offset(TkButton, highlightWidthPtr),
+ Tk_Offset(TkButton, highlightWidth), 0, 0, 0},
+ {TK_OPTION_STRING, "-image", "image", "Image",
+ DEF_BUTTON_IMAGE, Tk_Offset(TkButton, imagePtr), -1,
+ TK_OPTION_NULL_OK, 0, 0},
+ {TK_OPTION_BOOLEAN, "-indicatoron", "indicatorOn", "IndicatorOn",
+ DEF_BUTTON_INDICATOR, -1, Tk_Offset(TkButton, indicatorOn),
+ 0, 0, 0},
+ {TK_OPTION_JUSTIFY, "-justify", "justify", "Justify",
+ DEF_BUTTON_JUSTIFY, -1, Tk_Offset(TkButton, justify), 0, 0, 0},
+ {TK_OPTION_RELIEF, "-offrelief", "offRelief", "OffRelief",
+ DEF_BUTTON_RELIEF, -1, Tk_Offset(TkButton, offRelief), 0, 0, 0},
+ {TK_OPTION_RELIEF, "-overrelief", "overRelief", "OverRelief",
+ DEF_BUTTON_OVER_RELIEF, -1, Tk_Offset(TkButton, overRelief),
+ TK_OPTION_NULL_OK, 0, 0},
+ {TK_OPTION_PIXELS, "-padx", "padX", "Pad",
+ tkDefLabelPadx, Tk_Offset(TkButton, padXPtr),
+ Tk_Offset(TkButton, padX), 0, 0, 0},
+ {TK_OPTION_PIXELS, "-pady", "padY", "Pad",
+ tkDefLabelPady, 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, 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, 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_STRING, "-tristateimage", "tristateImage", "TristateImage",
+ DEF_BUTTON_IMAGE, Tk_Offset(TkButton, tristateImagePtr), -1,
+ TK_OPTION_NULL_OK, 0, 0},
+ {TK_OPTION_STRING, "-tristatevalue", "tristateValue", "TristateValue",
+ DEF_BUTTON_TRISTATE_VALUE, Tk_Offset(TkButton, tristateValuePtr), -1, 0, 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, NULL, NULL, NULL, 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 const Tk_OptionSpec *const optionSpecs[] = {
+ labelOptionSpecs,
+ buttonOptionSpecs,
+ checkbuttonOptionSpecs,
+ radiobuttonOptionSpecs
+};
+
+/*
+ * The following tables define the widget commands supported by each of the
+ * classes, and map the indexes into the string tables into a single
+ * enumerated type used to dispatch the widget command.
+ */
+
+static const char *const commandNames[][8] = {
+ {"cget", "configure", NULL},
+ {"cget", "configure", "flash", "invoke", NULL},
+ {"cget", "configure", "deselect", "flash", "invoke", "select",
+ "toggle", NULL},
+ {"cget", "configure", "deselect", "flash", "invoke", "select", NULL}
+};
+enum command {
+ COMMAND_CGET, COMMAND_CONFIGURE, COMMAND_DESELECT, COMMAND_FLASH,
+ COMMAND_INVOKE, COMMAND_SELECT, COMMAND_TOGGLE
+};
+static const enum command map[][8] = {
+ {COMMAND_CGET, COMMAND_CONFIGURE},
+ {COMMAND_CGET, COMMAND_CONFIGURE, COMMAND_FLASH, COMMAND_INVOKE},
+ {COMMAND_CGET, COMMAND_CONFIGURE, COMMAND_DESELECT, COMMAND_FLASH,
+ COMMAND_INVOKE, COMMAND_SELECT, COMMAND_TOGGLE},
+ {COMMAND_CGET, COMMAND_CONFIGURE, COMMAND_DESELECT, COMMAND_FLASH,
+ COMMAND_INVOKE, COMMAND_SELECT}
+};
+
+/*
+ * Forward declarations for functions defined later in this file:
+ */
+
+static void ButtonCmdDeletedProc(ClientData clientData);
+static int ButtonCreate(ClientData clientData,
+ Tcl_Interp *interp, int objc,
+ Tcl_Obj *const objv[], int type);
+static void ButtonEventProc(ClientData clientData,
+ XEvent *eventPtr);
+static void ButtonImageProc(ClientData clientData,
+ int x, int y, int width, int height,
+ int imgWidth, int imgHeight);
+static void ButtonSelectImageProc(ClientData clientData,
+ int x, int y, int width, int height,
+ int imgWidth, int imgHeight);
+static void ButtonTristateImageProc(ClientData clientData,
+ int x, int y, int width, int height,
+ int imgWidth, int imgHeight);
+static char * ButtonTextVarProc(ClientData clientData,
+ Tcl_Interp *interp, const char *name1,
+ const char *name2, int flags);
+static char * ButtonVarProc(ClientData clientData,
+ Tcl_Interp *interp, const char *name1,
+ const char *name2, int flags);
+static int ButtonWidgetObjCmd(ClientData clientData,
+ Tcl_Interp *interp, int objc,
+ Tcl_Obj *const objv[]);
+static int ConfigureButton(Tcl_Interp *interp, TkButton *butPtr,
+ int objc, Tcl_Obj *const objv[]);
+static void DestroyButton(TkButton *butPtr);
+
+/*
+ *--------------------------------------------------------------
+ *
+ * Tk_ButtonCmd, Tk_CheckbuttonCmd, Tk_LabelCmd, Tk_RadiobuttonCmd --
+ *
+ * These functions are invoked to process the "button", "label",
+ * "radiobutton", and "checkbutton" Tcl commands. See the user
+ * documentation for details on what they do.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * See the user documentation. These functions are just wrappers; they
+ * call ButtonCreate to do all of the real work.
+ *
+ *--------------------------------------------------------------
+ */
+
+int
+Tk_ButtonObjCmd(
+ ClientData clientData, /* Either NULL or pointer to option table. */
+ Tcl_Interp *interp, /* Current interpreter. */
+ int objc, /* Number of arguments. */
+ Tcl_Obj *const objv[]) /* Argument values. */
+{
+ return ButtonCreate(clientData, interp, objc, objv, TYPE_BUTTON);
+}
+
+int
+Tk_CheckbuttonObjCmd(
+ ClientData clientData, /* Either NULL or pointer to option table. */
+ Tcl_Interp *interp, /* Current interpreter. */
+ int objc, /* Number of arguments. */
+ Tcl_Obj *const objv[]) /* Argument values. */
+{
+ return ButtonCreate(clientData, interp, objc, objv, TYPE_CHECK_BUTTON);
+}
+
+int
+Tk_LabelObjCmd(
+ ClientData clientData, /* Either NULL or pointer to option table. */
+ Tcl_Interp *interp, /* Current interpreter. */
+ int objc, /* Number of arguments. */
+ Tcl_Obj *const objv[]) /* Argument values. */
+{
+ return ButtonCreate(clientData, interp, objc, objv, TYPE_LABEL);
+}
+
+int
+Tk_RadiobuttonObjCmd(
+ ClientData clientData, /* Either NULL or pointer to option table. */
+ Tcl_Interp *interp, /* Current interpreter. */
+ int objc, /* Number of arguments. */
+ Tcl_Obj *const objv[]) /* Argument values. */
+{
+ return ButtonCreate(clientData, interp, objc, objv, TYPE_RADIO_BUTTON);
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * ButtonCreate --
+ *
+ * This function does all the real work of implementing the "button",
+ * "label", "radiobutton", and "checkbutton" Tcl commands. See the user
+ * documentation for details on what it does.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * See the user documentation.
+ *
+ *--------------------------------------------------------------
+ */
+
+static int
+ButtonCreate(
+ ClientData clientData, /* NULL. */
+ Tcl_Interp *interp, /* Current interpreter. */
+ int objc, /* Number of arguments. */
+ Tcl_Obj *const objv[], /* Argument values. */
+ int type) /* Type of button to create: TYPE_LABEL,
+ * TYPE_BUTTON, TYPE_CHECK_BUTTON, or
+ * TYPE_RADIO_BUTTON. */
+{
+ TkButton *butPtr;
+ Tk_OptionTable optionTable;
+ Tk_Window tkwin;
+ ThreadSpecificData *tsdPtr =
+ Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
+
+ if (!tsdPtr->defaultsInitialized) {
+ TkpButtonSetDefaults();
+ tsdPtr->defaultsInitialized = 1;
+ }
+
+ if (objc < 2) {
+ Tcl_WrongNumArgs(interp, 1, objv, "pathName ?-option value ...?");
+ return TCL_ERROR;
+ }
+
+ /*
+ * Create the new window.
+ */
+
+ tkwin = Tk_CreateWindowFromPath(interp, Tk_MainWindow(interp),
+ Tcl_GetString(objv[1]), NULL);
+ if (tkwin == NULL) {
+ return TCL_ERROR;
+ }
+
+ /*
+ * Create the option table for this widget class. If it has already been
+ * created, the cached pointer will be returned.
+ */
+
+ optionTable = Tk_CreateOptionTable(interp, optionSpecs[type]);
+
+ Tk_SetClass(tkwin, classNames[type]);
+ butPtr = TkpCreateButton(tkwin);
+
+ Tk_SetClassProcs(tkwin, &tkpButtonProcs, butPtr);
+
+ /*
+ * Initialize the data structure for the button.
+ */
+
+ butPtr->tkwin = tkwin;
+ butPtr->display = Tk_Display(tkwin);
+ butPtr->interp = interp;
+ butPtr->widgetCmd = Tcl_CreateObjCommand(interp, Tk_PathName(tkwin),
+ ButtonWidgetObjCmd, butPtr, ButtonCmdDeletedProc);
+ butPtr->type = type;
+ butPtr->optionTable = optionTable;
+ butPtr->textPtr = NULL;
+ butPtr->underline = -1;
+ butPtr->textVarNamePtr = NULL;
+ butPtr->bitmap = None;
+ butPtr->imagePtr = NULL;
+ butPtr->image = NULL;
+ butPtr->selectImagePtr = NULL;
+ butPtr->selectImage = NULL;
+ butPtr->tristateImagePtr = NULL;
+ butPtr->tristateImage = NULL;
+ butPtr->state = STATE_NORMAL;
+ butPtr->normalBorder = NULL;
+ butPtr->activeBorder = NULL;
+ butPtr->borderWidthPtr = NULL;
+ butPtr->borderWidth = 0;
+ butPtr->relief = TK_RELIEF_FLAT;
+ butPtr->highlightWidthPtr = NULL;
+ butPtr->highlightWidth = 0;
+ butPtr->highlightBorder = NULL;
+ butPtr->highlightColorPtr = NULL;
+ butPtr->inset = 0;
+ butPtr->tkfont = NULL;
+ butPtr->normalFg = NULL;
+ butPtr->activeFg = NULL;
+ butPtr->disabledFg = NULL;
+ butPtr->normalTextGC = None;
+ butPtr->activeTextGC = None;
+ butPtr->disabledGC = None;
+ butPtr->stippleGC = None;
+ butPtr->gray = None;
+ butPtr->copyGC = None;
+ butPtr->widthPtr = NULL;
+ butPtr->width = 0;
+ butPtr->heightPtr = NULL;
+ butPtr->height = 0;
+ butPtr->wrapLengthPtr = NULL;
+ butPtr->wrapLength = 0;
+ butPtr->padXPtr = NULL;
+ butPtr->padX = 0;
+ butPtr->padYPtr = NULL;
+ butPtr->padY = 0;
+ butPtr->anchor = TK_ANCHOR_CENTER;
+ butPtr->justify = TK_JUSTIFY_CENTER;
+ butPtr->indicatorOn = 0;
+ butPtr->selectBorder = NULL;
+ butPtr->textWidth = 0;
+ butPtr->textHeight = 0;
+ butPtr->textLayout = NULL;
+ butPtr->indicatorSpace = 0;
+ butPtr->indicatorDiameter = 0;
+ butPtr->defaultState = DEFAULT_DISABLED;
+ butPtr->selVarNamePtr = NULL;
+ butPtr->onValuePtr = NULL;
+ butPtr->offValuePtr = NULL;
+ butPtr->tristateValuePtr = NULL;
+ butPtr->cursor = None;
+ butPtr->takeFocusPtr = NULL;
+ butPtr->commandPtr = NULL;
+ butPtr->flags = 0;
+
+ Tk_CreateEventHandler(butPtr->tkwin,
+ ExposureMask|StructureNotifyMask|FocusChangeMask,
+ ButtonEventProc, butPtr);
+
+ if (Tk_InitOptions(interp, (char *) butPtr, optionTable, tkwin)
+ != TCL_OK) {
+ Tk_DestroyWindow(butPtr->tkwin);
+ return TCL_ERROR;
+ }
+ if (ConfigureButton(interp, butPtr, objc - 2, objv + 2) != TCL_OK) {
+ Tk_DestroyWindow(butPtr->tkwin);
+ return TCL_ERROR;
+ }
+
+ Tcl_SetObjResult(interp, TkNewWindowObj(butPtr->tkwin));
+ return TCL_OK;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * ButtonWidgetCmd --
+ *
+ * This function is invoked to process the Tcl command that corresponds
+ * to a widget managed by this module. See the user documentation for
+ * details on what it does.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * See the user documentation.
+ *
+ *--------------------------------------------------------------
+ */
+
+static int
+ButtonWidgetObjCmd(
+ ClientData clientData, /* Information about button widget. */
+ Tcl_Interp *interp, /* Current interpreter. */
+ int objc, /* Number of arguments. */
+ Tcl_Obj *const objv[]) /* Argument values. */
+{
+ TkButton *butPtr = clientData;
+ int index;
+ int result;
+ Tcl_Obj *objPtr;
+
+ if (objc < 2) {
+ Tcl_WrongNumArgs(interp, 1, objv, "option ?arg ...?");
+ return TCL_ERROR;
+ }
+ result = Tcl_GetIndexFromObjStruct(interp, objv[1], commandNames[butPtr->type],
+ sizeof(char *), "option", 0, &index);
+ if (result != TCL_OK) {
+ return result;
+ }
+ Tcl_Preserve(butPtr);
+
+ switch (map[butPtr->type][index]) {
+ case COMMAND_CGET:
+ if (objc != 3) {
+ Tcl_WrongNumArgs(interp, 1, objv, "cget option");
+ goto error;
+ }
+ objPtr = Tk_GetOptionValue(interp, (char *) butPtr,
+ butPtr->optionTable, objv[2], butPtr->tkwin);
+ if (objPtr == NULL) {
+ goto error;
+ }
+ Tcl_SetObjResult(interp, objPtr);
+ break;
+
+ case COMMAND_CONFIGURE:
+ if (objc <= 3) {
+ objPtr = Tk_GetOptionInfo(interp, (char *) butPtr,
+ butPtr->optionTable, (objc == 3) ? objv[2] : NULL,
+ butPtr->tkwin);
+ if (objPtr == NULL) {
+ goto error;
+ }
+ Tcl_SetObjResult(interp, objPtr);
+ } else {
+ result = ConfigureButton(interp, butPtr, objc-2, objv+2);
+ }
+ break;
+
+ case COMMAND_DESELECT:
+ if (objc > 2) {
+ Tcl_WrongNumArgs(interp, 1, objv, "deselect");
+ goto error;
+ }
+ if (butPtr->type == TYPE_CHECK_BUTTON) {
+ if (Tcl_ObjSetVar2(interp, butPtr->selVarNamePtr, NULL,
+ butPtr->offValuePtr, TCL_GLOBAL_ONLY|TCL_LEAVE_ERR_MSG)
+ == NULL) {
+ goto error;
+ }
+ } else if (butPtr->flags & SELECTED) {
+ if (Tcl_ObjSetVar2(interp, butPtr->selVarNamePtr, NULL,
+ Tcl_NewObj(), TCL_GLOBAL_ONLY|TCL_LEAVE_ERR_MSG) == NULL){
+ goto error;
+ }
+ }
+ break;
+
+ case COMMAND_FLASH:
+ if (objc > 2) {
+ Tcl_WrongNumArgs(interp, 1, objv, "flash");
+ goto error;
+ }
+ if (butPtr->state != STATE_DISABLED) {
+ int i;
+
+ 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(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, butPtr);
+ XFlush(butPtr->display);
+ Tcl_Sleep(50);
+ }
+ }
+ break;
+
+ case COMMAND_INVOKE:
+ if (objc > 2) {
+ Tcl_WrongNumArgs(interp, 1, objv, "invoke");
+ goto error;
+ }
+ if (butPtr->state != STATE_DISABLED) {
+ result = TkInvokeButton(butPtr);
+ }
+ break;
+
+ case COMMAND_SELECT:
+ if (objc > 2) {
+ Tcl_WrongNumArgs(interp, 1, objv, "select");
+ goto error;
+ }
+ if (Tcl_ObjSetVar2(interp, butPtr->selVarNamePtr, NULL,
+ butPtr->onValuePtr, TCL_GLOBAL_ONLY|TCL_LEAVE_ERR_MSG)
+ == NULL) {
+ goto error;
+ }
+ break;
+
+ case COMMAND_TOGGLE:
+ if (objc > 2) {
+ Tcl_WrongNumArgs(interp, 1, objv, "toggle");
+ goto error;
+ }
+ if (Tcl_ObjSetVar2(interp, butPtr->selVarNamePtr, NULL,
+ (butPtr->flags & SELECTED) ? butPtr->offValuePtr
+ : butPtr->onValuePtr, TCL_GLOBAL_ONLY|TCL_LEAVE_ERR_MSG)
+ == NULL) {
+ goto error;
+ }
+ break;
+ }
+ Tcl_Release(butPtr);
+ return result;
+
+ error:
+ Tcl_Release(butPtr);
+ return TCL_ERROR;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * DestroyButton --
+ *
+ * This function is invoked by ButtonEventProc to free all the resources
+ * of a button and clean up its state.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Everything associated with the widget is freed.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+DestroyButton(
+ TkButton *butPtr) /* Info about button widget. */
+{
+ butPtr->flags |= BUTTON_DELETED;
+ TkpDestroyButton(butPtr);
+
+ if (butPtr->flags & REDRAW_PENDING) {
+ Tcl_CancelIdleCall(TkpDisplayButton, butPtr);
+ }
+
+ /*
+ * Free up all the stuff that requires special handling, then let
+ * Tk_FreeOptions handle all the standard option-related stuff.
+ */
+
+ Tcl_DeleteCommandFromToken(butPtr->interp, butPtr->widgetCmd);
+ if (butPtr->textVarNamePtr != NULL) {
+ Tcl_UntraceVar2(butPtr->interp, Tcl_GetString(butPtr->textVarNamePtr),
+ NULL, TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS,
+ ButtonTextVarProc, butPtr);
+ }
+ if (butPtr->image != NULL) {
+ Tk_FreeImage(butPtr->image);
+ }
+ if (butPtr->selectImage != NULL) {
+ Tk_FreeImage(butPtr->selectImage);
+ }
+ if (butPtr->tristateImage != NULL) {
+ Tk_FreeImage(butPtr->tristateImage);
+ }
+ if (butPtr->normalTextGC != None) {
+ Tk_FreeGC(butPtr->display, butPtr->normalTextGC);
+ }
+ if (butPtr->activeTextGC != None) {
+ Tk_FreeGC(butPtr->display, butPtr->activeTextGC);
+ }
+ if (butPtr->disabledGC != None) {
+ Tk_FreeGC(butPtr->display, butPtr->disabledGC);
+ }
+ if (butPtr->stippleGC != None) {
+ Tk_FreeGC(butPtr->display, butPtr->stippleGC);
+ }
+ if (butPtr->gray != None) {
+ Tk_FreeBitmap(butPtr->display, butPtr->gray);
+ }
+ if (butPtr->copyGC != None) {
+ Tk_FreeGC(butPtr->display, butPtr->copyGC);
+ }
+ if (butPtr->textLayout != NULL) {
+ Tk_FreeTextLayout(butPtr->textLayout);
+ }
+ if (butPtr->selVarNamePtr != NULL) {
+ Tcl_UntraceVar2(butPtr->interp, Tcl_GetString(butPtr->selVarNamePtr),
+ NULL, TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS,
+ ButtonVarProc, butPtr);
+ }
+ Tk_FreeConfigOptions((char *) butPtr, butPtr->optionTable,
+ butPtr->tkwin);
+ butPtr->tkwin = NULL;
+ Tcl_EventuallyFree(butPtr, TCL_DYNAMIC);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ConfigureButton --
+ *
+ * This function is called to process an objc/objv list to set
+ * configuration options for a button widget.
+ *
+ * Results:
+ * The return value is a standard Tcl result. If TCL_ERROR is returned,
+ * then an error message is left in interp's result.
+ *
+ * Side effects:
+ * Configuration information, such as text string, colors, font, etc. get
+ * set for butPtr; old resources get freed, if there were any. The button
+ * is redisplayed.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+ConfigureButton(
+ Tcl_Interp *interp, /* Used for error reporting. */
+ register TkButton *butPtr, /* Information about widget; may or may
+ * not already have values for some fields. */
+ int objc, /* Number of arguments. */
+ Tcl_Obj *const objv[]) /* Argument values. */
+{
+ Tk_SavedOptions savedOptions;
+ Tcl_Obj *errorResult = NULL;
+ int error, haveImage;
+ Tk_Image image;
+
+ /*
+ * Eliminate any existing trace on variables monitored by the button.
+ */
+
+ if (butPtr->textVarNamePtr != NULL) {
+ Tcl_UntraceVar2(interp, Tcl_GetString(butPtr->textVarNamePtr),
+ NULL, TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS,
+ ButtonTextVarProc, butPtr);
+ }
+ if (butPtr->selVarNamePtr != NULL) {
+ Tcl_UntraceVar2(interp, Tcl_GetString(butPtr->selVarNamePtr),
+ NULL, TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS,
+ ButtonVarProc, butPtr);
+ }
+
+ /*
+ * The following loop is potentially executed twice. During the first pass
+ * configuration options get set to their new values. If there is an error
+ * in this pass, we execute a second pass to restore all the options to
+ * their previous values.
+ */
+
+ for (error = 0; error <= 1; error++) {
+ if (!error) {
+ /*
+ * First pass: set options to new values.
+ */
+
+ if (Tk_SetOptions(interp, (char *) butPtr,
+ butPtr->optionTable, objc, objv,
+ butPtr->tkwin, &savedOptions, NULL) != TCL_OK) {
+ continue;
+ }
+ } else {
+ /*
+ * Second pass: restore options to old values.
+ */
+
+ errorResult = Tcl_GetObjResult(interp);
+ Tcl_IncrRefCount(errorResult);
+ Tk_RestoreSavedOptions(&savedOptions);
+ }
+
+ if ((butPtr->flags & BUTTON_DELETED)) {
+ /*
+ * Somehow button was deleted - just abort now. [Bug #824479]
+ */
+ 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_SetOptions.
+ */
+
+ if ((butPtr->state == STATE_ACTIVE)
+ && !Tk_StrictMotif(butPtr->tkwin)) {
+ Tk_SetBackgroundFromBorder(butPtr->tkwin, butPtr->activeBorder);
+ } else {
+ Tk_SetBackgroundFromBorder(butPtr->tkwin, butPtr->normalBorder);
+ }
+ if (butPtr->borderWidth < 0) {
+ butPtr->borderWidth = 0;
+ }
+ if (butPtr->highlightWidth < 0) {
+ butPtr->highlightWidth = 0;
+ }
+ if (butPtr->padX < 0) {
+ butPtr->padX = 0;
+ }
+ if (butPtr->padY < 0) {
+ butPtr->padY = 0;
+ }
+
+ if (butPtr->type >= TYPE_CHECK_BUTTON) {
+ Tcl_Obj *valuePtr, *namePtr;
+
+ if (butPtr->selVarNamePtr == NULL) {
+ butPtr->selVarNamePtr = Tcl_NewStringObj(
+ Tk_Name(butPtr->tkwin), -1);
+ Tcl_IncrRefCount(butPtr->selVarNamePtr);
+ }
+ namePtr = butPtr->selVarNamePtr;
+
+ /*
+ * Select the button if the associated variable has the
+ * appropriate value, initialize the variable if it doesn't exist,
+ * then set a trace on the variable to monitor future changes to
+ * its value.
+ */
+
+ valuePtr = Tcl_ObjGetVar2(interp, namePtr, NULL, TCL_GLOBAL_ONLY);
+ butPtr->flags &= ~SELECTED;
+ butPtr->flags &= ~TRISTATED;
+ if (valuePtr != NULL) {
+ const char *value = Tcl_GetString(valuePtr);
+ if (strcmp(value, Tcl_GetString(butPtr->onValuePtr)) == 0) {
+ butPtr->flags |= SELECTED;
+ } else if (strcmp(value,
+ Tcl_GetString(butPtr->tristateValuePtr)) == 0) {
+ butPtr->flags |= TRISTATED;
+
+ /*
+ * For checkbuttons if the tristate value is the
+ * same as the offvalue then prefer off to tristate
+ */
+
+ if (butPtr->offValuePtr
+ && strcmp(value,
+ Tcl_GetString(butPtr->offValuePtr)) == 0) {
+ butPtr->flags &= ~TRISTATED;
+ }
+ }
+ } else {
+ if (Tcl_ObjSetVar2(interp, namePtr, NULL,
+ (butPtr->type == TYPE_CHECK_BUTTON)
+ ? butPtr->offValuePtr : Tcl_NewObj(),
+ TCL_GLOBAL_ONLY|TCL_LEAVE_ERR_MSG)
+ == NULL) {
+ continue;
+ }
+
+ /*
+ * If a radiobutton has the empty string as value it should be
+ * selected.
+ */
+
+ if ((butPtr->type == TYPE_RADIO_BUTTON) &&
+ (*Tcl_GetString(butPtr->onValuePtr) == 0)) {
+ butPtr->flags |= SELECTED;
+ }
+ }
+ }
+
+ /*
+ * Get the images for the widget, if there are any. Allocate the new
+ * images before freeing the old ones, so that the reference counts
+ * don't go to zero and cause image data to be discarded.
+ */
+
+ if (butPtr->imagePtr != NULL) {
+ image = Tk_GetImage(butPtr->interp, butPtr->tkwin,
+ Tcl_GetString(butPtr->imagePtr), ButtonImageProc,
+ butPtr);
+ if (image == NULL) {
+ continue;
+ }
+ } else {
+ image = NULL;
+ }
+ if (butPtr->image != NULL) {
+ Tk_FreeImage(butPtr->image);
+ }
+ butPtr->image = image;
+ if (butPtr->selectImagePtr != NULL) {
+ image = Tk_GetImage(butPtr->interp, butPtr->tkwin,
+ Tcl_GetString(butPtr->selectImagePtr),
+ ButtonSelectImageProc, butPtr);
+ if (image == NULL) {
+ continue;
+ }
+ } else {
+ image = NULL;
+ }
+ if (butPtr->selectImage != NULL) {
+ Tk_FreeImage(butPtr->selectImage);
+ }
+ butPtr->selectImage = image;
+ if (butPtr->tristateImagePtr != NULL) {
+ image = Tk_GetImage(butPtr->interp, butPtr->tkwin,
+ Tcl_GetString(butPtr->tristateImagePtr),
+ ButtonTristateImageProc, butPtr);
+ if (image == NULL) {
+ continue;
+ }
+ } else {
+ image = NULL;
+ }
+ if (butPtr->tristateImage != NULL) {
+ Tk_FreeImage(butPtr->tristateImage);
+ }
+ butPtr->tristateImage = image;
+
+ haveImage = 0;
+ if (butPtr->imagePtr != NULL || butPtr->bitmap != None) {
+ haveImage = 1;
+ }
+ if ((!haveImage || butPtr->compound != COMPOUND_NONE)
+ && (butPtr->textVarNamePtr != NULL)) {
+ /*
+ * The button must display the value of a variable: set up a trace
+ * on the variable's value, create the variable if it doesn't
+ * exist, and fetch its current value.
+ */
+
+ Tcl_Obj *valuePtr, *namePtr;
+
+ namePtr = butPtr->textVarNamePtr;
+ valuePtr = Tcl_ObjGetVar2(interp, namePtr, NULL, TCL_GLOBAL_ONLY);
+ if (valuePtr == NULL) {
+ if (Tcl_ObjSetVar2(interp, namePtr, NULL, butPtr->textPtr,
+ TCL_GLOBAL_ONLY|TCL_LEAVE_ERR_MSG)
+ == NULL) {
+ continue;
+ }
+ } else {
+ if (butPtr->textPtr != NULL) {
+ Tcl_DecrRefCount(butPtr->textPtr);
+ }
+ butPtr->textPtr = valuePtr;
+ Tcl_IncrRefCount(butPtr->textPtr);
+ }
+ }
+
+ if ((butPtr->bitmap != None) || (butPtr->imagePtr != NULL)) {
+ /*
+ * The button must display the contents of an image or bitmap.
+ */
+
+ if (Tk_GetPixelsFromObj(interp, butPtr->tkwin, butPtr->widthPtr,
+ &butPtr->width) != TCL_OK) {
+ widthError:
+ Tcl_AddErrorInfo(interp, "\n (processing -width option)");
+ continue;
+ }
+ if (Tk_GetPixelsFromObj(interp, butPtr->tkwin, butPtr->heightPtr,
+ &butPtr->height) != TCL_OK) {
+ heightError:
+ Tcl_AddErrorInfo(interp, "\n (processing -height option)");
+ continue;
+ }
+ } else {
+ /*
+ * The button displays an ordinary text string.
+ */
+
+ if (Tcl_GetIntFromObj(interp, butPtr->widthPtr, &butPtr->width)
+ != TCL_OK) {
+ goto widthError;
+ }
+ if (Tcl_GetIntFromObj(interp, butPtr->heightPtr, &butPtr->height)
+ != TCL_OK) {
+ goto heightError;
+ }
+ }
+ break;
+ }
+ if (!error) {
+ Tk_FreeSavedOptions(&savedOptions);
+ }
+
+ /*
+ * Reestablish the variable traces, if they're needed.
+ */
+
+ if (butPtr->textVarNamePtr != NULL) {
+ Tcl_TraceVar2(interp, Tcl_GetString(butPtr->textVarNamePtr),
+ NULL, TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS,
+ ButtonTextVarProc, butPtr);
+ }
+ if (butPtr->selVarNamePtr != NULL) {
+ Tcl_TraceVar2(interp, Tcl_GetString(butPtr->selVarNamePtr),
+ NULL, TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS,
+ ButtonVarProc, butPtr);
+ }
+
+ TkButtonWorldChanged(butPtr);
+ if (error) {
+ Tcl_SetObjResult(interp, errorResult);
+ Tcl_DecrRefCount(errorResult);
+ return TCL_ERROR;
+ } else {
+ return TCL_OK;
+ }
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * TkButtonWorldChanged --
+ *
+ * This function is called when the world has changed in some way and the
+ * widget needs to recompute all its graphics contexts and determine its
+ * new geometry.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Button will be relayed out and redisplayed.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+void
+TkButtonWorldChanged(
+ ClientData instanceData) /* Information about widget. */
+{
+ XGCValues gcValues;
+ GC newGC;
+ unsigned long mask;
+ TkButton *butPtr = instanceData;
+
+ /*
+ * Recompute GCs.
+ */
+
+ gcValues.font = Tk_FontId(butPtr->tkfont);
+ gcValues.foreground = butPtr->normalFg->pixel;
+ gcValues.background = Tk_3DBorderColor(butPtr->normalBorder)->pixel;
+
+ /*
+ * Note: GraphicsExpose events are disabled in normalTextGC because it's
+ * used to copy stuff from an off-screen pixmap onto the screen (we know
+ * that there's no problem with obscured areas).
+ */
+
+ gcValues.graphics_exposures = False;
+ mask = GCForeground | GCBackground | GCFont | GCGraphicsExposures;
+ newGC = Tk_GetGC(butPtr->tkwin, mask, &gcValues);
+ if (butPtr->normalTextGC != None) {
+ Tk_FreeGC(butPtr->display, butPtr->normalTextGC);
+ }
+ butPtr->normalTextGC = newGC;
+
+ if (butPtr->activeFg != NULL) {
+ gcValues.foreground = butPtr->activeFg->pixel;
+ gcValues.background = Tk_3DBorderColor(butPtr->activeBorder)->pixel;
+ mask = GCForeground | GCBackground | GCFont;
+ newGC = Tk_GetGC(butPtr->tkwin, mask, &gcValues);
+ if (butPtr->activeTextGC != None) {
+ Tk_FreeGC(butPtr->display, butPtr->activeTextGC);
+ }
+ butPtr->activeTextGC = newGC;
+ }
+
+ gcValues.background = Tk_3DBorderColor(butPtr->normalBorder)->pixel;
+
+ /*
+ * Create the GC that can be used for stippling
+ */
+
+ if (butPtr->stippleGC == None) {
+ gcValues.foreground = gcValues.background;
+ mask = GCForeground;
+ if (butPtr->gray == None) {
+ butPtr->gray = Tk_GetBitmap(NULL, butPtr->tkwin, "gray50");
+ }
+ if (butPtr->gray != None) {
+ gcValues.fill_style = FillStippled;
+ gcValues.stipple = butPtr->gray;
+ mask |= GCFillStyle | GCStipple;
+ }
+ butPtr->stippleGC = Tk_GetGC(butPtr->tkwin, mask, &gcValues);
+ }
+
+ /*
+ * Allocate the disabled graphics context, for drawing text in its
+ * disabled state.
+ */
+
+ mask = GCForeground | GCBackground | GCFont;
+ if (butPtr->disabledFg != NULL) {
+ gcValues.foreground = butPtr->disabledFg->pixel;
+ } else {
+ gcValues.foreground = gcValues.background;
+ }
+ newGC = Tk_GetGC(butPtr->tkwin, mask, &gcValues);
+ if (butPtr->disabledGC != None) {
+ Tk_FreeGC(butPtr->display, butPtr->disabledGC);
+ }
+ butPtr->disabledGC = newGC;
+
+ if (butPtr->copyGC == None) {
+ butPtr->copyGC = Tk_GetGC(butPtr->tkwin, 0, &gcValues);
+ }
+
+ TkpComputeButtonGeometry(butPtr);
+
+ /*
+ * Lastly, arrange for the button to be redisplayed.
+ */
+
+ if (Tk_IsMapped(butPtr->tkwin) && !(butPtr->flags & REDRAW_PENDING)) {
+ Tcl_DoWhenIdle(TkpDisplayButton, butPtr);
+ butPtr->flags |= REDRAW_PENDING;
+ }
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * ButtonEventProc --
+ *
+ * This function is invoked by the Tk dispatcher for various events on
+ * buttons.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * When the window gets deleted, internal structures get cleaned up. When
+ * it gets exposed, it is redisplayed.
+ *
+ *--------------------------------------------------------------
+ */
+
+static void
+ButtonEventProc(
+ ClientData clientData, /* Information about window. */
+ XEvent *eventPtr) /* Information about event. */
+{
+ TkButton *butPtr = clientData;
+ if ((eventPtr->type == Expose) && (eventPtr->xexpose.count == 0)) {
+ goto redraw;
+ } else if (eventPtr->type == ConfigureNotify) {
+ /*
+ * Must redraw after size changes, since layout could have changed and
+ * borders will need to be redrawn.
+ */
+
+ goto redraw;
+ } else if (eventPtr->type == DestroyNotify) {
+ DestroyButton(butPtr);
+ } else if (eventPtr->type == FocusIn) {
+ if (eventPtr->xfocus.detail != NotifyInferior) {
+ butPtr->flags |= GOT_FOCUS;
+ if (butPtr->highlightWidth > 0) {
+ goto redraw;
+ }
+ }
+ } else if (eventPtr->type == FocusOut) {
+ if (eventPtr->xfocus.detail != NotifyInferior) {
+ butPtr->flags &= ~GOT_FOCUS;
+ if (butPtr->highlightWidth > 0) {
+ goto redraw;
+ }
+ }
+ }
+ return;
+
+ redraw:
+ if ((butPtr->tkwin != NULL) && !(butPtr->flags & REDRAW_PENDING)) {
+ Tcl_DoWhenIdle(TkpDisplayButton, butPtr);
+ butPtr->flags |= REDRAW_PENDING;
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ButtonCmdDeletedProc --
+ *
+ * This function is invoked when a widget command is deleted. If the
+ * widget isn't already in the process of being destroyed, this command
+ * destroys it.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The widget is destroyed.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+ButtonCmdDeletedProc(
+ ClientData clientData) /* Pointer to widget record for widget. */
+{
+ TkButton *butPtr = clientData;
+
+ /*
+ * This function could be invoked either because the window was destroyed
+ * and the command was then deleted or because the command was deleted,
+ * and then this function destroys the widget. The BUTTON_DELETED flag
+ * distinguishes these cases.
+ */
+
+ if (!(butPtr->flags & BUTTON_DELETED)) {
+ Tk_DestroyWindow(butPtr->tkwin);
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkInvokeButton --
+ *
+ * This function is called to carry out the actions associated with a
+ * button, such as invoking a Tcl command or setting a variable. This
+ * function is invoked, for example, when the button is invoked via the
+ * mouse.
+ *
+ * Results:
+ * A standard Tcl return value. Information is also left in the interp's
+ * result.
+ *
+ * Side effects:
+ * Depends on the button and its associated command.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TkInvokeButton(
+ TkButton *butPtr) /* Information about button. */
+{
+ Tcl_Obj *namePtr = butPtr->selVarNamePtr;
+
+ if (butPtr->type == TYPE_CHECK_BUTTON) {
+ if (butPtr->flags & SELECTED) {
+ if (Tcl_ObjSetVar2(butPtr->interp, namePtr, NULL,
+ butPtr->offValuePtr, TCL_GLOBAL_ONLY|TCL_LEAVE_ERR_MSG)
+ == NULL) {
+ return TCL_ERROR;
+ }
+ } else {
+ if (Tcl_ObjSetVar2(butPtr->interp, namePtr, NULL,
+ butPtr->onValuePtr, TCL_GLOBAL_ONLY|TCL_LEAVE_ERR_MSG)
+ == NULL) {
+ return TCL_ERROR;
+ }
+ }
+ } else if (butPtr->type == TYPE_RADIO_BUTTON) {
+ if (Tcl_ObjSetVar2(butPtr->interp, namePtr, NULL, butPtr->onValuePtr,
+ TCL_GLOBAL_ONLY|TCL_LEAVE_ERR_MSG)
+ == NULL) {
+ return TCL_ERROR;
+ }
+ }
+ if ((butPtr->type != TYPE_LABEL) && (butPtr->commandPtr != NULL)) {
+ return Tcl_EvalObjEx(butPtr->interp, butPtr->commandPtr,
+ TCL_EVAL_GLOBAL);
+ }
+ return TCL_OK;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * ButtonVarProc --
+ *
+ * This function is invoked when someone changes the state variable
+ * associated with a radio button. Depending on the new value of the
+ * button's variable, the button may be selected or deselected.
+ *
+ * Results:
+ * NULL is always returned.
+ *
+ * Side effects:
+ * The button may become selected or deselected.
+ *
+ *--------------------------------------------------------------
+ */
+
+ /* ARGSUSED */
+static char *
+ButtonVarProc(
+ ClientData clientData, /* Information about button. */
+ Tcl_Interp *interp, /* Interpreter containing variable. */
+ const char *name1, /* Name of variable. */
+ const char *name2, /* Second part of variable name. */
+ int flags) /* Information about what happened. */
+{
+ register TkButton *butPtr = clientData;
+ const char *value;
+ Tcl_Obj *valuePtr;
+
+ /*
+ * If the variable is being unset, then just re-establish the trace unless
+ * the whole interpreter is going away.
+ */
+
+ if (flags & TCL_TRACE_UNSETS) {
+ butPtr->flags &= ~(SELECTED | TRISTATED);
+ if ((flags & TCL_TRACE_DESTROYED) && !(flags & TCL_INTERP_DESTROYED)) {
+ Tcl_TraceVar2(interp, Tcl_GetString(butPtr->selVarNamePtr),
+ NULL, TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS,
+ ButtonVarProc, clientData);
+ }
+ goto redisplay;
+ }
+
+ /*
+ * Use the value of the variable to update the selected status of the
+ * button.
+ */
+
+ valuePtr = Tcl_ObjGetVar2(interp, butPtr->selVarNamePtr, NULL,
+ TCL_GLOBAL_ONLY);
+ if (valuePtr == NULL) {
+ value = Tcl_GetString(butPtr->tristateValuePtr);
+ } else {
+ value = Tcl_GetString(valuePtr);
+ }
+ if (strcmp(value, Tcl_GetString(butPtr->onValuePtr)) == 0) {
+ if (butPtr->flags & SELECTED) {
+ return NULL;
+ }
+ butPtr->flags |= SELECTED;
+ butPtr->flags &= ~TRISTATED;
+ } else if (butPtr->offValuePtr
+ && strcmp(value, Tcl_GetString(butPtr->offValuePtr)) == 0) {
+ if (!(butPtr->flags & (SELECTED | TRISTATED))) {
+ return NULL;
+ }
+ butPtr->flags &= ~(SELECTED | TRISTATED);
+ } else if (strcmp(value, Tcl_GetString(butPtr->tristateValuePtr)) == 0) {
+ if (butPtr->flags & TRISTATED) {
+ return NULL;
+ }
+ butPtr->flags |= TRISTATED;
+ butPtr->flags &= ~SELECTED;
+ } else if (butPtr->flags & (SELECTED | TRISTATED)) {
+ butPtr->flags &= ~(SELECTED | TRISTATED);
+ } else {
+ return NULL;
+ }
+
+ redisplay:
+ if ((butPtr->tkwin != NULL) && Tk_IsMapped(butPtr->tkwin)
+ && !(butPtr->flags & REDRAW_PENDING)) {
+ Tcl_DoWhenIdle(TkpDisplayButton, butPtr);
+ butPtr->flags |= REDRAW_PENDING;
+ }
+ return NULL;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * ButtonTextVarProc --
+ *
+ * This function is invoked when someone changes the variable whose
+ * contents are to be displayed in a button.
+ *
+ * Results:
+ * NULL is always returned.
+ *
+ * Side effects:
+ * The text displayed in the button will change to match the variable.
+ *
+ *--------------------------------------------------------------
+ */
+
+ /* ARGSUSED */
+static char *
+ButtonTextVarProc(
+ ClientData clientData, /* Information about button. */
+ Tcl_Interp *interp, /* Interpreter containing variable. */
+ const char *name1, /* Not used. */
+ const char *name2, /* Not used. */
+ int flags) /* Information about what happened. */
+{
+ TkButton *butPtr = clientData;
+ Tcl_Obj *valuePtr;
+
+ if (butPtr->flags & BUTTON_DELETED) {
+ return NULL;
+ }
+
+ /*
+ * If the variable is unset, then immediately recreate it unless the whole
+ * interpreter is going away.
+ */
+
+ if (flags & TCL_TRACE_UNSETS) {
+ if ((flags & TCL_TRACE_DESTROYED) && !(flags & TCL_INTERP_DESTROYED)) {
+ Tcl_ObjSetVar2(interp, butPtr->textVarNamePtr, NULL,
+ butPtr->textPtr, TCL_GLOBAL_ONLY);
+ Tcl_TraceVar2(interp, Tcl_GetString(butPtr->textVarNamePtr),
+ NULL, TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS,
+ ButtonTextVarProc, clientData);
+ }
+ return NULL;
+ }
+
+ valuePtr = Tcl_ObjGetVar2(interp, butPtr->textVarNamePtr, NULL,
+ TCL_GLOBAL_ONLY);
+ if (valuePtr == NULL) {
+ valuePtr = Tcl_NewObj();
+ }
+ Tcl_DecrRefCount(butPtr->textPtr);
+ butPtr->textPtr = valuePtr;
+ Tcl_IncrRefCount(butPtr->textPtr);
+ TkpComputeButtonGeometry(butPtr);
+
+ if ((butPtr->tkwin != NULL) && Tk_IsMapped(butPtr->tkwin)
+ && !(butPtr->flags & REDRAW_PENDING)) {
+ Tcl_DoWhenIdle(TkpDisplayButton, butPtr);
+ butPtr->flags |= REDRAW_PENDING;
+ }
+ return NULL;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ButtonImageProc --
+ *
+ * This function is invoked by the image code whenever the manager for an
+ * image does something that affects the size or contents of an image
+ * displayed in a button.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Arranges for the button to get redisplayed.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+ButtonImageProc(
+ ClientData clientData, /* Pointer to widget record. */
+ int x, int y, /* Upper left pixel (within image) that must
+ * be redisplayed. */
+ int width, int height, /* Dimensions of area to redisplay (might be
+ * <= 0). */
+ int imgWidth, int imgHeight)/* New dimensions of image. */
+{
+ register TkButton *butPtr = clientData;
+
+ if (butPtr->tkwin != NULL) {
+ TkpComputeButtonGeometry(butPtr);
+ if (Tk_IsMapped(butPtr->tkwin) && !(butPtr->flags & REDRAW_PENDING)) {
+ Tcl_DoWhenIdle(TkpDisplayButton, butPtr);
+ butPtr->flags |= REDRAW_PENDING;
+ }
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ButtonSelectImageProc --
+ *
+ * This function is invoked by the image code whenever the manager for an
+ * image does something that affects the size or contents of the image
+ * displayed in a button when it is selected.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * May arrange for the button to get redisplayed.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+ButtonSelectImageProc(
+ ClientData clientData, /* Pointer to widget record. */
+ int x, int y, /* Upper left pixel (within image) that must
+ * be redisplayed. */
+ int width, int height, /* Dimensions of area to redisplay (might be
+ * <= 0). */
+ int imgWidth, int imgHeight)/* New dimensions of image. */
+{
+ register TkButton *butPtr = clientData;
+
+#ifdef MAC_OSX_TK
+ if (butPtr->tkwin != NULL) {
+ TkpComputeButtonGeometry(butPtr);
+ }
+#else
+ /*
+ * Don't recompute geometry: it's controlled by the primary image.
+ */
+#endif
+
+ if ((butPtr->flags & SELECTED) && (butPtr->tkwin != NULL)
+ && Tk_IsMapped(butPtr->tkwin)
+ && !(butPtr->flags & REDRAW_PENDING)) {
+ Tcl_DoWhenIdle(TkpDisplayButton, butPtr);
+ butPtr->flags |= REDRAW_PENDING;
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ButtonTristateImageProc --
+ *
+ * This function is invoked by the image code whenever the manager for an
+ * image does something that affects the size or contents of the image
+ * displayed in a button when it is selected.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * May arrange for the button to get redisplayed.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+ButtonTristateImageProc(
+ ClientData clientData, /* Pointer to widget record. */
+ int x, int y, /* Upper left pixel (within image) that must
+ * be redisplayed. */
+ int width, int height, /* Dimensions of area to redisplay (might be
+ * <= 0). */
+ int imgWidth, int imgHeight)/* New dimensions of image. */
+{
+ register TkButton *butPtr = clientData;
+
+#ifdef MAC_OSX_TK
+ if (butPtr->tkwin != NULL) {
+ TkpComputeButtonGeometry(butPtr);
+ }
+#else
+ /*
+ * Don't recompute geometry: it's controlled by the primary image.
+ */
+#endif
+
+ if ((butPtr->flags & TRISTATED) && (butPtr->tkwin != NULL)
+ && Tk_IsMapped(butPtr->tkwin)
+ && !(butPtr->flags & REDRAW_PENDING)) {
+ Tcl_DoWhenIdle(TkpDisplayButton, butPtr);
+ butPtr->flags |= REDRAW_PENDING;
+ }
+}
+
+/*
+ * Local Variables:
+ * mode: c
+ * c-basic-offset: 4
+ * fill-column: 78
+ * End:
+ */
diff --git a/tk8.6/generic/tkButton.h b/tk8.6/generic/tkButton.h
new file mode 100644
index 0000000..7ed464f
--- /dev/null
+++ b/tk8.6/generic/tkButton.h
@@ -0,0 +1,322 @@
+/*
+ * tkButton.h --
+ *
+ * Declarations of types and functions used to implement button-like
+ * widgets.
+ *
+ * Copyright (c) 1996-1998 by Sun Microsystems, Inc.
+ *
+ * See the file "license.terms" for information on usage and redistribution of
+ * this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ */
+
+#ifndef _TKBUTTON
+#define _TKBUTTON
+
+#ifndef _TKINT
+#include "tkInt.h"
+#endif
+
+/*
+ * Legal values for the "compound" field of TkButton records.
+ */
+
+enum compound {
+ COMPOUND_BOTTOM, COMPOUND_CENTER, COMPOUND_LEFT, COMPOUND_NONE,
+ COMPOUND_RIGHT, COMPOUND_TOP
+};
+
+/*
+ * Legal values for the "state" field of TkButton records.
+ */
+
+enum state {
+ STATE_ACTIVE, STATE_DISABLED, STATE_NORMAL
+};
+
+/*
+ * Legal values for the "defaultState" field of TkButton records.
+ */
+
+enum defaultState {
+ DEFAULT_ACTIVE, DEFAULT_DISABLED, DEFAULT_NORMAL
+};
+
+/*
+ * A data structure of the following type is kept for each widget managed by
+ * this file:
+ */
+
+typedef struct {
+ Tk_Window tkwin; /* Window that embodies the button. NULL means
+ * that the window has been destroyed. */
+ Display *display; /* Display containing widget. Needed to free
+ * up resources after tkwin is gone. */
+ Tcl_Interp *interp; /* Interpreter associated with button. */
+ Tcl_Command widgetCmd; /* Token for button's widget command. */
+ int type; /* Type of widget, such as TYPE_LABEL:
+ * restricts operations that may be performed
+ * on widget. See below for legal values. */
+ Tk_OptionTable optionTable; /* Table that defines configuration options
+ * available for this widget. */
+
+ /*
+ * Information about what's in the button.
+ */
+
+ Tcl_Obj *textPtr; /* Value of -text option: specifies text to
+ * display in button. */
+ int underline; /* Value of -underline option: specifies index
+ * of character to underline. < 0 means don't
+ * underline anything. */
+ Tcl_Obj *textVarNamePtr; /* Value of -textvariable option: specifies
+ * name of variable or NULL. If non-NULL,
+ * button displays the contents of this
+ * variable. */
+ Pixmap bitmap; /* Value of -bitmap option. If not None,
+ * specifies bitmap to display and text and
+ * textVar are ignored. */
+ Tcl_Obj *imagePtr; /* Value of -image option: specifies image to
+ * display in window, or NULL if none. If
+ * non-NULL, bitmap, text, and textVarName are
+ * ignored.*/
+ Tk_Image image; /* Derived from imagePtr by calling
+ * Tk_GetImage, or NULL if imagePtr is
+ * NULL. */
+ Tcl_Obj *selectImagePtr; /* Value of -selectimage option: specifies
+ * image to display in window when selected,
+ * or NULL if none. Ignored if imagePtr is
+ * NULL. */
+ Tk_Image selectImage; /* Derived from selectImagePtr by calling
+ * Tk_GetImage, or NULL if selectImagePtr is
+ * NULL. */
+ Tcl_Obj *tristateImagePtr; /* Value of -tristateimage option: specifies
+ * image to display in window when selected,
+ * or NULL if none. Ignored if imagePtr is
+ * NULL. */
+ Tk_Image tristateImage; /* Derived from tristateImagePtr by calling
+ * Tk_GetImage, or NULL if tristateImagePtr is
+ * NULL. */
+
+ /*
+ * Information used when displaying widget:
+ */
+
+ enum state state; /* Value of -state option: specifies state of
+ * button for display purposes.*/
+ Tk_3DBorder normalBorder; /* Value of -background option: specifies
+ * color for background (and border) when
+ * window isn't active. */
+ Tk_3DBorder activeBorder; /* Value of -activebackground option: this is
+ * the color used to draw 3-D border and
+ * background when widget is active. */
+ Tcl_Obj *borderWidthPtr; /* Value of -borderWidth option: specifies
+ * width of border in pixels. */
+ int borderWidth; /* Integer value corresponding to
+ * borderWidthPtr. Always >= 0. */
+ int relief; /* Value of -relief option: specifies 3-d
+ * effect for border, such as
+ * TK_RELIEF_RAISED. */
+ int overRelief; /* Value of -overrelief option: specifies a
+ * 3-d effect for the border, such as
+ * TK_RELIEF_RAISED, to be used when the mouse
+ * is over the button. */
+ int offRelief; /* Value of -offrelief option: specifies a 3-d
+ * effect for the border, such as
+ * TK_RELIEF_RAISED, to be used when a
+ * checkbutton or radiobutton without
+ * indicator is off. */
+ Tcl_Obj *highlightWidthPtr; /* Value of -highlightthickness option:
+ * specifies width in pixels of highlight to
+ * draw around widget when it has the focus.
+ * <= 0 means don't draw a highlight. */
+ int highlightWidth; /* Integer value corresponding to
+ * highlightWidthPtr. Always >= 0. */
+ Tk_3DBorder highlightBorder;/* Value of -highlightbackground option:
+ * specifies background with which to draw 3-D
+ * default ring and focus highlight area when
+ * highlight is off. */
+ XColor *highlightColorPtr; /* Value of -highlightcolor option: specifies
+ * color for drawing traversal highlight. */
+ int inset; /* Total width of all borders, including
+ * traversal highlight and 3-D border.
+ * Indicates how much interior stuff must be
+ * offset from outside edges to leave room for
+ * borders. */
+ Tk_Font tkfont; /* Value of -font option: specifies font to
+ * use for display text. */
+ XColor *normalFg; /* Value of -font option: specifies foreground
+ * color in normal mode. */
+ XColor *activeFg; /* Value of -activeforeground option:
+ * foreground color in active mode. NULL means
+ * use -foreground instead. */
+ XColor *disabledFg; /* Value of -disabledforeground option:
+ * foreground color when disabled. NULL means
+ * use normalFg with a 50% stipple instead. */
+ GC normalTextGC; /* GC for drawing text in normal mode. Also
+ * used to copy from off-screen pixmap onto
+ * screen. */
+ GC activeTextGC; /* GC for drawing text in active mode (NULL
+ * means use normalTextGC). */
+ GC disabledGC; /* Used to produce disabled effect for text
+ * and check/radio marks. */
+ GC stippleGC; /* Used to produce disabled stipple effect for
+ * images when disabled. */
+ Pixmap gray; /* Pixmap for displaying disabled text if
+ * disabledFg is NULL. */
+ GC copyGC; /* Used for copying information from an
+ * off-screen pixmap to the screen. */
+ Tcl_Obj *widthPtr; /* Value of -width option. */
+ int width; /* Integer value corresponding to widthPtr. */
+ Tcl_Obj *heightPtr; /* Value of -height option. */
+ int height; /* Integer value corresponding to heightPtr. */
+ Tcl_Obj *wrapLengthPtr; /* Value of -wraplength option: specifies line
+ * length (in pixels) at which to wrap onto
+ * next line. <= 0 means don't wrap except at
+ * newlines. */
+ int wrapLength; /* Integer value corresponding to
+ * wrapLengthPtr. */
+ Tcl_Obj *padXPtr; /* Value of -padx option: specifies how many
+ * pixels of extra space to leave on left and
+ * right of text. Ignored for bitmaps and
+ * images. */
+ int padX; /* Integer value corresponding to padXPtr. */
+ Tcl_Obj *padYPtr; /* Value of -padx option: specifies how many
+ * pixels of extra space to leave above and
+ * below text. Ignored for bitmaps and
+ * images. */
+ int padY; /* Integer value corresponding to padYPtr. */
+ Tk_Anchor anchor; /* Value of -anchor option: specifies where
+ * text/bitmap should be displayed inside
+ * button region. */
+ Tk_Justify justify; /* Value of -justify option: specifies how to
+ * align lines of multi-line text. */
+ int indicatorOn; /* Value of -indicatoron option: 1 means draw
+ * indicator in checkbuttons and radiobuttons,
+ * 0 means don't draw it. */
+ Tk_3DBorder selectBorder; /* Value of -selectcolor option: specifies
+ * color for drawing indicator background, or
+ * perhaps widget background, when
+ * selected. */
+ int textWidth; /* Width needed to display text as requested,
+ * in pixels. */
+ int textHeight; /* Height needed to display text as requested,
+ * in pixels. */
+ Tk_TextLayout textLayout; /* Saved text layout information. */
+ int indicatorSpace; /* Horizontal space (in pixels) allocated for
+ * display of indicator. */
+ int indicatorDiameter; /* Diameter of indicator, in pixels. */
+ enum defaultState defaultState;
+ /* Value of -default option, such as
+ * DEFAULT_NORMAL: specifies state of default
+ * ring for buttons (normal, active, or
+ * disabled). NULL for other classes. */
+
+ /*
+ * For check and radio buttons, the fields below are used to manage the
+ * variable indicating the button's state.
+ */
+
+ Tcl_Obj *selVarNamePtr; /* Value of -variable option: specifies name
+ * of variable used to control selected state
+ * of button. */
+ Tcl_Obj *onValuePtr; /* Value of -offvalue option: specifies value
+ * to store in variable when this button is
+ * selected. */
+ Tcl_Obj *offValuePtr; /* Value of -offvalue option: specifies value
+ * to store in variable when this button isn't
+ * selected. Used only by checkbuttons. */
+ Tcl_Obj *tristateValuePtr; /* Value of -tristatevalue option: specifies
+ * value to display Tristate or Multivalue
+ * mode when variable matches this value.
+ * Used by check- buttons. */
+
+ /*
+ * Miscellaneous information:
+ */
+
+ Tk_Cursor cursor; /* Value of -cursor option: if not None,
+ * specifies current cursor for window. */
+ Tcl_Obj *takeFocusPtr; /* Value of -takefocus option; not used in the
+ * C code, but used by keyboard traversal
+ * scripts. */
+ Tcl_Obj *commandPtr; /* Value of -command option: specifies script
+ * to execute when button is invoked. If
+ * widget is label or has no command, this is
+ * NULL. */
+ int compound; /* Value of -compound option; specifies
+ * whether the button should show both an
+ * image and text, and, if so, how. */
+ int repeatDelay; /* Value of -repeatdelay option; specifies the
+ * number of ms after which the button will
+ * start to auto-repeat its command. */
+ int repeatInterval; /* Value of -repeatinterval option; specifies
+ * the number of ms between auto-repeat
+ * invocataions of the button command. */
+ int flags; /* Various flags; see below for
+ * definitions. */
+} TkButton;
+
+/*
+ * Possible "type" values for buttons. These are the kinds of widgets
+ * supported by this file. The ordering of the type numbers is significant:
+ * greater means more features and is used in the code.
+ */
+
+#define TYPE_LABEL 0
+#define TYPE_BUTTON 1
+#define TYPE_CHECK_BUTTON 2
+#define TYPE_RADIO_BUTTON 3
+
+/*
+ * Flag bits for buttons:
+ *
+ * REDRAW_PENDING: Non-zero means a DoWhenIdle handler has
+ * already been queued to redraw this window.
+ * SELECTED: Non-zero means this button is selected, so
+ * special highlight should be drawn.
+ * GOT_FOCUS: Non-zero means this button currently has the
+ * input focus.
+ * BUTTON_DELETED: Non-zero needs that this button has been
+ * deleted, or is in the process of being deleted
+ */
+
+#define REDRAW_PENDING (1 << 0)
+#define SELECTED (1 << 1)
+#define GOT_FOCUS (1 << 2)
+#define BUTTON_DELETED (1 << 3)
+#define TRISTATED (1 << 4)
+
+/*
+ * Declaration of button class functions structure
+ * and button/label defaults, for use in optionSpecs.
+ */
+
+MODULE_SCOPE const Tk_ClassProcs tkpButtonProcs;
+MODULE_SCOPE char tkDefButtonHighlightWidth[TCL_INTEGER_SPACE];
+MODULE_SCOPE char tkDefButtonPadx[TCL_INTEGER_SPACE];
+MODULE_SCOPE char tkDefButtonPady[TCL_INTEGER_SPACE];
+MODULE_SCOPE char tkDefButtonBorderWidth[TCL_INTEGER_SPACE];
+MODULE_SCOPE char tkDefLabelHighlightWidth[TCL_INTEGER_SPACE];
+MODULE_SCOPE char tkDefLabelPadx[TCL_INTEGER_SPACE];
+MODULE_SCOPE char tkDefLabelPady[TCL_INTEGER_SPACE];
+
+/*
+ * Declaration of functions used in the implementation of the button widget.
+ */
+
+#ifndef TkpButtonSetDefaults
+MODULE_SCOPE void TkpButtonSetDefaults();
+#endif
+MODULE_SCOPE void TkButtonWorldChanged(ClientData instanceData);
+MODULE_SCOPE void TkpComputeButtonGeometry(TkButton *butPtr);
+MODULE_SCOPE TkButton *TkpCreateButton(Tk_Window tkwin);
+#ifndef TkpDestroyButton
+MODULE_SCOPE void TkpDestroyButton(TkButton *butPtr);
+#endif
+#ifndef TkpDisplayButton
+MODULE_SCOPE void TkpDisplayButton(ClientData clientData);
+#endif
+MODULE_SCOPE int TkInvokeButton(TkButton *butPtr);
+
+#endif /* _TKBUTTON */
diff --git a/tk8.6/generic/tkCanvArc.c b/tk8.6/generic/tkCanvArc.c
new file mode 100644
index 0000000..4e4c582
--- /dev/null
+++ b/tk8.6/generic/tkCanvArc.c
@@ -0,0 +1,2119 @@
+/*
+ * tkCanvArc.c --
+ *
+ * This file implements arc items for canvas widgets.
+ *
+ * Copyright (c) 1992-1994 The Regents of the University of California.
+ * Copyright (c) 1994-1997 Sun Microsystems, Inc.
+ *
+ * See the file "license.terms" for information on usage and redistribution of
+ * this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ */
+
+#include "tkInt.h"
+#include "tkCanvas.h"
+
+/*
+ * The structure below defines the record for each arc item.
+ */
+
+typedef enum {
+ PIESLICE_STYLE, CHORD_STYLE, ARC_STYLE
+} Style;
+
+typedef struct ArcItem {
+ Tk_Item header; /* Generic stuff that's the same for all
+ * types. MUST BE FIRST IN STRUCTURE. */
+ Tk_Outline outline; /* Outline structure */
+ double bbox[4]; /* Coordinates (x1, y1, x2, y2) of bounding
+ * box for oval of which arc is a piece. */
+ double start; /* Angle at which arc begins, in degrees
+ * between 0 and 360. */
+ double extent; /* Extent of arc (angular distance from start
+ * to end of arc) in degrees between -360 and
+ * 360. */
+ double *outlinePtr; /* Points to (x,y) coordinates for points that
+ * define one or two closed polygons
+ * representing the portion of the outline
+ * that isn't part of the arc (the V-shape for
+ * a pie slice or a line-like segment for a
+ * chord). Malloc'ed. */
+ int numOutlinePoints; /* Number of points at outlinePtr. Zero means
+ * no space allocated. */
+ Tk_TSOffset tsoffset;
+ XColor *fillColor; /* Color for filling arc (used for drawing
+ * outline too when style is "arc"). NULL
+ * means don't fill arc. */
+ XColor *activeFillColor; /* Color for filling arc (used for drawing
+ * outline too when style is "arc" and state
+ * is "active"). NULL means use fillColor. */
+ XColor *disabledFillColor; /* Color for filling arc (used for drawing
+ * outline too when style is "arc" and state
+ * is "disabled". NULL means use fillColor */
+ Pixmap fillStipple; /* Stipple bitmap for filling item. */
+ Pixmap activeFillStipple; /* Stipple bitmap for filling item if state is
+ * active. */
+ Pixmap disabledFillStipple; /* Stipple bitmap for filling item if state is
+ * disabled. */
+ Style style; /* How to draw arc: arc, chord, or
+ * pieslice. */
+ GC fillGC; /* Graphics context for filling item. */
+ double center1[2]; /* Coordinates of center of arc outline at
+ * start (see ComputeArcOutline). */
+ double center2[2]; /* Coordinates of center of arc outline at
+ * start+extent (see ComputeArcOutline). */
+} ArcItem;
+
+/*
+ * The definitions below define the sizes of the polygons used to display
+ * outline information for various styles of arcs:
+ */
+
+#define CHORD_OUTLINE_PTS 7
+#define PIE_OUTLINE1_PTS 6
+#define PIE_OUTLINE2_PTS 7
+
+/*
+ * Information used for parsing configuration specs:
+ */
+
+static int StyleParseProc(ClientData clientData, Tcl_Interp *interp,
+ Tk_Window tkwin, const char *value,
+ char *widgRec, int offset);
+static const char * StylePrintProc(ClientData clientData, Tk_Window tkwin,
+ char *widgRec, int offset, Tcl_FreeProc **freeProcPtr);
+
+static const Tk_CustomOption stateOption = {
+ TkStateParseProc, TkStatePrintProc, INT2PTR(2)
+};
+static const Tk_CustomOption styleOption = {
+ StyleParseProc, StylePrintProc, NULL
+};
+static const Tk_CustomOption tagsOption = {
+ Tk_CanvasTagsParseProc, Tk_CanvasTagsPrintProc, NULL
+};
+static const Tk_CustomOption dashOption = {
+ TkCanvasDashParseProc, TkCanvasDashPrintProc, NULL
+};
+static const Tk_CustomOption offsetOption = {
+ TkOffsetParseProc, TkOffsetPrintProc, INT2PTR(TK_OFFSET_RELATIVE)
+};
+static const Tk_CustomOption pixelOption = {
+ TkPixelParseProc, TkPixelPrintProc, NULL
+};
+
+static const Tk_ConfigSpec configSpecs[] = {
+ {TK_CONFIG_CUSTOM, "-activedash", NULL, NULL,
+ NULL, Tk_Offset(ArcItem, outline.activeDash),
+ TK_CONFIG_NULL_OK, &dashOption},
+ {TK_CONFIG_COLOR, "-activefill", NULL, NULL,
+ NULL, Tk_Offset(ArcItem, activeFillColor), TK_CONFIG_NULL_OK, NULL},
+ {TK_CONFIG_COLOR, "-activeoutline", NULL, NULL,
+ NULL, Tk_Offset(ArcItem, outline.activeColor), TK_CONFIG_NULL_OK, NULL},
+ {TK_CONFIG_BITMAP, "-activeoutlinestipple", NULL, NULL,
+ NULL, Tk_Offset(ArcItem, outline.activeStipple), TK_CONFIG_NULL_OK, NULL},
+ {TK_CONFIG_BITMAP, "-activestipple", NULL, NULL,
+ NULL, Tk_Offset(ArcItem, activeFillStipple), TK_CONFIG_NULL_OK, NULL},
+ {TK_CONFIG_CUSTOM, "-activewidth", NULL, NULL,
+ "0.0", Tk_Offset(ArcItem, outline.activeWidth),
+ TK_CONFIG_DONT_SET_DEFAULT, &pixelOption},
+ {TK_CONFIG_CUSTOM, "-dash", NULL, NULL,
+ NULL, Tk_Offset(ArcItem, outline.dash),
+ TK_CONFIG_NULL_OK, &dashOption},
+ {TK_CONFIG_PIXELS, "-dashoffset", NULL, NULL,
+ "0", Tk_Offset(ArcItem, outline.offset), TK_CONFIG_DONT_SET_DEFAULT, NULL},
+ {TK_CONFIG_CUSTOM, "-disableddash", NULL, NULL,
+ NULL, Tk_Offset(ArcItem, outline.disabledDash),
+ TK_CONFIG_NULL_OK, &dashOption},
+ {TK_CONFIG_COLOR, "-disabledfill", NULL, NULL,
+ NULL, Tk_Offset(ArcItem, disabledFillColor), TK_CONFIG_NULL_OK, NULL},
+ {TK_CONFIG_COLOR, "-disabledoutline", NULL, NULL,
+ NULL, Tk_Offset(ArcItem, outline.disabledColor), TK_CONFIG_NULL_OK, NULL},
+ {TK_CONFIG_BITMAP, "-disabledoutlinestipple", NULL, NULL,
+ NULL, Tk_Offset(ArcItem, outline.disabledStipple), TK_CONFIG_NULL_OK, NULL},
+ {TK_CONFIG_BITMAP, "-disabledstipple", NULL, NULL,
+ NULL, Tk_Offset(ArcItem, disabledFillStipple), TK_CONFIG_NULL_OK, NULL},
+ {TK_CONFIG_CUSTOM, "-disabledwidth", NULL, NULL,
+ "0.0", Tk_Offset(ArcItem, outline.disabledWidth),
+ TK_CONFIG_DONT_SET_DEFAULT, &pixelOption},
+ {TK_CONFIG_DOUBLE, "-extent", NULL, NULL,
+ "90", Tk_Offset(ArcItem, extent), TK_CONFIG_DONT_SET_DEFAULT, NULL},
+ {TK_CONFIG_COLOR, "-fill", NULL, NULL,
+ NULL, Tk_Offset(ArcItem, fillColor), TK_CONFIG_NULL_OK, NULL},
+ {TK_CONFIG_CUSTOM, "-offset", NULL, NULL,
+ "0,0", Tk_Offset(ArcItem, tsoffset),
+ TK_CONFIG_DONT_SET_DEFAULT, &offsetOption},
+ {TK_CONFIG_COLOR, "-outline", NULL, NULL,
+ "black", Tk_Offset(ArcItem, outline.color), TK_CONFIG_NULL_OK, NULL},
+ {TK_CONFIG_CUSTOM, "-outlineoffset", NULL, NULL,
+ "0,0", Tk_Offset(ArcItem, outline.tsoffset),
+ TK_CONFIG_DONT_SET_DEFAULT, &offsetOption},
+ {TK_CONFIG_BITMAP, "-outlinestipple", NULL, NULL,
+ NULL, Tk_Offset(ArcItem, outline.stipple), TK_CONFIG_NULL_OK, NULL},
+ {TK_CONFIG_DOUBLE, "-start", NULL, NULL,
+ "0", Tk_Offset(ArcItem, start), TK_CONFIG_DONT_SET_DEFAULT, NULL},
+ {TK_CONFIG_CUSTOM, "-state", NULL, NULL,
+ NULL, Tk_Offset(Tk_Item, state), TK_CONFIG_NULL_OK, &stateOption},
+ {TK_CONFIG_BITMAP, "-stipple", NULL, NULL,
+ NULL, Tk_Offset(ArcItem, fillStipple), TK_CONFIG_NULL_OK, NULL},
+ {TK_CONFIG_CUSTOM, "-style", NULL, NULL,
+ NULL, Tk_Offset(ArcItem, style), TK_CONFIG_DONT_SET_DEFAULT,
+ &styleOption},
+ {TK_CONFIG_CUSTOM, "-tags", NULL, NULL,
+ NULL, 0, TK_CONFIG_NULL_OK, &tagsOption},
+ {TK_CONFIG_CUSTOM, "-width", NULL, NULL,
+ "1.0", Tk_Offset(ArcItem, outline.width), TK_CONFIG_DONT_SET_DEFAULT,
+ &pixelOption},
+ {TK_CONFIG_END, NULL, NULL, NULL, NULL, 0, 0, NULL}
+};
+
+/*
+ * Prototypes for functions defined in this file:
+ */
+
+static void ComputeArcBbox(Tk_Canvas canvas, ArcItem *arcPtr);
+static int ConfigureArc(Tcl_Interp *interp,
+ Tk_Canvas canvas, Tk_Item *itemPtr, int objc,
+ Tcl_Obj *const objv[], int flags);
+static int CreateArc(Tcl_Interp *interp,
+ Tk_Canvas canvas, struct Tk_Item *itemPtr,
+ int objc, Tcl_Obj *const objv[]);
+static void DeleteArc(Tk_Canvas canvas,
+ Tk_Item *itemPtr, Display *display);
+static void DisplayArc(Tk_Canvas canvas,
+ Tk_Item *itemPtr, Display *display, Drawable dst,
+ int x, int y, int width, int height);
+static int ArcCoords(Tcl_Interp *interp, Tk_Canvas canvas,
+ Tk_Item *itemPtr, int objc, Tcl_Obj *const objv[]);
+static int ArcToArea(Tk_Canvas canvas,
+ Tk_Item *itemPtr, double *rectPtr);
+static double ArcToPoint(Tk_Canvas canvas,
+ Tk_Item *itemPtr, double *coordPtr);
+static int ArcToPostscript(Tcl_Interp *interp,
+ Tk_Canvas canvas, Tk_Item *itemPtr, int prepass);
+static void ScaleArc(Tk_Canvas canvas,
+ Tk_Item *itemPtr, double originX, double originY,
+ double scaleX, double scaleY);
+static void TranslateArc(Tk_Canvas canvas,
+ Tk_Item *itemPtr, double deltaX, double deltaY);
+static int AngleInRange(double x, double y,
+ double start, double extent);
+static void ComputeArcOutline(Tk_Canvas canvas, ArcItem *arcPtr);
+static int HorizLineToArc(double x1, double x2,
+ double y, double rx, double ry,
+ double start, double extent);
+static int VertLineToArc(double x, double y1,
+ double y2, double rx, double ry,
+ double start, double extent);
+
+/*
+ * The structures below defines the arc item types by means of functions that
+ * can be invoked by generic item code.
+ */
+
+Tk_ItemType tkArcType = {
+ "arc", /* name */
+ sizeof(ArcItem), /* itemSize */
+ CreateArc, /* createProc */
+ configSpecs, /* configSpecs */
+ ConfigureArc, /* configureProc */
+ ArcCoords, /* coordProc */
+ DeleteArc, /* deleteProc */
+ DisplayArc, /* displayProc */
+ TK_CONFIG_OBJS, /* flags */
+ ArcToPoint, /* pointProc */
+ ArcToArea, /* areaProc */
+ ArcToPostscript, /* postscriptProc */
+ ScaleArc, /* scaleProc */
+ TranslateArc, /* translateProc */
+ NULL, /* indexProc */
+ NULL, /* icursorProc */
+ NULL, /* selectionProc */
+ NULL, /* insertProc */
+ NULL, /* dTextProc */
+ NULL, /* nextPtr */
+ NULL, 0, NULL, NULL
+};
+
+/*
+ *--------------------------------------------------------------
+ *
+ * CreateArc --
+ *
+ * This function is invoked to create a new arc item in a canvas.
+ *
+ * Results:
+ * A standard Tcl return value. If an error occurred in creating the
+ * item, then an error message is left in the interp's result; in this
+ * case itemPtr is left uninitialized, so it can be safely freed by the
+ * caller.
+ *
+ * Side effects:
+ * A new arc item is created.
+ *
+ *--------------------------------------------------------------
+ */
+
+static int
+CreateArc(
+ Tcl_Interp *interp, /* Interpreter for error reporting. */
+ Tk_Canvas canvas, /* Canvas to hold new item. */
+ Tk_Item *itemPtr, /* Record to hold new item; header has been
+ * initialized by caller. */
+ int objc, /* Number of arguments in objv. */
+ Tcl_Obj *const objv[]) /* Arguments describing arc. */
+{
+ ArcItem *arcPtr = (ArcItem *) itemPtr;
+ int i;
+
+ if (objc == 0) {
+ Tcl_Panic("canvas did not pass any coords");
+ }
+
+ /*
+ * Carry out initialization that is needed in order to clean up after
+ * errors during the the remainder of this function.
+ */
+
+ Tk_CreateOutline(&(arcPtr->outline));
+ arcPtr->start = 0;
+ arcPtr->extent = 90;
+ arcPtr->outlinePtr = NULL;
+ arcPtr->numOutlinePoints = 0;
+ arcPtr->tsoffset.flags = 0;
+ arcPtr->tsoffset.xoffset = 0;
+ arcPtr->tsoffset.yoffset = 0;
+ arcPtr->fillColor = NULL;
+ arcPtr->activeFillColor = NULL;
+ arcPtr->disabledFillColor = NULL;
+ arcPtr->fillStipple = None;
+ arcPtr->activeFillStipple = None;
+ arcPtr->disabledFillStipple = None;
+ arcPtr->style = PIESLICE_STYLE;
+ arcPtr->fillGC = None;
+
+ /*
+ * Process the arguments to fill in the item record.
+ */
+
+ for (i = 1; i < objc; i++) {
+ const char *arg = Tcl_GetString(objv[i]);
+
+ if ((arg[0] == '-') && (arg[1] >= 'a') && (arg[1] <= 'z')) {
+ break;
+ }
+ }
+ if (ArcCoords(interp, canvas, itemPtr, i, objv) != TCL_OK) {
+ goto error;
+ }
+ if (ConfigureArc(interp, canvas, itemPtr, objc-i, objv+i, 0) == TCL_OK) {
+ return TCL_OK;
+ }
+
+ error:
+ DeleteArc(canvas, itemPtr, Tk_Display(Tk_CanvasTkwin(canvas)));
+ return TCL_ERROR;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * ArcCoords --
+ *
+ * This function is invoked to process the "coords" widget command on
+ * arcs. See the user documentation for details on what it does.
+ *
+ * Results:
+ * Returns TCL_OK or TCL_ERROR, and sets the interp's result.
+ *
+ * Side effects:
+ * The coordinates for the given item may be changed.
+ *
+ *--------------------------------------------------------------
+ */
+
+static int
+ArcCoords(
+ Tcl_Interp *interp, /* Used for error reporting. */
+ Tk_Canvas canvas, /* Canvas containing item. */
+ Tk_Item *itemPtr, /* Item whose coordinates are to be read or
+ * modified. */
+ int objc, /* Number of coordinates supplied in objv. */
+ Tcl_Obj *const objv[]) /* Array of coordinates: x1, y1, x2, y2, ... */
+{
+ ArcItem *arcPtr = (ArcItem *) itemPtr;
+
+ if (objc == 0) {
+ Tcl_Obj *objs[4];
+
+ objs[0] = Tcl_NewDoubleObj(arcPtr->bbox[0]);
+ objs[1] = Tcl_NewDoubleObj(arcPtr->bbox[1]);
+ objs[2] = Tcl_NewDoubleObj(arcPtr->bbox[2]);
+ objs[3] = Tcl_NewDoubleObj(arcPtr->bbox[3]);
+ Tcl_SetObjResult(interp, Tcl_NewListObj(4, objs));
+ } else if ((objc == 1)||(objc == 4)) {
+ if (objc==1) {
+ if (Tcl_ListObjGetElements(interp, objv[0], &objc,
+ (Tcl_Obj ***) &objv) != TCL_OK) {
+ return TCL_ERROR;
+ } else if (objc != 4) {
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "wrong # coordinates: expected 4, got %d", objc));
+ Tcl_SetErrorCode(interp, "TK", "CANVAS", "COORDS", "ARC",
+ NULL);
+ return TCL_ERROR;
+ }
+ }
+ if ((Tk_CanvasGetCoordFromObj(interp, canvas, objv[0],
+ &arcPtr->bbox[0]) != TCL_OK)
+ || (Tk_CanvasGetCoordFromObj(interp, canvas, objv[1],
+ &arcPtr->bbox[1]) != TCL_OK)
+ || (Tk_CanvasGetCoordFromObj(interp, canvas, objv[2],
+ &arcPtr->bbox[2]) != TCL_OK)
+ || (Tk_CanvasGetCoordFromObj(interp, canvas, objv[3],
+ &arcPtr->bbox[3]) != TCL_OK)) {
+ return TCL_ERROR;
+ }
+ ComputeArcBbox(canvas, arcPtr);
+ } else {
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "wrong # coordinates: expected 0 or 4, got %d", objc));
+ Tcl_SetErrorCode(interp, "TK", "CANVAS", "COORDS", "ARC", NULL);
+ return TCL_ERROR;
+ }
+ return TCL_OK;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * ConfigureArc --
+ *
+ * This function is invoked to configure various aspects of a arc item,
+ * such as its outline and fill colors.
+ *
+ * Results:
+ * A standard Tcl result code. If an error occurs, then an error message
+ * is left in the interp's result.
+ *
+ * Side effects:
+ * Configuration information, such as colors and stipple patterns, may be
+ * set for itemPtr.
+ *
+ *--------------------------------------------------------------
+ */
+
+static int
+ConfigureArc(
+ Tcl_Interp *interp, /* Used for error reporting. */
+ Tk_Canvas canvas, /* Canvas containing itemPtr. */
+ Tk_Item *itemPtr, /* Arc item to reconfigure. */
+ int objc, /* Number of elements in objv. */
+ Tcl_Obj *const objv[], /* Arguments describing things to configure. */
+ int flags) /* Flags to pass to Tk_ConfigureWidget. */
+{
+ ArcItem *arcPtr = (ArcItem *) itemPtr;
+ XGCValues gcValues;
+ GC newGC;
+ unsigned long mask;
+ int i;
+ Tk_Window tkwin;
+ Tk_TSOffset *tsoffset;
+ XColor *color;
+ Pixmap stipple;
+ Tk_State state;
+
+ tkwin = Tk_CanvasTkwin(canvas);
+ if (TCL_OK != Tk_ConfigureWidget(interp, tkwin, configSpecs, objc,
+ (const char **) objv, (char *) arcPtr, flags|TK_CONFIG_OBJS)) {
+ return TCL_ERROR;
+ }
+
+ state = itemPtr->state;
+
+ /*
+ * A few of the options require additional processing, such as style and
+ * graphics contexts.
+ */
+
+ if (arcPtr->outline.activeWidth > arcPtr->outline.width ||
+ arcPtr->outline.activeDash.number != 0 ||
+ arcPtr->outline.activeColor != NULL ||
+ arcPtr->outline.activeStipple != None ||
+ arcPtr->activeFillColor != NULL ||
+ arcPtr->activeFillStipple != None) {
+ itemPtr->redraw_flags |= TK_ITEM_STATE_DEPENDANT;
+ } else {
+ itemPtr->redraw_flags &= ~TK_ITEM_STATE_DEPENDANT;
+ }
+
+ tsoffset = &arcPtr->outline.tsoffset;
+ flags = tsoffset->flags;
+ if (flags & TK_OFFSET_LEFT) {
+ tsoffset->xoffset = (int) (arcPtr->bbox[0] + 0.5);
+ } else if (flags & TK_OFFSET_CENTER) {
+ tsoffset->xoffset = (int) ((arcPtr->bbox[0]+arcPtr->bbox[2]+1)/2);
+ } else if (flags & TK_OFFSET_RIGHT) {
+ tsoffset->xoffset = (int) (arcPtr->bbox[2] + 0.5);
+ }
+ if (flags & TK_OFFSET_TOP) {
+ tsoffset->yoffset = (int) (arcPtr->bbox[1] + 0.5);
+ } else if (flags & TK_OFFSET_MIDDLE) {
+ tsoffset->yoffset = (int) ((arcPtr->bbox[1]+arcPtr->bbox[3]+1)/2);
+ } else if (flags & TK_OFFSET_BOTTOM) {
+ tsoffset->yoffset = (int) (arcPtr->bbox[2] + 0.5);
+ }
+
+ i = (int) (arcPtr->start/360.0);
+ arcPtr->start -= i*360.0;
+ if (arcPtr->start < 0) {
+ arcPtr->start += 360.0;
+ }
+ i = (int) (arcPtr->extent/360.0);
+ arcPtr->extent -= i*360.0;
+
+ mask = Tk_ConfigOutlineGC(&gcValues, canvas, itemPtr, &(arcPtr->outline));
+ if (mask) {
+ gcValues.cap_style = CapButt;
+ mask |= GCCapStyle;
+ newGC = Tk_GetGC(tkwin, mask, &gcValues);
+ } else {
+ newGC = None;
+ }
+ if (arcPtr->outline.gc != None) {
+ Tk_FreeGC(Tk_Display(tkwin), arcPtr->outline.gc);
+ }
+ arcPtr->outline.gc = newGC;
+
+ if(state == TK_STATE_NULL) {
+ state = Canvas(canvas)->canvas_state;
+ }
+ if (state==TK_STATE_HIDDEN) {
+ ComputeArcBbox(canvas, arcPtr);
+ return TCL_OK;
+ }
+
+ color = arcPtr->fillColor;
+ stipple = arcPtr->fillStipple;
+ if (Canvas(canvas)->currentItemPtr == itemPtr) {
+ if (arcPtr->activeFillColor!=NULL) {
+ color = arcPtr->activeFillColor;
+ }
+ if (arcPtr->activeFillStipple!=None) {
+ stipple = arcPtr->activeFillStipple;
+ }
+ } else if (state==TK_STATE_DISABLED) {
+ if (arcPtr->disabledFillColor!=NULL) {
+ color = arcPtr->disabledFillColor;
+ }
+ if (arcPtr->disabledFillStipple!=None) {
+ stipple = arcPtr->disabledFillStipple;
+ }
+ }
+
+ if (arcPtr->style == ARC_STYLE) {
+ newGC = None;
+ } else if (color == NULL) {
+ newGC = None;
+ } else {
+ gcValues.foreground = color->pixel;
+ if (arcPtr->style == CHORD_STYLE) {
+ gcValues.arc_mode = ArcChord;
+ } else {
+ gcValues.arc_mode = ArcPieSlice;
+ }
+ mask = GCForeground|GCArcMode;
+ if (stipple != None) {
+ gcValues.stipple = stipple;
+ gcValues.fill_style = FillStippled;
+ mask |= GCStipple|GCFillStyle;
+ }
+ newGC = Tk_GetGC(tkwin, mask, &gcValues);
+ }
+ if (arcPtr->fillGC != None) {
+ Tk_FreeGC(Tk_Display(tkwin), arcPtr->fillGC);
+ }
+ arcPtr->fillGC = newGC;
+
+ tsoffset = &arcPtr->tsoffset;
+ flags = tsoffset->flags;
+ if (flags & TK_OFFSET_LEFT) {
+ tsoffset->xoffset = (int) (arcPtr->bbox[0] + 0.5);
+ } else if (flags & TK_OFFSET_CENTER) {
+ tsoffset->xoffset = (int) ((arcPtr->bbox[0]+arcPtr->bbox[2]+1)/2);
+ } else if (flags & TK_OFFSET_RIGHT) {
+ tsoffset->xoffset = (int) (arcPtr->bbox[2] + 0.5);
+ }
+ if (flags & TK_OFFSET_TOP) {
+ tsoffset->yoffset = (int) (arcPtr->bbox[1] + 0.5);
+ } else if (flags & TK_OFFSET_MIDDLE) {
+ tsoffset->yoffset = (int) ((arcPtr->bbox[1]+arcPtr->bbox[3]+1)/2);
+ } else if (flags & TK_OFFSET_BOTTOM) {
+ tsoffset->yoffset = (int) (arcPtr->bbox[3] + 0.5);
+ }
+
+ ComputeArcBbox(canvas, arcPtr);
+ return TCL_OK;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * DeleteArc --
+ *
+ * This function is called to clean up the data structure associated with
+ * an arc item.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Resources associated with itemPtr are released.
+ *
+ *--------------------------------------------------------------
+ */
+
+static void
+DeleteArc(
+ Tk_Canvas canvas, /* Info about overall canvas. */
+ Tk_Item *itemPtr, /* Item that is being deleted. */
+ Display *display) /* Display containing window for canvas. */
+{
+ ArcItem *arcPtr = (ArcItem *) itemPtr;
+
+ Tk_DeleteOutline(display, &(arcPtr->outline));
+ if (arcPtr->numOutlinePoints != 0) {
+ ckfree(arcPtr->outlinePtr);
+ }
+ if (arcPtr->fillColor != NULL) {
+ Tk_FreeColor(arcPtr->fillColor);
+ }
+ if (arcPtr->activeFillColor != NULL) {
+ Tk_FreeColor(arcPtr->activeFillColor);
+ }
+ if (arcPtr->disabledFillColor != NULL) {
+ Tk_FreeColor(arcPtr->disabledFillColor);
+ }
+ if (arcPtr->fillStipple != None) {
+ Tk_FreeBitmap(display, arcPtr->fillStipple);
+ }
+ if (arcPtr->activeFillStipple != None) {
+ Tk_FreeBitmap(display, arcPtr->activeFillStipple);
+ }
+ if (arcPtr->disabledFillStipple != None) {
+ Tk_FreeBitmap(display, arcPtr->disabledFillStipple);
+ }
+ if (arcPtr->fillGC != None) {
+ Tk_FreeGC(display, arcPtr->fillGC);
+ }
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * ComputeArcBbox --
+ *
+ * This function is invoked to compute the bounding box of all the pixels
+ * that may be drawn as part of an arc.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The fields x1, y1, x2, and y2 are updated in the header for itemPtr.
+ *
+ *--------------------------------------------------------------
+ */
+
+ /* ARGSUSED */
+static void
+ComputeArcBbox(
+ Tk_Canvas canvas, /* Canvas that contains item. */
+ ArcItem *arcPtr) /* Item whose bbox is to be recomputed. */
+{
+ double tmp, center[2], point[2];
+ double width;
+ Tk_State state = arcPtr->header.state;
+
+ if (state == TK_STATE_NULL) {
+ state = Canvas(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 (Canvas(canvas)->currentItemPtr == (Tk_Item *) arcPtr) {
+ if (arcPtr->outline.activeWidth>width) {
+ width = arcPtr->outline.activeWidth;
+ }
+ } else if (state==TK_STATE_DISABLED) {
+ if (arcPtr->outline.disabledWidth>0) {
+ width = arcPtr->outline.disabledWidth;
+ }
+ }
+
+ /*
+ * Make sure that the first coordinates are the lowest ones.
+ */
+
+ if (arcPtr->bbox[1] > arcPtr->bbox[3]) {
+ double tmp = arcPtr->bbox[3];
+
+ arcPtr->bbox[3] = arcPtr->bbox[1];
+ arcPtr->bbox[1] = tmp;
+ }
+ if (arcPtr->bbox[0] > arcPtr->bbox[2]) {
+ double tmp = arcPtr->bbox[2];
+
+ arcPtr->bbox[2] = arcPtr->bbox[0];
+ arcPtr->bbox[0] = tmp;
+ }
+
+ ComputeArcOutline(canvas,arcPtr);
+
+ /*
+ * To compute the bounding box, start with the the bbox formed by the two
+ * endpoints of the arc. Then add in the center of the arc's oval (if
+ * relevant) and the 3-o'clock, 6-o'clock, 9-o'clock, and 12-o'clock
+ * positions, if they are relevant.
+ */
+
+ arcPtr->header.x1 = arcPtr->header.x2 = (int) arcPtr->center1[0];
+ arcPtr->header.y1 = arcPtr->header.y2 = (int) arcPtr->center1[1];
+ TkIncludePoint((Tk_Item *) arcPtr, arcPtr->center2);
+ center[0] = (arcPtr->bbox[0] + arcPtr->bbox[2])/2;
+ center[1] = (arcPtr->bbox[1] + arcPtr->bbox[3])/2;
+ if (arcPtr->style == PIESLICE_STYLE) {
+ TkIncludePoint((Tk_Item *) arcPtr, center);
+ }
+
+ tmp = -arcPtr->start;
+ if (tmp < 0) {
+ tmp += 360.0;
+ }
+ if ((tmp < arcPtr->extent) || ((tmp-360) > arcPtr->extent)) {
+ point[0] = arcPtr->bbox[2];
+ point[1] = center[1];
+ TkIncludePoint((Tk_Item *) arcPtr, point);
+ }
+ tmp = 90.0 - arcPtr->start;
+ if (tmp < 0) {
+ tmp += 360.0;
+ }
+ if ((tmp < arcPtr->extent) || ((tmp-360) > arcPtr->extent)) {
+ point[0] = center[0];
+ point[1] = arcPtr->bbox[1];
+ TkIncludePoint((Tk_Item *) arcPtr, point);
+ }
+ tmp = 180.0 - arcPtr->start;
+ if (tmp < 0) {
+ tmp += 360.0;
+ }
+ if ((tmp < arcPtr->extent) || ((tmp-360) > arcPtr->extent)) {
+ point[0] = arcPtr->bbox[0];
+ point[1] = center[1];
+ TkIncludePoint((Tk_Item *) arcPtr, point);
+ }
+ tmp = 270.0 - arcPtr->start;
+ if (tmp < 0) {
+ tmp += 360.0;
+ }
+ if ((tmp < arcPtr->extent) || ((tmp-360) > arcPtr->extent)) {
+ point[0] = center[0];
+ point[1] = arcPtr->bbox[3];
+ TkIncludePoint((Tk_Item *) arcPtr, point);
+ }
+
+ /*
+ * Lastly, expand by the width of the arc (if the arc's outline is being
+ * drawn) and add one extra pixel just for safety.
+ */
+
+ if (arcPtr->outline.gc == None) {
+ tmp = 1;
+ } else {
+ tmp = (int) ((width + 1.0)/2.0 + 1);
+ }
+ arcPtr->header.x1 -= (int) tmp;
+ arcPtr->header.y1 -= (int) tmp;
+ arcPtr->header.x2 += (int) tmp;
+ arcPtr->header.y2 += (int) tmp;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * DisplayArc --
+ *
+ * This function is invoked to draw an arc item in a given drawable.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * ItemPtr is drawn in drawable using the transformation information in
+ * canvas.
+ *
+ *--------------------------------------------------------------
+ */
+
+static void
+DisplayArc(
+ 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, int y, /* Describes region of canvas that must be */
+ int width, int height) /* redisplayed (not used). */
+{
+ ArcItem *arcPtr = (ArcItem *) itemPtr;
+ short x1, y1, x2, y2;
+ int start, extent, dashnumber;
+ double lineWidth;
+ Tk_State state = itemPtr->state;
+ Pixmap stipple;
+
+ if (state == TK_STATE_NULL) {
+ state = Canvas(canvas)->canvas_state;
+ }
+ lineWidth = arcPtr->outline.width;
+ if (lineWidth < 1.0) {
+ lineWidth = 1.0;
+ }
+ dashnumber = arcPtr->outline.dash.number;
+ stipple = arcPtr->fillStipple;
+ if (Canvas(canvas)->currentItemPtr == itemPtr) {
+ if (arcPtr->outline.activeWidth>lineWidth) {
+ lineWidth = arcPtr->outline.activeWidth;
+ }
+ if (arcPtr->outline.activeDash.number != 0) {
+ dashnumber = arcPtr->outline.activeDash.number;
+ }
+ if (arcPtr->activeFillStipple != None) {
+ stipple = arcPtr->activeFillStipple;
+ }
+ } else if (state == TK_STATE_DISABLED) {
+ if (arcPtr->outline.disabledWidth > 0) {
+ lineWidth = arcPtr->outline.disabledWidth;
+ }
+ if (arcPtr->outline.disabledDash.number != 0) {
+ dashnumber = arcPtr->outline.disabledDash.number;
+ }
+ if (arcPtr->disabledFillStipple != None) {
+ stipple = arcPtr->disabledFillStipple;
+ }
+ }
+
+ /*
+ * Compute the screen coordinates of the bounding box for the item, plus
+ * integer values for the angles.
+ */
+
+ Tk_CanvasDrawableCoords(canvas, arcPtr->bbox[0], arcPtr->bbox[1],
+ &x1, &y1);
+ Tk_CanvasDrawableCoords(canvas, arcPtr->bbox[2], arcPtr->bbox[3],
+ &x2, &y2);
+ if (x2 <= x1) {
+ x2 = x1+1;
+ }
+ if (y2 <= y1) {
+ y2 = y1+1;
+ }
+ start = (int) ((64*arcPtr->start) + 0.5);
+ extent = (int) ((64*arcPtr->extent) + 0.5);
+
+ /*
+ * Display filled arc first (if wanted), then outline. If the extent is
+ * zero then don't invoke XFillArc or XDrawArc, since this causes some
+ * window servers to crash and should be a no-op anyway.
+ */
+
+ if ((arcPtr->fillGC != None) && (extent != 0)) {
+ if (stipple != None) {
+ int w = 0;
+ int h = 0;
+ Tk_TSOffset *tsoffset = &arcPtr->tsoffset;
+ int flags = tsoffset->flags;
+
+ if (flags & (TK_OFFSET_CENTER|TK_OFFSET_MIDDLE)) {
+ Tk_SizeOfBitmap(display, stipple, &w, &h);
+ if (flags & TK_OFFSET_CENTER) {
+ w /= 2;
+ } else {
+ w = 0;
+ }
+ if (flags & TK_OFFSET_MIDDLE) {
+ h /= 2;
+ } else {
+ h = 0;
+ }
+ }
+ tsoffset->xoffset -= w;
+ tsoffset->yoffset -= h;
+ Tk_CanvasSetOffset(canvas, arcPtr->fillGC, tsoffset);
+ if (tsoffset) {
+ tsoffset->xoffset += w;
+ tsoffset->yoffset += h;
+ }
+ }
+ XFillArc(display, drawable, arcPtr->fillGC, x1, y1, (unsigned) (x2-x1),
+ (unsigned) (y2-y1), start, extent);
+ if (stipple != None) {
+ XSetTSOrigin(display, arcPtr->fillGC, 0, 0);
+ }
+ }
+ if (arcPtr->outline.gc != None) {
+ Tk_ChangeOutlineGC(canvas, itemPtr, &(arcPtr->outline));
+
+ if (extent != 0) {
+ XDrawArc(display, drawable, arcPtr->outline.gc, x1, y1,
+ (unsigned) (x2-x1), (unsigned) (y2-y1), start, extent);
+ }
+
+ /*
+ * If the outline width is very thin, don't use polygons to draw the
+ * linear parts of the outline (this often results in nothing being
+ * displayed); just draw lines instead. The same is done if the
+ * outline is dashed, because then polygons don't work.
+ */
+
+ if (lineWidth < 1.5 || dashnumber != 0) {
+ Tk_CanvasDrawableCoords(canvas, arcPtr->center1[0],
+ arcPtr->center1[1], &x1, &y1);
+ Tk_CanvasDrawableCoords(canvas, arcPtr->center2[0],
+ arcPtr->center2[1], &x2, &y2);
+
+ if (arcPtr->style == CHORD_STYLE) {
+ XDrawLine(display, drawable, arcPtr->outline.gc,
+ x1, y1, x2, y2);
+ } else if (arcPtr->style == PIESLICE_STYLE) {
+ short cx, cy;
+
+ Tk_CanvasDrawableCoords(canvas,
+ (arcPtr->bbox[0] + arcPtr->bbox[2])/2.0,
+ (arcPtr->bbox[1] + arcPtr->bbox[3])/2.0, &cx, &cy);
+ XDrawLine(display, drawable, arcPtr->outline.gc,
+ cx, cy, x1, y1);
+ XDrawLine(display, drawable, arcPtr->outline.gc,
+ cx, cy, x2, y2);
+ }
+ } else {
+ if (arcPtr->style == CHORD_STYLE) {
+ TkFillPolygon(canvas, arcPtr->outlinePtr, CHORD_OUTLINE_PTS,
+ display, drawable, arcPtr->outline.gc, None);
+ } else if (arcPtr->style == PIESLICE_STYLE) {
+ TkFillPolygon(canvas, arcPtr->outlinePtr, PIE_OUTLINE1_PTS,
+ display, drawable, arcPtr->outline.gc, None);
+ TkFillPolygon(canvas, arcPtr->outlinePtr + 2*PIE_OUTLINE1_PTS,
+ PIE_OUTLINE2_PTS, display, drawable,
+ arcPtr->outline.gc, None);
+ }
+ }
+
+ Tk_ResetOutlineGC(canvas, itemPtr, &(arcPtr->outline));
+ }
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * ArcToPoint --
+ *
+ * Computes the distance from a given point to a given arc, in canvas
+ * units.
+ *
+ * Results:
+ * The return value is 0 if the point whose x and y coordinates are
+ * coordPtr[0] and coordPtr[1] is inside the arc. If the point isn't
+ * inside the arc then the return value is the distance from the point to
+ * the arc. If itemPtr is filled, then anywhere in the interior is
+ * considered "inside"; if itemPtr isn't filled, then "inside" means only
+ * the area occupied by the outline.
+ *
+ * Side effects:
+ * None.
+ *
+ *--------------------------------------------------------------
+ */
+
+ /* ARGSUSED */
+static double
+ArcToPoint(
+ Tk_Canvas canvas, /* Canvas containing item. */
+ Tk_Item *itemPtr, /* Item to check against point. */
+ double *pointPtr) /* Pointer to x and y coordinates. */
+{
+ ArcItem *arcPtr = (ArcItem *) itemPtr;
+ double vertex[2], pointAngle, diff, dist, newDist;
+ double poly[8], polyDist, width, t1, t2;
+ int filled, angleInRange;
+ Tk_State state = itemPtr->state;
+
+ if (state == TK_STATE_NULL) {
+ state = Canvas(canvas)->canvas_state;
+ }
+
+ width = (double) arcPtr->outline.width;
+ if (Canvas(canvas)->currentItemPtr == itemPtr) {
+ if (arcPtr->outline.activeWidth>width) {
+ width = (double) arcPtr->outline.activeWidth;
+ }
+ } else if (state == TK_STATE_DISABLED) {
+ if (arcPtr->outline.disabledWidth>0) {
+ width = (double) arcPtr->outline.disabledWidth;
+ }
+ }
+
+ /*
+ * See if the point is within the angular range of the arc. Remember, X
+ * angles are backwards from the way we'd normally think of them. Also,
+ * compensate for any eccentricity of the oval.
+ */
+
+ vertex[0] = (arcPtr->bbox[0] + arcPtr->bbox[2])/2.0;
+ vertex[1] = (arcPtr->bbox[1] + arcPtr->bbox[3])/2.0;
+ t1 = arcPtr->bbox[3] - arcPtr->bbox[1];
+ if (t1 != 0.0) {
+ t1 = (pointPtr[1] - vertex[1]) / t1;
+ }
+ t2 = arcPtr->bbox[2] - arcPtr->bbox[0];
+ if (t2 != 0.0) {
+ t2 = (pointPtr[0] - vertex[0]) / t2;
+ }
+ if ((t1 == 0.0) && (t2 == 0.0)) {
+ pointAngle = 0;
+ } else {
+ pointAngle = -atan2(t1, t2)*180/PI;
+ }
+ diff = pointAngle - arcPtr->start;
+ diff -= ((int) (diff/360.0) * 360.0);
+ if (diff < 0) {
+ diff += 360.0;
+ }
+ angleInRange = (diff <= arcPtr->extent) ||
+ ((arcPtr->extent < 0) && ((diff - 360.0) >= arcPtr->extent));
+
+ /*
+ * Now perform different tests depending on what kind of arc we're dealing
+ * with.
+ */
+
+ if (arcPtr->style == ARC_STYLE) {
+ if (angleInRange) {
+ return TkOvalToPoint(arcPtr->bbox, width, 0, pointPtr);
+ }
+ dist = hypot(pointPtr[0] - arcPtr->center1[0],
+ pointPtr[1] - arcPtr->center1[1]);
+ newDist = hypot(pointPtr[0] - arcPtr->center2[0],
+ pointPtr[1] - arcPtr->center2[1]);
+ if (newDist < dist) {
+ return newDist;
+ }
+ return dist;
+ }
+
+ if ((arcPtr->fillGC != None) || (arcPtr->outline.gc == None)) {
+ filled = 1;
+ } else {
+ filled = 0;
+ }
+ if (arcPtr->outline.gc == None) {
+ width = 0.0;
+ }
+
+ if (arcPtr->style == PIESLICE_STYLE) {
+ if (width > 1.0) {
+ dist = TkPolygonToPoint(arcPtr->outlinePtr, PIE_OUTLINE1_PTS,
+ pointPtr);
+ newDist = TkPolygonToPoint(arcPtr->outlinePtr + 2*PIE_OUTLINE1_PTS,
+ PIE_OUTLINE2_PTS, pointPtr);
+ } else {
+ dist = TkLineToPoint(vertex, arcPtr->center1, pointPtr);
+ newDist = TkLineToPoint(vertex, arcPtr->center2, pointPtr);
+ }
+ if (newDist < dist) {
+ dist = newDist;
+ }
+ if (angleInRange) {
+ newDist = TkOvalToPoint(arcPtr->bbox, width, filled, pointPtr);
+ if (newDist < dist) {
+ dist = newDist;
+ }
+ }
+ return dist;
+ }
+
+ /*
+ * This is a chord-style arc. We have to deal specially with the
+ * triangular piece that represents the difference between a chord-style
+ * arc and a pie-slice arc (for small angles this piece is excluded here
+ * where it would be included for pie slices; for large angles the piece
+ * is included here but would be excluded for pie slices).
+ */
+
+ if (width > 1.0) {
+ dist = TkPolygonToPoint(arcPtr->outlinePtr, CHORD_OUTLINE_PTS,
+ pointPtr);
+ } else {
+ dist = TkLineToPoint(arcPtr->center1, arcPtr->center2, pointPtr);
+ }
+ poly[0] = poly[6] = vertex[0];
+ poly[1] = poly[7] = vertex[1];
+ poly[2] = arcPtr->center1[0];
+ poly[3] = arcPtr->center1[1];
+ poly[4] = arcPtr->center2[0];
+ poly[5] = arcPtr->center2[1];
+ polyDist = TkPolygonToPoint(poly, 4, pointPtr);
+ if (angleInRange) {
+ if ((arcPtr->extent < -180.0) || (arcPtr->extent > 180.0)
+ || (polyDist > 0.0)) {
+ newDist = TkOvalToPoint(arcPtr->bbox, width, filled, pointPtr);
+ if (newDist < dist) {
+ dist = newDist;
+ }
+ }
+ } else {
+ if ((arcPtr->extent < -180.0) || (arcPtr->extent > 180.0)) {
+ if (filled && (polyDist < dist)) {
+ dist = polyDist;
+ }
+ }
+ }
+ return dist;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * ArcToArea --
+ *
+ * This function is called to determine whether an item lies entirely
+ * inside, entirely outside, or overlapping a given area.
+ *
+ * Results:
+ * -1 is returned if the item is entirely outside the area given by
+ * rectPtr, 0 if it overlaps, and 1 if it is entirely inside the given
+ * area.
+ *
+ * Side effects:
+ * None.
+ *
+ *--------------------------------------------------------------
+ */
+
+ /* ARGSUSED */
+static int
+ArcToArea(
+ Tk_Canvas canvas, /* Canvas containing item. */
+ Tk_Item *itemPtr, /* Item to check against arc. */
+ double *rectPtr) /* Pointer to array of four coordinates (x1,
+ * y1, x2, y2) describing rectangular area. */
+{
+ ArcItem *arcPtr = (ArcItem *) itemPtr;
+ double rx, ry; /* Radii for transformed oval: these define an
+ * oval centered at the origin. */
+ double tRect[4]; /* Transformed version of x1, y1, x2, y2, for
+ * coord. system where arc is centered on the
+ * origin. */
+ double center[2], width, angle, tmp;
+ double points[20], *pointPtr;
+ int numPoints, filled;
+ int inside; /* Non-zero means every test so far suggests
+ * that arc is inside rectangle. 0 means every
+ * test so far shows arc to be outside of
+ * rectangle. */
+ int newInside;
+ Tk_State state = itemPtr->state;
+
+ if(state == TK_STATE_NULL) {
+ state = Canvas(canvas)->canvas_state;
+ }
+ width = (double) arcPtr->outline.width;
+ if (Canvas(canvas)->currentItemPtr == itemPtr) {
+ if (arcPtr->outline.activeWidth>width) {
+ width = (double) arcPtr->outline.activeWidth;
+ }
+ } else if (state == TK_STATE_DISABLED) {
+ if (arcPtr->outline.disabledWidth>0) {
+ width = (double) arcPtr->outline.disabledWidth;
+ }
+ }
+
+ if ((arcPtr->fillGC != None) || (arcPtr->outline.gc == None)) {
+ filled = 1;
+ } else {
+ filled = 0;
+ }
+ if (arcPtr->outline.gc == None) {
+ width = 0.0;
+ }
+
+ /*
+ * Transform both the arc and the rectangle so that the arc's oval is
+ * centered on the origin.
+ */
+
+ center[0] = (arcPtr->bbox[0] + arcPtr->bbox[2])/2.0;
+ center[1] = (arcPtr->bbox[1] + arcPtr->bbox[3])/2.0;
+ tRect[0] = rectPtr[0] - center[0];
+ tRect[1] = rectPtr[1] - center[1];
+ tRect[2] = rectPtr[2] - center[0];
+ tRect[3] = rectPtr[3] - center[1];
+ rx = arcPtr->bbox[2] - center[0] + width/2.0;
+ ry = arcPtr->bbox[3] - center[1] + width/2.0;
+
+ /*
+ * Find the extreme points of the arc and see whether these are all inside
+ * the rectangle (in which case we're done), partly in and partly out (in
+ * which case we're done), or all outside (in which case we have more work
+ * to do). The extreme points include the following, which are checked in
+ * order:
+ *
+ * 1. The outside points of the arc, corresponding to start and extent.
+ * 2. The center of the arc (but only in pie-slice mode).
+ * 3. The 12, 3, 6, and 9-o'clock positions (but only if the arc includes
+ * those angles).
+ */
+
+ pointPtr = points;
+ angle = -arcPtr->start*(PI/180.0);
+ pointPtr[0] = rx*cos(angle);
+ pointPtr[1] = ry*sin(angle);
+ angle += -arcPtr->extent*(PI/180.0);
+ pointPtr[2] = rx*cos(angle);
+ pointPtr[3] = ry*sin(angle);
+ numPoints = 2;
+ pointPtr += 4;
+
+ if ((arcPtr->style == PIESLICE_STYLE) && (arcPtr->extent < 180.0)) {
+ pointPtr[0] = 0.0;
+ pointPtr[1] = 0.0;
+ numPoints++;
+ pointPtr += 2;
+ }
+
+ tmp = -arcPtr->start;
+ if (tmp < 0) {
+ tmp += 360.0;
+ }
+ if ((tmp < arcPtr->extent) || ((tmp-360) > arcPtr->extent)) {
+ pointPtr[0] = rx;
+ pointPtr[1] = 0.0;
+ numPoints++;
+ pointPtr += 2;
+ }
+ tmp = 90.0 - arcPtr->start;
+ if (tmp < 0) {
+ tmp += 360.0;
+ }
+ if ((tmp < arcPtr->extent) || ((tmp-360) > arcPtr->extent)) {
+ pointPtr[0] = 0.0;
+ pointPtr[1] = -ry;
+ numPoints++;
+ pointPtr += 2;
+ }
+ tmp = 180.0 - arcPtr->start;
+ if (tmp < 0) {
+ tmp += 360.0;
+ }
+ if ((tmp < arcPtr->extent) || ((tmp-360) > arcPtr->extent)) {
+ pointPtr[0] = -rx;
+ pointPtr[1] = 0.0;
+ numPoints++;
+ pointPtr += 2;
+ }
+ tmp = 270.0 - arcPtr->start;
+ if (tmp < 0) {
+ tmp += 360.0;
+ }
+ if ((tmp < arcPtr->extent) || ((tmp-360) > arcPtr->extent)) {
+ pointPtr[0] = 0.0;
+ pointPtr[1] = ry;
+ numPoints++;
+ }
+
+ /*
+ * Now that we've located the extreme points, loop through them all to see
+ * which are inside the rectangle.
+ */
+
+ inside = (points[0] > tRect[0]) && (points[0] < tRect[2])
+ && (points[1] > tRect[1]) && (points[1] < tRect[3]);
+ for (pointPtr = points+2; numPoints > 1; pointPtr += 2, numPoints--) {
+ newInside = (pointPtr[0] > tRect[0]) && (pointPtr[0] < tRect[2])
+ && (pointPtr[1] > tRect[1]) && (pointPtr[1] < tRect[3]);
+ if (newInside != inside) {
+ return 0;
+ }
+ }
+
+ if (inside) {
+ return 1;
+ }
+
+ /*
+ * So far, oval appears to be outside rectangle, but can't yet tell for
+ * sure. Next, test each of the four sides of the rectangle against the
+ * bounding region for the arc. If any intersections are found, then
+ * return "overlapping". First, test against the polygon(s) forming the
+ * sides of a chord or pie-slice.
+ */
+
+ if (arcPtr->style == PIESLICE_STYLE) {
+ if (width >= 1.0) {
+ if (TkPolygonToArea(arcPtr->outlinePtr, PIE_OUTLINE1_PTS,
+ rectPtr) != -1) {
+ return 0;
+ }
+ if (TkPolygonToArea(arcPtr->outlinePtr + 2*PIE_OUTLINE1_PTS,
+ PIE_OUTLINE2_PTS, rectPtr) != -1) {
+ return 0;
+ }
+ } else {
+ if ((TkLineToArea(center, arcPtr->center1, rectPtr) != -1) ||
+ (TkLineToArea(center, arcPtr->center2, rectPtr) != -1)) {
+ return 0;
+ }
+ }
+ } else if (arcPtr->style == CHORD_STYLE) {
+ if (width >= 1.0) {
+ if (TkPolygonToArea(arcPtr->outlinePtr, CHORD_OUTLINE_PTS,
+ rectPtr) != -1) {
+ return 0;
+ }
+ } else {
+ if (TkLineToArea(arcPtr->center1, arcPtr->center2,
+ rectPtr) != -1) {
+ return 0;
+ }
+ }
+ }
+
+ /*
+ * Next check for overlap between each of the four sides and the outer
+ * perimiter of the arc. If the arc isn't filled, then also check the
+ * inner perimeter of the arc.
+ */
+
+ if (HorizLineToArc(tRect[0], tRect[2], tRect[1], rx, ry, arcPtr->start,
+ arcPtr->extent)
+ || HorizLineToArc(tRect[0], tRect[2], tRect[3], rx, ry,
+ arcPtr->start, arcPtr->extent)
+ || VertLineToArc(tRect[0], tRect[1], tRect[3], rx, ry,
+ arcPtr->start, arcPtr->extent)
+ || VertLineToArc(tRect[2], tRect[1], tRect[3], rx, ry,
+ arcPtr->start, arcPtr->extent)) {
+ return 0;
+ }
+ if ((width > 1.0) && !filled) {
+ rx -= width;
+ ry -= width;
+ if (HorizLineToArc(tRect[0], tRect[2], tRect[1], rx, ry, arcPtr->start,
+ arcPtr->extent)
+ || HorizLineToArc(tRect[0], tRect[2], tRect[3], rx, ry,
+ arcPtr->start, arcPtr->extent)
+ || VertLineToArc(tRect[0], tRect[1], tRect[3], rx, ry,
+ arcPtr->start, arcPtr->extent)
+ || VertLineToArc(tRect[2], tRect[1], tRect[3], rx, ry,
+ arcPtr->start, arcPtr->extent)) {
+ return 0;
+ }
+ }
+
+ /*
+ * The arc still appears to be totally disjoint from the rectangle, but
+ * it's also possible that the rectangle is totally inside the arc. Do one
+ * last check, which is to check one point of the rectangle to see if it's
+ * inside the arc. If it is, we've got overlap. If it isn't, the arc's
+ * really outside the rectangle.
+ */
+
+ if (ArcToPoint(canvas, itemPtr, rectPtr) == 0.0) {
+ return 0;
+ }
+ return -1;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * ScaleArc --
+ *
+ * This function is invoked to rescale an arc item.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The arc referred to by itemPtr is rescaled so that the following
+ * transformation is applied to all point coordinates:
+ * x' = originX + scaleX*(x-originX)
+ * y' = originY + scaleY*(y-originY)
+ *
+ *--------------------------------------------------------------
+ */
+
+static void
+ScaleArc(
+ Tk_Canvas canvas, /* Canvas containing arc. */
+ Tk_Item *itemPtr, /* Arc to be scaled. */
+ double originX, /* Origin about which to scale rect. */
+ double originY,
+ double scaleX, /* Amount to scale in X direction. */
+ double scaleY) /* Amount to scale in Y direction. */
+{
+ ArcItem *arcPtr = (ArcItem *) itemPtr;
+
+ arcPtr->bbox[0] = originX + scaleX*(arcPtr->bbox[0] - originX);
+ arcPtr->bbox[1] = originY + scaleY*(arcPtr->bbox[1] - originY);
+ arcPtr->bbox[2] = originX + scaleX*(arcPtr->bbox[2] - originX);
+ arcPtr->bbox[3] = originY + scaleY*(arcPtr->bbox[3] - originY);
+ ComputeArcBbox(canvas, arcPtr);
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * TranslateArc --
+ *
+ * This function is called to move an arc by a given amount.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The position of the arc is offset by (xDelta, yDelta), and the
+ * bounding box is updated in the generic part of the item structure.
+ *
+ *--------------------------------------------------------------
+ */
+
+static void
+TranslateArc(
+ Tk_Canvas canvas, /* Canvas containing item. */
+ Tk_Item *itemPtr, /* Item that is being moved. */
+ double deltaX, /* Amount by which item is to be moved. */
+ double deltaY)
+{
+ ArcItem *arcPtr = (ArcItem *) itemPtr;
+
+ arcPtr->bbox[0] += deltaX;
+ arcPtr->bbox[1] += deltaY;
+ arcPtr->bbox[2] += deltaX;
+ arcPtr->bbox[3] += deltaY;
+ ComputeArcBbox(canvas, arcPtr);
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * ComputeArcOutline --
+ *
+ * This function creates a polygon describing everything in the outline
+ * for an arc except what's in the curved part. For a "pie slice" arc
+ * this is a V-shaped chunk, and for a "chord" arc this is a linear chunk
+ * (with cutaway corners). For "arc" arcs, this stuff isn't relevant.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The information at arcPtr->outlinePtr gets modified, and storage for
+ * arcPtr->outlinePtr may be allocated or freed.
+ *
+ *--------------------------------------------------------------
+ */
+
+static void
+ComputeArcOutline(
+ Tk_Canvas canvas, /* Information about overall canvas. */
+ ArcItem *arcPtr) /* Information about arc. */
+{
+ double sin1, cos1, sin2, cos2, angle, width, halfWidth;
+ double boxWidth, boxHeight;
+ double vertex[2], corner1[2], corner2[2];
+ double *outlinePtr;
+ Tk_State state = arcPtr->header.state;
+
+ /*
+ * Make sure that the outlinePtr array is large enough to hold either a
+ * chord or pie-slice outline.
+ */
+
+ if (arcPtr->numOutlinePoints == 0) {
+ arcPtr->outlinePtr = ckalloc(26 * sizeof(double));
+ arcPtr->numOutlinePoints = 22;
+ }
+ outlinePtr = arcPtr->outlinePtr;
+
+ if (state == TK_STATE_NULL) {
+ state = Canvas(canvas)->canvas_state;
+ }
+
+ /*
+ * First compute the two points that lie at the centers of the ends of the
+ * curved arc segment, which are marked with X's in the figure below:
+ *
+ *
+ * * * *
+ * * *
+ * * * * *
+ * * * * *
+ * * * * *
+ * X * * X
+ *
+ * The code is tricky because the arc can be ovular in shape. It computes
+ * the position for a unit circle, and then scales to fit the shape of the
+ * arc's bounding box.
+ *
+ * Also, watch out because angles go counter-clockwise like you might
+ * expect, but the y-coordinate system is inverted. To handle this, just
+ * negate the angles in all the computations.
+ */
+
+ boxWidth = arcPtr->bbox[2] - arcPtr->bbox[0];
+ boxHeight = arcPtr->bbox[3] - arcPtr->bbox[1];
+ angle = -arcPtr->start*PI/180.0;
+ sin1 = sin(angle);
+ cos1 = cos(angle);
+ angle -= arcPtr->extent*PI/180.0;
+ sin2 = sin(angle);
+ cos2 = cos(angle);
+ vertex[0] = (arcPtr->bbox[0] + arcPtr->bbox[2])/2.0;
+ vertex[1] = (arcPtr->bbox[1] + arcPtr->bbox[3])/2.0;
+ arcPtr->center1[0] = vertex[0] + cos1*boxWidth/2.0;
+ arcPtr->center1[1] = vertex[1] + sin1*boxHeight/2.0;
+ arcPtr->center2[0] = vertex[0] + cos2*boxWidth/2.0;
+ arcPtr->center2[1] = vertex[1] + sin2*boxHeight/2.0;
+
+ /*
+ * Next compute the "outermost corners" of the arc, which are marked with
+ * X's in the figure below:
+ *
+ * * * *
+ * * *
+ * * * * *
+ * * * * *
+ * X * * X
+ * * *
+ *
+ * The code below is tricky because it has to handle eccentricity in the
+ * shape of the oval. The key in the code below is to realize that the
+ * slope of the line from arcPtr->center1 to corner1 is (boxWidth*sin1)
+ * divided by (boxHeight*cos1), and similarly for arcPtr->center2 and
+ * corner2. These formulas can be computed from the formula for the oval.
+ */
+
+ width = arcPtr->outline.width;
+ if (Canvas(canvas)->currentItemPtr == (Tk_Item *) arcPtr) {
+ if (arcPtr->outline.activeWidth>arcPtr->outline.width) {
+ width = arcPtr->outline.activeWidth;
+ }
+ } else if (state == TK_STATE_DISABLED) {
+ if (arcPtr->outline.disabledWidth>arcPtr->outline.width) {
+ width = arcPtr->outline.disabledWidth;
+ }
+ }
+ halfWidth = width/2.0;
+
+ if (((boxWidth*sin1) == 0.0) && ((boxHeight*cos1) == 0.0)) {
+ angle = 0.0;
+ } else {
+ angle = atan2(boxWidth*sin1, boxHeight*cos1);
+ }
+ corner1[0] = arcPtr->center1[0] + cos(angle)*halfWidth;
+ corner1[1] = arcPtr->center1[1] + sin(angle)*halfWidth;
+ if (((boxWidth*sin2) == 0.0) && ((boxHeight*cos2) == 0.0)) {
+ angle = 0.0;
+ } else {
+ angle = atan2(boxWidth*sin2, boxHeight*cos2);
+ }
+ corner2[0] = arcPtr->center2[0] + cos(angle)*halfWidth;
+ corner2[1] = arcPtr->center2[1] + sin(angle)*halfWidth;
+
+ /*
+ * For a chord outline, generate a six-sided polygon with three points for
+ * each end of the chord. The first and third points for each end are butt
+ * points generated on either side of the center point. The second point
+ * is the corner point.
+ */
+
+ if (arcPtr->style == CHORD_STYLE) {
+ outlinePtr[0] = outlinePtr[12] = corner1[0];
+ outlinePtr[1] = outlinePtr[13] = corner1[1];
+ TkGetButtPoints(arcPtr->center2, arcPtr->center1,
+ width, 0, outlinePtr+10, outlinePtr+2);
+ outlinePtr[4] = arcPtr->center2[0] + outlinePtr[2]
+ - arcPtr->center1[0];
+ outlinePtr[5] = arcPtr->center2[1] + outlinePtr[3]
+ - arcPtr->center1[1];
+ outlinePtr[6] = corner2[0];
+ outlinePtr[7] = corner2[1];
+ outlinePtr[8] = arcPtr->center2[0] + outlinePtr[10]
+ - arcPtr->center1[0];
+ outlinePtr[9] = arcPtr->center2[1] + outlinePtr[11]
+ - arcPtr->center1[1];
+ } else if (arcPtr->style == PIESLICE_STYLE) {
+ /*
+ * For pie slices, generate two polygons, one for each side of the pie
+ * slice. The first arm has a shape like this, where the center of the
+ * oval is X, arcPtr->center1 is at Y, and corner1 is at Z:
+ *
+ * _____________________
+ * | \
+ * | \
+ * X Y Z
+ * | /
+ * |_____________________/
+ */
+
+ TkGetButtPoints(arcPtr->center1, vertex, width, 0,
+ outlinePtr, outlinePtr+2);
+ outlinePtr[4] = arcPtr->center1[0] + outlinePtr[2] - vertex[0];
+ outlinePtr[5] = arcPtr->center1[1] + outlinePtr[3] - vertex[1];
+ outlinePtr[6] = corner1[0];
+ outlinePtr[7] = corner1[1];
+ outlinePtr[8] = arcPtr->center1[0] + outlinePtr[0] - vertex[0];
+ outlinePtr[9] = arcPtr->center1[1] + outlinePtr[1] - vertex[1];
+ outlinePtr[10] = outlinePtr[0];
+ outlinePtr[11] = outlinePtr[1];
+
+ /*
+ * The second arm has a shape like this:
+ *
+ * ______________________
+ * / \
+ * / \
+ * Z Y X /
+ * \ /
+ * \______________________/
+ *
+ * Similar to above X is the center of the oval/circle, Y is
+ * arcPtr->center2, and Z is corner2. The extra jog out to the left of
+ * X is needed in or to produce a butted joint with the first arm; the
+ * corner to the right of X is one of the first two points of the
+ * first arm, depending on extent.
+ */
+
+ TkGetButtPoints(arcPtr->center2, vertex, width, 0,
+ outlinePtr+12, outlinePtr+16);
+ if ((arcPtr->extent > 180) ||
+ ((arcPtr->extent < 0) && (arcPtr->extent > -180))) {
+ outlinePtr[14] = outlinePtr[0];
+ outlinePtr[15] = outlinePtr[1];
+ } else {
+ outlinePtr[14] = outlinePtr[2];
+ outlinePtr[15] = outlinePtr[3];
+ }
+ outlinePtr[18] = arcPtr->center2[0] + outlinePtr[16] - vertex[0];
+ outlinePtr[19] = arcPtr->center2[1] + outlinePtr[17] - vertex[1];
+ outlinePtr[20] = corner2[0];
+ outlinePtr[21] = corner2[1];
+ outlinePtr[22] = arcPtr->center2[0] + outlinePtr[12] - vertex[0];
+ outlinePtr[23] = arcPtr->center2[1] + outlinePtr[13] - vertex[1];
+ outlinePtr[24] = outlinePtr[12];
+ outlinePtr[25] = outlinePtr[13];
+ }
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * HorizLineToArc --
+ *
+ * Determines whether a horizontal line segment intersects a given arc.
+ *
+ * Results:
+ * The return value is 1 if the given line intersects the infinitely-thin
+ * arc section defined by rx, ry, start, and extent, and 0 otherwise.
+ * Only the perimeter of the arc is checked: interior areas (e.g. chord
+ * or pie-slice) are not checked.
+ *
+ * Side effects:
+ * None.
+ *
+ *--------------------------------------------------------------
+ */
+
+static int
+HorizLineToArc(
+ double x1, double x2, /* X-coords of endpoints of line segment. X1
+ * must be <= x2. */
+ double y, /* Y-coordinate of line segment. */
+ double rx, double ry, /* These x- and y-radii define an oval
+ * centered at the origin. */
+ double start, double extent)/* Angles that define extent of arc, in the
+ * standard fashion for this module. */
+{
+ double tmp, x;
+ double tx, ty; /* Coordinates of intersection point in
+ * transformed coordinate system. */
+
+ /*
+ * Compute the x-coordinate of one possible intersection point between the
+ * arc and the line. Use a transformed coordinate system where the oval is
+ * a unit circle centered at the origin. Then scale back to get actual
+ * x-coordinate.
+ */
+
+ ty = y/ry;
+ tmp = 1 - ty*ty;
+ if (tmp < 0) {
+ return 0;
+ }
+ tx = sqrt(tmp);
+ x = tx*rx;
+
+ /*
+ * Test both intersection points.
+ */
+
+ if ((x >= x1) && (x <= x2) && AngleInRange(tx, ty, start, extent)) {
+ return 1;
+ }
+ if ((-x >= x1) && (-x <= x2) && AngleInRange(-tx, ty, start, extent)) {
+ return 1;
+ }
+ return 0;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * VertLineToArc --
+ *
+ * Determines whether a vertical line segment intersects a given arc.
+ *
+ * Results:
+ * The return value is 1 if the given line intersects the infinitely-thin
+ * arc section defined by rx, ry, start, and extent, and 0 otherwise.
+ * Only the perimeter of the arc is checked: interior areas (e.g. chord
+ * or pie-slice) are not checked.
+ *
+ * Side effects:
+ * None.
+ *
+ *--------------------------------------------------------------
+ */
+
+static int
+VertLineToArc(
+ double x, /* X-coordinate of line segment. */
+ double y1, double y2, /* Y-coords of endpoints of line segment. Y1
+ * must be <= y2. */
+ double rx, double ry, /* These x- and y-radii define an oval
+ * centered at the origin. */
+ double start, double extent)/* Angles that define extent of arc, in the
+ * standard fashion for this module. */
+{
+ double tmp, y;
+ double tx, ty; /* Coordinates of intersection point in
+ * transformed coordinate system. */
+
+ /*
+ * Compute the y-coordinate of one possible intersection point between the
+ * arc and the line. Use a transformed coordinate system where the oval is
+ * a unit circle centered at the origin. Then scale back to get actual
+ * y-coordinate.
+ */
+
+ tx = x/rx;
+ tmp = 1 - tx*tx;
+ if (tmp < 0) {
+ return 0;
+ }
+ ty = sqrt(tmp);
+ y = ty*ry;
+
+ /*
+ * Test both intersection points.
+ */
+
+ if ((y > y1) && (y < y2) && AngleInRange(tx, ty, start, extent)) {
+ return 1;
+ }
+ if ((-y > y1) && (-y < y2) && AngleInRange(tx, -ty, start, extent)) {
+ return 1;
+ }
+ return 0;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * AngleInRange --
+ *
+ * Determine whether the angle from the origin to a given point is within
+ * a given range.
+ *
+ * Results:
+ * The return value is 1 if the angle from (0,0) to (x,y) is in the range
+ * given by start and extent, where angles are interpreted in the
+ * standard way for ovals (meaning backwards from normal interpretation).
+ * Otherwise the return value is 0.
+ *
+ * Side effects:
+ * None.
+ *
+ *--------------------------------------------------------------
+ */
+
+static int
+AngleInRange(
+ double x, double y, /* Coordinate of point; angle measured from
+ * origin to here, relative to x-axis. */
+ double start, /* First angle, degrees, >=0, <=360. */
+ double extent) /* Size of arc in degrees >=-360, <=360. */
+{
+ double diff;
+
+ if ((x == 0.0) && (y == 0.0)) {
+ return 1;
+ }
+ diff = -atan2(y, x);
+ diff = diff*(180.0/PI) - start;
+ while (diff > 360.0) {
+ diff -= 360.0;
+ }
+ while (diff < 0.0) {
+ diff += 360.0;
+ }
+ if (extent >= 0) {
+ return diff <= extent;
+ }
+ return (diff-360.0) >= extent;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * ArcToPostscript --
+ *
+ * This function is called to generate Postscript for arc items.
+ *
+ * Results:
+ * The return value is a standard Tcl result. If an error occurs in
+ * generating Postscript then an error message is left in the interp's
+ * result, replacing whatever used to be there. If no error occurs, then
+ * Postscript for the item is appended to the result.
+ *
+ * Side effects:
+ * None.
+ *
+ *--------------------------------------------------------------
+ */
+
+static int
+ArcToPostscript(
+ Tcl_Interp *interp, /* Leave Postscript or error message here. */
+ Tk_Canvas canvas, /* Information about overall canvas. */
+ Tk_Item *itemPtr, /* Item for which Postscript is wanted. */
+ int prepass) /* 1 means this is a prepass to collect font
+ * information; 0 means final Postscript is
+ * being created. */
+{
+ ArcItem *arcPtr = (ArcItem *) itemPtr;
+ double y1, y2, ang1, ang2;
+ XColor *color;
+ Pixmap stipple;
+ XColor *fillColor;
+ Pixmap fillStipple;
+ Tk_State state = itemPtr->state;
+ Tcl_Obj *psObj;
+ Tcl_InterpState interpState;
+
+ y1 = Tk_CanvasPsY(canvas, arcPtr->bbox[1]);
+ y2 = Tk_CanvasPsY(canvas, arcPtr->bbox[3]);
+ ang1 = arcPtr->start;
+ ang2 = ang1 + arcPtr->extent;
+ if (ang2 < ang1) {
+ ang1 = ang2;
+ ang2 = arcPtr->start;
+ }
+
+ if (state == TK_STATE_NULL) {
+ state = Canvas(canvas)->canvas_state;
+ }
+ color = arcPtr->outline.color;
+ stipple = arcPtr->outline.stipple;
+ fillColor = arcPtr->fillColor;
+ fillStipple = arcPtr->fillStipple;
+ if (Canvas(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;
+ }
+ }
+
+ /*
+ * Make our working space.
+ */
+
+ psObj = Tcl_NewObj();
+ interpState = Tcl_SaveInterpState(interp, TCL_OK);
+
+ /*
+ * If the arc is filled, output Postscript for the interior region of the
+ * arc.
+ */
+
+ if (arcPtr->fillGC != None) {
+ Tcl_AppendPrintfToObj(psObj,
+ "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);
+
+ if (arcPtr->style != CHORD_STYLE) {
+ Tcl_AppendToObj(psObj, "0 0 moveto ", -1);
+ }
+ Tcl_AppendPrintfToObj(psObj,
+ "0 0 1 %.15g %.15g arc closepath\nsetmatrix\n",
+ ang1, ang2);
+
+ Tcl_ResetResult(interp);
+ if (Tk_CanvasPsColor(interp, canvas, fillColor) != TCL_OK) {
+ goto error;
+ }
+ Tcl_AppendObjToObj(psObj, Tcl_GetObjResult(interp));
+
+ if (fillStipple != None) {
+ Tcl_AppendToObj(psObj, "clip ", -1);
+
+ Tcl_ResetResult(interp);
+ if (Tk_CanvasPsStipple(interp, canvas, fillStipple) != TCL_OK) {
+ goto error;
+ }
+ Tcl_AppendObjToObj(psObj, Tcl_GetObjResult(interp));
+
+ if (arcPtr->outline.gc != None) {
+ Tcl_AppendToObj(psObj, "grestore gsave\n", -1);
+ }
+ } else {
+ Tcl_AppendToObj(psObj, "fill\n", -1);
+ }
+ }
+
+ /*
+ * If there's an outline for the arc, draw it.
+ */
+
+ if (arcPtr->outline.gc != None) {
+ Tcl_AppendPrintfToObj(psObj,
+ "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_AppendPrintfToObj(psObj,
+ "0 0 1 %.15g %.15g arc\nsetmatrix\n0 setlinecap\n",
+ ang1, ang2);
+
+ Tcl_ResetResult(interp);
+ if (Tk_CanvasPsOutline(canvas, itemPtr, &arcPtr->outline) != TCL_OK) {
+ goto error;
+ }
+ Tcl_AppendObjToObj(psObj, Tcl_GetObjResult(interp));
+
+ if (arcPtr->style != ARC_STYLE) {
+ Tcl_AppendToObj(psObj, "grestore gsave\n", -1);
+
+ Tcl_ResetResult(interp);
+ if (arcPtr->style == CHORD_STYLE) {
+ Tk_CanvasPsPath(interp, canvas, arcPtr->outlinePtr,
+ CHORD_OUTLINE_PTS);
+ } else {
+ Tk_CanvasPsPath(interp, canvas, arcPtr->outlinePtr,
+ PIE_OUTLINE1_PTS);
+ if (Tk_CanvasPsColor(interp, canvas, color) != TCL_OK) {
+ goto error;
+ }
+ Tcl_AppendObjToObj(psObj, Tcl_GetObjResult(interp));
+
+ if (stipple != None) {
+ Tcl_AppendToObj(psObj, "clip ", -1);
+
+ Tcl_ResetResult(interp);
+ if (Tk_CanvasPsStipple(interp, canvas, stipple) !=TCL_OK){
+ goto error;
+ }
+ Tcl_AppendObjToObj(psObj, Tcl_GetObjResult(interp));
+ } else {
+ Tcl_AppendToObj(psObj, "fill\n", -1);
+ }
+ Tcl_AppendToObj(psObj, "grestore gsave\n", -1);
+
+ Tcl_ResetResult(interp);
+ Tk_CanvasPsPath(interp, canvas,
+ arcPtr->outlinePtr + 2*PIE_OUTLINE1_PTS,
+ PIE_OUTLINE2_PTS);
+ }
+ if (Tk_CanvasPsColor(interp, canvas, color) != TCL_OK) {
+ goto error;
+ }
+ Tcl_AppendObjToObj(psObj, Tcl_GetObjResult(interp));
+
+ if (stipple != None) {
+ Tcl_AppendToObj(psObj, "clip ", -1);
+
+ Tcl_ResetResult(interp);
+ if (Tk_CanvasPsStipple(interp, canvas, stipple) != TCL_OK) {
+ goto error;
+ }
+ Tcl_AppendObjToObj(psObj, Tcl_GetObjResult(interp));
+ } else {
+ Tcl_AppendToObj(psObj, "fill\n", -1);
+ }
+ }
+ }
+
+ /*
+ * Plug the accumulated postscript back into the result.
+ */
+
+ (void) Tcl_RestoreInterpState(interp, interpState);
+ Tcl_AppendObjToObj(Tcl_GetObjResult(interp), psObj);
+ Tcl_DecrRefCount(psObj);
+ return TCL_OK;
+
+ error:
+ Tcl_DiscardInterpState(interpState);
+ Tcl_DecrRefCount(psObj);
+ return TCL_ERROR;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * StyleParseProc --
+ *
+ * This function 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 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_SetObjResult(interp, Tcl_ObjPrintf(
+ "bad -style option \"%s\": must be arc, chord, or pieslice",
+ value));
+ Tcl_SetErrorCode(interp, "TK", "CANVAS", "ARC_STYLE", NULL);
+ *stylePtr = PIESLICE_STYLE;
+ return TCL_ERROR;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * StylePrintProc --
+ *
+ * This function 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 function 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 const char *
+StylePrintProc(
+ 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";
+ }
+}
+
+/*
+ * Local Variables:
+ * mode: c
+ * c-basic-offset: 4
+ * fill-column: 78
+ * End:
+ */
diff --git a/tk8.6/generic/tkCanvBmap.c b/tk8.6/generic/tkCanvBmap.c
new file mode 100644
index 0000000..d7d54f4
--- /dev/null
+++ b/tk8.6/generic/tkCanvBmap.c
@@ -0,0 +1,1010 @@
+/*
+ * tkCanvBmap.c --
+ *
+ * This file implements bitmap items for canvas widgets.
+ *
+ * Copyright (c) 1992-1994 The Regents of the University of California.
+ * Copyright (c) 1994-1997 Sun Microsystems, Inc.
+ *
+ * See the file "license.terms" for information on usage and redistribution of
+ * this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ */
+
+#include "tkInt.h"
+#include "tkCanvas.h"
+
+/*
+ * The structure below defines the record for each bitmap item.
+ */
+
+typedef struct BitmapItem {
+ Tk_Item header; /* Generic stuff that's the same for all
+ * types. MUST BE FIRST IN STRUCTURE. */
+ double x, y; /* Coordinates of positioning point for
+ * bitmap. */
+ Tk_Anchor anchor; /* Where to anchor bitmap relative to (x,y) */
+ Pixmap bitmap; /* Bitmap to display in window. */
+ Pixmap activeBitmap; /* Bitmap to display in window. */
+ Pixmap disabledBitmap; /* Bitmap to display in window. */
+ XColor *fgColor; /* Foreground color to use for bitmap. */
+ XColor *activeFgColor; /* Foreground color to use for bitmap. */
+ XColor *disabledFgColor; /* Foreground color to use for bitmap. */
+ XColor *bgColor; /* Background color to use for bitmap. */
+ XColor *activeBgColor; /* Background color to use for bitmap. */
+ XColor *disabledBgColor; /* Background color to use for bitmap. */
+ GC gc; /* Graphics context to use for drawing bitmap
+ * on screen. */
+} BitmapItem;
+
+/*
+ * Information used for parsing configuration specs:
+ */
+
+static const Tk_CustomOption stateOption = {
+ TkStateParseProc, TkStatePrintProc, INT2PTR(2)
+};
+static const Tk_CustomOption tagsOption = {
+ Tk_CanvasTagsParseProc, Tk_CanvasTagsPrintProc, NULL
+};
+
+static const Tk_ConfigSpec configSpecs[] = {
+ {TK_CONFIG_COLOR, "-activebackground", NULL, NULL,
+ NULL, Tk_Offset(BitmapItem, activeBgColor), TK_CONFIG_NULL_OK, NULL},
+ {TK_CONFIG_BITMAP, "-activebitmap", NULL, NULL,
+ NULL, Tk_Offset(BitmapItem, activeBitmap), TK_CONFIG_NULL_OK, NULL},
+ {TK_CONFIG_COLOR, "-activeforeground", NULL, NULL,
+ NULL, Tk_Offset(BitmapItem, activeFgColor), TK_CONFIG_NULL_OK, NULL},
+ {TK_CONFIG_ANCHOR, "-anchor", NULL, NULL,
+ "center", Tk_Offset(BitmapItem, anchor), TK_CONFIG_DONT_SET_DEFAULT, NULL},
+ {TK_CONFIG_COLOR, "-background", NULL, NULL,
+ NULL, Tk_Offset(BitmapItem, bgColor), TK_CONFIG_NULL_OK, NULL},
+ {TK_CONFIG_BITMAP, "-bitmap", NULL, NULL,
+ NULL, Tk_Offset(BitmapItem, bitmap), TK_CONFIG_NULL_OK, NULL},
+ {TK_CONFIG_COLOR, "-disabledbackground", NULL, NULL,
+ NULL, Tk_Offset(BitmapItem, disabledBgColor),
+ TK_CONFIG_NULL_OK, NULL},
+ {TK_CONFIG_BITMAP, "-disabledbitmap", NULL, NULL,
+ NULL, Tk_Offset(BitmapItem, disabledBitmap),
+ TK_CONFIG_NULL_OK, NULL},
+ {TK_CONFIG_COLOR, "-disabledforeground", NULL, NULL,
+ NULL, Tk_Offset(BitmapItem, disabledFgColor),
+ TK_CONFIG_NULL_OK, NULL},
+ {TK_CONFIG_COLOR, "-foreground", NULL, NULL,
+ "black", Tk_Offset(BitmapItem, fgColor), 0, NULL},
+ {TK_CONFIG_CUSTOM, "-state", NULL, NULL,
+ NULL, Tk_Offset(Tk_Item, state), TK_CONFIG_NULL_OK,
+ &stateOption},
+ {TK_CONFIG_CUSTOM, "-tags", NULL, NULL,
+ NULL, 0, TK_CONFIG_NULL_OK, &tagsOption},
+ {TK_CONFIG_END, NULL, NULL, NULL, NULL, 0, 0, NULL}
+};
+
+/*
+ * Prototypes for functions defined in this file:
+ */
+
+static int BitmapCoords(Tcl_Interp *interp,
+ Tk_Canvas canvas, Tk_Item *itemPtr, int objc,
+ Tcl_Obj *const objv[]);
+static int BitmapToArea(Tk_Canvas canvas,
+ Tk_Item *itemPtr, double *rectPtr);
+static double BitmapToPoint(Tk_Canvas canvas,
+ Tk_Item *itemPtr, double *coordPtr);
+static int BitmapToPostscript(Tcl_Interp *interp,
+ Tk_Canvas canvas, Tk_Item *itemPtr, int prepass);
+static void ComputeBitmapBbox(Tk_Canvas canvas,
+ BitmapItem *bmapPtr);
+static int ConfigureBitmap(Tcl_Interp *interp,
+ Tk_Canvas canvas, Tk_Item *itemPtr, int objc,
+ Tcl_Obj *const objv[], int flags);
+static int TkcCreateBitmap(Tcl_Interp *interp,
+ Tk_Canvas canvas, struct Tk_Item *itemPtr,
+ int objc, Tcl_Obj *const objv[]);
+static void DeleteBitmap(Tk_Canvas canvas,
+ Tk_Item *itemPtr, Display *display);
+static void DisplayBitmap(Tk_Canvas canvas,
+ Tk_Item *itemPtr, Display *display, Drawable dst,
+ int x, int y, int width, int height);
+static void ScaleBitmap(Tk_Canvas canvas,
+ Tk_Item *itemPtr, double originX, double originY,
+ double scaleX, double scaleY);
+static void TranslateBitmap(Tk_Canvas canvas, Tk_Item *itemPtr,
+ double deltaX, double deltaY);
+
+/*
+ * The structures below defines the bitmap item type in terms of functions
+ * that can be invoked by generic item code.
+ */
+
+Tk_ItemType tkBitmapType = {
+ "bitmap", /* name */
+ sizeof(BitmapItem), /* itemSize */
+ TkcCreateBitmap, /* createProc */
+ configSpecs, /* configSpecs */
+ ConfigureBitmap, /* configureProc */
+ BitmapCoords, /* coordProc */
+ DeleteBitmap, /* deleteProc */
+ DisplayBitmap, /* displayProc */
+ TK_CONFIG_OBJS, /* flags */
+ BitmapToPoint, /* pointProc */
+ BitmapToArea, /* areaProc */
+ BitmapToPostscript, /* postscriptProc */
+ ScaleBitmap, /* scaleProc */
+ TranslateBitmap, /* translateProc */
+ NULL, /* indexProc */
+ NULL, /* icursorProc */
+ NULL, /* selectionProc */
+ NULL, /* insertProc */
+ NULL, /* dTextProc */
+ NULL, /* nextPtr */
+ NULL, 0, NULL, NULL
+};
+
+/*
+ *--------------------------------------------------------------
+ *
+ * TkcCreateBitmap --
+ *
+ * This function is invoked to create a new bitmap item in a canvas.
+ *
+ * Results:
+ * A standard Tcl return value. If an error occurred in creating the
+ * item, then an error message is left in the interp's result; in this
+ * case itemPtr is left uninitialized, so it can be safely freed by the
+ * caller.
+ *
+ * Side effects:
+ * A new bitmap item is created.
+ *
+ *--------------------------------------------------------------
+ */
+
+static int
+TkcCreateBitmap(
+ Tcl_Interp *interp, /* Interpreter for error reporting. */
+ Tk_Canvas canvas, /* Canvas to hold new item. */
+ Tk_Item *itemPtr, /* Record to hold new item; header has been
+ * initialized by caller. */
+ int objc, /* Number of arguments in objv. */
+ Tcl_Obj *const objv[]) /* Arguments describing rectangle. */
+{
+ BitmapItem *bmapPtr = (BitmapItem *) itemPtr;
+ int i;
+
+ if (objc == 0) {
+ Tcl_Panic("canvas did not pass any coords");
+ }
+
+ /*
+ * Initialize item's record.
+ */
+
+ bmapPtr->anchor = TK_ANCHOR_CENTER;
+ bmapPtr->bitmap = None;
+ bmapPtr->activeBitmap = None;
+ bmapPtr->disabledBitmap = None;
+ bmapPtr->fgColor = NULL;
+ bmapPtr->activeFgColor = NULL;
+ bmapPtr->disabledFgColor = NULL;
+ bmapPtr->bgColor = NULL;
+ bmapPtr->activeBgColor = NULL;
+ bmapPtr->disabledBgColor = NULL;
+ bmapPtr->gc = None;
+
+ /*
+ * Process the arguments to fill in the item record. Only 1 (list) or 2 (x
+ * y) coords are allowed.
+ */
+
+ if (objc == 1) {
+ i = 1;
+ } else {
+ const char *arg = Tcl_GetString(objv[1]);
+ i = 2;
+ if ((arg[0] == '-') && (arg[1] >= 'a') && (arg[1] <= 'z')) {
+ i = 1;
+ }
+ }
+ if (BitmapCoords(interp, canvas, itemPtr, i, objv) != TCL_OK) {
+ goto error;
+ }
+ if (ConfigureBitmap(interp, canvas, itemPtr, objc-i, objv+i, 0)
+ == TCL_OK) {
+ return TCL_OK;
+ }
+
+ error:
+ DeleteBitmap(canvas, itemPtr, Tk_Display(Tk_CanvasTkwin(canvas)));
+ return TCL_ERROR;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * BitmapCoords --
+ *
+ * This function is invoked to process the "coords" widget command on
+ * bitmap items. See the user documentation for details on what it does.
+ *
+ * Results:
+ * Returns TCL_OK or TCL_ERROR, and sets the interp's result.
+ *
+ * Side effects:
+ * The coordinates for the given item may be changed.
+ *
+ *--------------------------------------------------------------
+ */
+
+static int
+BitmapCoords(
+ Tcl_Interp *interp, /* Used for error reporting. */
+ Tk_Canvas canvas, /* Canvas containing item. */
+ Tk_Item *itemPtr, /* Item whose coordinates are to be read or
+ * modified. */
+ int objc, /* Number of coordinates supplied in objv. */
+ Tcl_Obj *const objv[]) /* Array of coordinates: x1, y1, x2, y2, ... */
+{
+ BitmapItem *bmapPtr = (BitmapItem *) itemPtr;
+
+ if (objc == 0) {
+ Tcl_Obj *obj = Tcl_NewObj();
+
+ Tcl_ListObjAppendElement(NULL, obj, Tcl_NewDoubleObj(bmapPtr->x));
+ Tcl_ListObjAppendElement(NULL, obj, Tcl_NewDoubleObj(bmapPtr->y));
+ Tcl_SetObjResult(interp, obj);
+ } else if (objc < 3) {
+ if (objc == 1) {
+ if (Tcl_ListObjGetElements(interp, objv[0], &objc,
+ (Tcl_Obj ***) &objv) != TCL_OK) {
+ return TCL_ERROR;
+ } else if (objc != 2) {
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "wrong # coordinates: expected 2, got %d", objc));
+ Tcl_SetErrorCode(interp, "TK", "CANVAS", "COORDS", "BITMAP",
+ NULL);
+ return TCL_ERROR;
+ }
+ }
+ if ((Tk_CanvasGetCoordFromObj(interp, canvas, objv[0],
+ &bmapPtr->x) != TCL_OK)
+ || (Tk_CanvasGetCoordFromObj(interp, canvas, objv[1],
+ &bmapPtr->y) != TCL_OK)) {
+ return TCL_ERROR;
+ }
+ ComputeBitmapBbox(canvas, bmapPtr);
+ } else {
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "wrong # coordinates: expected 0 or 2, got %d", objc));
+ Tcl_SetErrorCode(interp, "TK", "CANVAS", "COORDS", "BITMAP", NULL);
+ return TCL_ERROR;
+ }
+ return TCL_OK;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * ConfigureBitmap --
+ *
+ * This function is invoked to configure various aspects of a bitmap
+ * item, such as its anchor position.
+ *
+ * Results:
+ * A standard Tcl result code. If an error occurs, then an error message
+ * is left in the interp's result.
+ *
+ * Side effects:
+ * Configuration information may be set for itemPtr.
+ *
+ *--------------------------------------------------------------
+ */
+
+static int
+ConfigureBitmap(
+ Tcl_Interp *interp, /* Used for error reporting. */
+ Tk_Canvas canvas, /* Canvas containing itemPtr. */
+ Tk_Item *itemPtr, /* Bitmap item to reconfigure. */
+ int objc, /* Number of elements in objv. */
+ Tcl_Obj *const objv[], /* Arguments describing things to configure. */
+ int flags) /* Flags to pass to Tk_ConfigureWidget. */
+{
+ BitmapItem *bmapPtr = (BitmapItem *) itemPtr;
+ XGCValues gcValues;
+ GC newGC;
+ Tk_Window tkwin;
+ unsigned long mask;
+ XColor *fgColor;
+ XColor *bgColor;
+ Pixmap bitmap;
+ Tk_State state;
+
+ tkwin = Tk_CanvasTkwin(canvas);
+ if (TCL_OK != Tk_ConfigureWidget(interp, tkwin, configSpecs, objc,
+ (const char **) objv, (char *) bmapPtr, flags|TK_CONFIG_OBJS)) {
+ return TCL_ERROR;
+ }
+
+ /*
+ * A few of the options require additional processing, such as those that
+ * determine the graphics context.
+ */
+
+ state = itemPtr->state;
+
+ if (bmapPtr->activeFgColor!=NULL ||
+ bmapPtr->activeBgColor!=NULL ||
+ bmapPtr->activeBitmap!=None) {
+ itemPtr->redraw_flags |= TK_ITEM_STATE_DEPENDANT;
+ } else {
+ itemPtr->redraw_flags &= ~TK_ITEM_STATE_DEPENDANT;
+ }
+
+ if (state == TK_STATE_NULL) {
+ state = Canvas(canvas)->canvas_state;
+ }
+ if (state == TK_STATE_HIDDEN) {
+ ComputeBitmapBbox(canvas, bmapPtr);
+ return TCL_OK;
+ }
+ fgColor = bmapPtr->fgColor;
+ bgColor = bmapPtr->bgColor;
+ bitmap = bmapPtr->bitmap;
+ if (Canvas(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) {
+ newGC = None;
+ } else {
+ gcValues.foreground = fgColor->pixel;
+ mask = GCForeground;
+ if (bgColor != NULL) {
+ gcValues.background = bgColor->pixel;
+ mask |= GCBackground;
+ } else {
+ gcValues.clip_mask = bitmap;
+ mask |= GCClipMask;
+ }
+ newGC = Tk_GetGC(tkwin, mask, &gcValues);
+ }
+ if (bmapPtr->gc != None) {
+ Tk_FreeGC(Tk_Display(tkwin), bmapPtr->gc);
+ }
+ bmapPtr->gc = newGC;
+
+ ComputeBitmapBbox(canvas, bmapPtr);
+ return TCL_OK;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * DeleteBitmap --
+ *
+ * This function is called to clean up the data structure associated with
+ * a bitmap item.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Resources associated with itemPtr are released.
+ *
+ *--------------------------------------------------------------
+ */
+
+static void
+DeleteBitmap(
+ Tk_Canvas canvas, /* Info about overall canvas widget. */
+ Tk_Item *itemPtr, /* Item that is being deleted. */
+ Display *display) /* Display containing window for canvas. */
+{
+ BitmapItem *bmapPtr = (BitmapItem *) itemPtr;
+
+ if (bmapPtr->bitmap != None) {
+ Tk_FreeBitmap(display, bmapPtr->bitmap);
+ }
+ if (bmapPtr->activeBitmap != None) {
+ Tk_FreeBitmap(display, bmapPtr->activeBitmap);
+ }
+ if (bmapPtr->disabledBitmap != None) {
+ Tk_FreeBitmap(display, bmapPtr->disabledBitmap);
+ }
+ if (bmapPtr->fgColor != NULL) {
+ Tk_FreeColor(bmapPtr->fgColor);
+ }
+ if (bmapPtr->activeFgColor != NULL) {
+ Tk_FreeColor(bmapPtr->activeFgColor);
+ }
+ if (bmapPtr->disabledFgColor != NULL) {
+ Tk_FreeColor(bmapPtr->disabledFgColor);
+ }
+ if (bmapPtr->bgColor != NULL) {
+ Tk_FreeColor(bmapPtr->bgColor);
+ }
+ if (bmapPtr->activeBgColor != NULL) {
+ Tk_FreeColor(bmapPtr->activeBgColor);
+ }
+ if (bmapPtr->disabledBgColor != NULL) {
+ Tk_FreeColor(bmapPtr->disabledBgColor);
+ }
+ if (bmapPtr->gc != NULL) {
+ Tk_FreeGC(display, bmapPtr->gc);
+ }
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * ComputeBitmapBbox --
+ *
+ * This function is invoked to compute the bounding box of all the pixels
+ * that may be drawn as part of a bitmap item. This function is where the
+ * child bitmap's placement is computed.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The fields x1, y1, x2, and y2 are updated in the header for itemPtr.
+ *
+ *--------------------------------------------------------------
+ */
+
+ /* ARGSUSED */
+static void
+ComputeBitmapBbox(
+ Tk_Canvas canvas, /* Canvas that contains item. */
+ BitmapItem *bmapPtr) /* Item whose bbox is to be recomputed. */
+{
+ int width, height;
+ int x, y;
+ Pixmap bitmap;
+ Tk_State state = bmapPtr->header.state;
+
+ if (state == TK_STATE_NULL) {
+ state = Canvas(canvas)->canvas_state;
+ }
+ bitmap = bmapPtr->bitmap;
+ if (Canvas(canvas)->currentItemPtr == (Tk_Item *)bmapPtr) {
+ if (bmapPtr->activeBitmap!=None) {
+ bitmap = bmapPtr->activeBitmap;
+ }
+ } else if (state==TK_STATE_DISABLED) {
+ if (bmapPtr->disabledBitmap!=None) {
+ bitmap = bmapPtr->disabledBitmap;
+ }
+ }
+
+ x = (int) (bmapPtr->x + ((bmapPtr->x >= 0) ? 0.5 : - 0.5));
+ y = (int) (bmapPtr->y + ((bmapPtr->y >= 0) ? 0.5 : - 0.5));
+
+ if (state==TK_STATE_HIDDEN || bitmap == None) {
+ bmapPtr->header.x1 = bmapPtr->header.x2 = x;
+ bmapPtr->header.y1 = bmapPtr->header.y2 = y;
+ return;
+ }
+
+ /*
+ * Compute location and size of bitmap, using anchor information.
+ */
+
+ Tk_SizeOfBitmap(Tk_Display(Tk_CanvasTkwin(canvas)), bitmap,
+ &width, &height);
+ switch (bmapPtr->anchor) {
+ case TK_ANCHOR_N:
+ x -= width/2;
+ break;
+ case TK_ANCHOR_NE:
+ x -= width;
+ break;
+ case TK_ANCHOR_E:
+ x -= width;
+ y -= height/2;
+ break;
+ case TK_ANCHOR_SE:
+ x -= width;
+ y -= height;
+ break;
+ case TK_ANCHOR_S:
+ x -= width/2;
+ y -= height;
+ break;
+ case TK_ANCHOR_SW:
+ y -= height;
+ break;
+ case TK_ANCHOR_W:
+ y -= height/2;
+ break;
+ case TK_ANCHOR_NW:
+ break;
+ case TK_ANCHOR_CENTER:
+ x -= width/2;
+ y -= height/2;
+ break;
+ }
+
+ /*
+ * Store the information in the item header.
+ */
+
+ bmapPtr->header.x1 = x;
+ bmapPtr->header.y1 = y;
+ bmapPtr->header.x2 = x + width;
+ bmapPtr->header.y2 = y + height;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * DisplayBitmap --
+ *
+ * This function is invoked to draw a bitmap item in a given drawable.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * ItemPtr is drawn in drawable using the transformation information in
+ * canvas.
+ *
+ *--------------------------------------------------------------
+ */
+
+static void
+DisplayBitmap(
+ 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, int y, int width, int height)
+ /* Describes region of canvas that must be
+ * redisplayed (not used). */
+{
+ BitmapItem *bmapPtr = (BitmapItem *) itemPtr;
+ int bmapX, bmapY, bmapWidth, bmapHeight;
+ short drawableX, drawableY;
+ Pixmap bitmap;
+ Tk_State state = itemPtr->state;
+
+ /*
+ * If the area being displayed doesn't cover the whole bitmap, then only
+ * redisplay the part of the bitmap that needs redisplay.
+ */
+
+ if (state == TK_STATE_NULL) {
+ state = Canvas(canvas)->canvas_state;
+ }
+ bitmap = bmapPtr->bitmap;
+ if (Canvas(canvas)->currentItemPtr == itemPtr) {
+ if (bmapPtr->activeBitmap!=None) {
+ bitmap = bmapPtr->activeBitmap;
+ }
+ } else if (state == TK_STATE_DISABLED) {
+ if (bmapPtr->disabledBitmap!=None) {
+ bitmap = bmapPtr->disabledBitmap;
+ }
+ }
+
+ if (bitmap != None) {
+ if (x > bmapPtr->header.x1) {
+ bmapX = x - bmapPtr->header.x1;
+ bmapWidth = bmapPtr->header.x2 - x;
+ } else {
+ bmapX = 0;
+ if ((x+width) < bmapPtr->header.x2) {
+ bmapWidth = x + width - bmapPtr->header.x1;
+ } else {
+ bmapWidth = bmapPtr->header.x2 - bmapPtr->header.x1;
+ }
+ }
+ if (y > bmapPtr->header.y1) {
+ bmapY = y - bmapPtr->header.y1;
+ bmapHeight = bmapPtr->header.y2 - y;
+ } else {
+ bmapY = 0;
+ if ((y+height) < bmapPtr->header.y2) {
+ bmapHeight = y + height - bmapPtr->header.y1;
+ } else {
+ bmapHeight = bmapPtr->header.y2 - bmapPtr->header.y1;
+ }
+ }
+ Tk_CanvasDrawableCoords(canvas,
+ (double) (bmapPtr->header.x1 + bmapX),
+ (double) (bmapPtr->header.y1 + bmapY),
+ &drawableX, &drawableY);
+
+ /*
+ * Must modify the mask origin within the graphics context to line up
+ * with the bitmap's origin (in order to make bitmaps with
+ * "-background {}" work right).
+ */
+
+ XSetClipOrigin(display, bmapPtr->gc, drawableX - bmapX,
+ drawableY - bmapY);
+ XCopyPlane(display, bitmap, drawable,
+ bmapPtr->gc, bmapX, bmapY, (unsigned int) bmapWidth,
+ (unsigned int) bmapHeight, drawableX, drawableY, 1);
+ XSetClipOrigin(display, bmapPtr->gc, 0, 0);
+ }
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * BitmapToPoint --
+ *
+ * Computes the distance from a given point to a given rectangle, in
+ * canvas units.
+ *
+ * Results:
+ * The return value is 0 if the point whose x and y coordinates are
+ * coordPtr[0] and coordPtr[1] is inside the bitmap. If the point isn't
+ * inside the bitmap then the return value is the distance from the point
+ * to the bitmap.
+ *
+ * Side effects:
+ * None.
+ *
+ *--------------------------------------------------------------
+ */
+
+ /* ARGSUSED */
+static double
+BitmapToPoint(
+ Tk_Canvas canvas, /* Canvas containing item. */
+ Tk_Item *itemPtr, /* Item to check against point. */
+ double *coordPtr) /* Pointer to x and y coordinates. */
+{
+ BitmapItem *bmapPtr = (BitmapItem *) itemPtr;
+ double x1, x2, y1, y2, xDiff, yDiff;
+
+ x1 = bmapPtr->header.x1;
+ y1 = bmapPtr->header.y1;
+ x2 = bmapPtr->header.x2;
+ y2 = bmapPtr->header.y2;
+
+ /*
+ * Point is outside rectangle.
+ */
+
+ if (coordPtr[0] < x1) {
+ xDiff = x1 - coordPtr[0];
+ } else if (coordPtr[0] > x2) {
+ xDiff = coordPtr[0] - x2;
+ } else {
+ xDiff = 0;
+ }
+
+ if (coordPtr[1] < y1) {
+ yDiff = y1 - coordPtr[1];
+ } else if (coordPtr[1] > y2) {
+ yDiff = coordPtr[1] - y2;
+ } else {
+ yDiff = 0;
+ }
+
+ return hypot(xDiff, yDiff);
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * BitmapToArea --
+ *
+ * This function is called to determine whether an item lies entirely
+ * inside, entirely outside, or overlapping a given rectangle.
+ *
+ * Results:
+ * -1 is returned if the item is entirely outside the area given by
+ * rectPtr, 0 if it overlaps, and 1 if it is entirely inside the given
+ * area.
+ *
+ * Side effects:
+ * None.
+ *
+ *--------------------------------------------------------------
+ */
+
+ /* ARGSUSED */
+static int
+BitmapToArea(
+ Tk_Canvas canvas, /* Canvas containing item. */
+ Tk_Item *itemPtr, /* Item to check against rectangle. */
+ double *rectPtr) /* Pointer to array of four coordinates
+ * (x1,y1,x2,y2) describing rectangular
+ * area. */
+{
+ BitmapItem *bmapPtr = (BitmapItem *) itemPtr;
+
+ if ((rectPtr[2] <= bmapPtr->header.x1)
+ || (rectPtr[0] >= bmapPtr->header.x2)
+ || (rectPtr[3] <= bmapPtr->header.y1)
+ || (rectPtr[1] >= bmapPtr->header.y2)) {
+ return -1;
+ }
+ if ((rectPtr[0] <= bmapPtr->header.x1)
+ && (rectPtr[1] <= bmapPtr->header.y1)
+ && (rectPtr[2] >= bmapPtr->header.x2)
+ && (rectPtr[3] >= bmapPtr->header.y2)) {
+ return 1;
+ }
+ return 0;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * ScaleBitmap --
+ *
+ * This function is invoked to rescale a bitmap item in a canvas. It is
+ * one of the standard item functions for bitmap items, and is invoked by
+ * the generic canvas code.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The item referred to by itemPtr is rescaled so that the following
+ * transformation is applied to all point coordinates:
+ * x' = originX + scaleX*(x-originX)
+ * y' = originY + scaleY*(y-originY)
+ *
+ *--------------------------------------------------------------
+ */
+
+static void
+ScaleBitmap(
+ Tk_Canvas canvas, /* Canvas containing rectangle. */
+ Tk_Item *itemPtr, /* Rectangle to be scaled. */
+ double originX, double originY,
+ /* Origin about which to scale item. */
+ double scaleX, /* Amount to scale in X direction. */
+ double scaleY) /* Amount to scale in Y direction. */
+{
+ BitmapItem *bmapPtr = (BitmapItem *) itemPtr;
+
+ bmapPtr->x = originX + scaleX*(bmapPtr->x - originX);
+ bmapPtr->y = originY + scaleY*(bmapPtr->y - originY);
+ ComputeBitmapBbox(canvas, bmapPtr);
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * TranslateBitmap --
+ *
+ * This function is called to move an item by a given amount.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The position of the item is offset by (xDelta, yDelta), and the
+ * bounding box is updated in the generic part of the item structure.
+ *
+ *--------------------------------------------------------------
+ */
+
+static void
+TranslateBitmap(
+ Tk_Canvas canvas, /* Canvas containing item. */
+ Tk_Item *itemPtr, /* Item that is being moved. */
+ double deltaX, double deltaY)
+ /* Amount by which item is to be moved. */
+{
+ BitmapItem *bmapPtr = (BitmapItem *) itemPtr;
+
+ bmapPtr->x += deltaX;
+ bmapPtr->y += deltaY;
+ ComputeBitmapBbox(canvas, bmapPtr);
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * BitmapToPostscript --
+ *
+ * This function is called to generate Postscript for bitmap items.
+ *
+ * Results:
+ * The return value is a standard Tcl result. If an error occurs in
+ * generating Postscript then an error message is left in the interp's
+ * result, replacing whatever used to be there. If no error occurs, then
+ * Postscript for the item is appended to the result.
+ *
+ * Side effects:
+ * None.
+ *
+ *--------------------------------------------------------------
+ */
+
+static int
+BitmapToPostscript(
+ Tcl_Interp *interp, /* Leave Postscript or error message here. */
+ Tk_Canvas canvas, /* Information about overall canvas. */
+ Tk_Item *itemPtr, /* Item for which Postscript is wanted. */
+ int prepass) /* 1 means this is a prepass to collect font
+ * information; 0 means final Postscript is
+ * being created. */
+{
+ BitmapItem *bmapPtr = (BitmapItem *) itemPtr;
+ double x, y;
+ int width, height, rowsAtOnce, rowsThisTime;
+ int curRow;
+ XColor *fgColor;
+ XColor *bgColor;
+ Pixmap bitmap;
+ Tk_State state = itemPtr->state;
+ Tcl_Obj *psObj;
+ Tcl_InterpState interpState;
+
+ if (state == TK_STATE_NULL) {
+ state = Canvas(canvas)->canvas_state;
+ }
+ fgColor = bmapPtr->fgColor;
+ bgColor = bmapPtr->bgColor;
+ bitmap = bmapPtr->bitmap;
+ if (Canvas(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) {
+ return TCL_OK;
+ }
+
+ /*
+ * Compute the coordinates of the lower-left corner of the bitmap, taking
+ * into account the anchor position for the bitmp.
+ */
+
+ x = bmapPtr->x;
+ y = Tk_CanvasPsY(canvas, bmapPtr->y);
+ Tk_SizeOfBitmap(Tk_Display(Tk_CanvasTkwin(canvas)), bitmap,
+ &width, &height);
+ switch (bmapPtr->anchor) {
+ case TK_ANCHOR_NW: y -= height; break;
+ case TK_ANCHOR_N: x -= width/2.0; y -= height; break;
+ case TK_ANCHOR_NE: x -= width; y -= height; break;
+ case TK_ANCHOR_E: x -= width; y -= height/2.0; break;
+ case TK_ANCHOR_SE: x -= width; break;
+ case TK_ANCHOR_S: x -= width/2.0; break;
+ case TK_ANCHOR_SW: break;
+ case TK_ANCHOR_W: y -= height/2.0; break;
+ case TK_ANCHOR_CENTER: x -= width/2.0; y -= height/2.0; break;
+ }
+
+ /*
+ * Make our working space.
+ */
+
+ psObj = Tcl_NewObj();
+ interpState = Tcl_SaveInterpState(interp, TCL_OK);
+
+ /*
+ * Color the background, if there is one.
+ */
+
+ if (bgColor != NULL) {
+ Tcl_AppendPrintfToObj(psObj,
+ "%.15g %.15g moveto %d 0 rlineto 0 %d rlineto "
+ "%d 0 rlineto closepath\n",
+ x, y, width, height, -width);
+
+ Tcl_ResetResult(interp);
+ if (Tk_CanvasPsColor(interp, canvas, bgColor) != TCL_OK) {
+ goto error;
+ }
+ Tcl_AppendObjToObj(psObj, Tcl_GetObjResult(interp));
+
+ Tcl_AppendToObj(psObj, "fill\n", -1);
+ }
+
+ /*
+ * 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 (fgColor != NULL) {
+ Tcl_ResetResult(interp);
+ if (Tk_CanvasPsColor(interp, canvas, fgColor) != TCL_OK) {
+ goto error;
+ }
+ Tcl_AppendObjToObj(psObj, Tcl_GetObjResult(interp));
+
+ if (width > 60000) {
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "can't generate Postscript for bitmaps more than 60000"
+ " pixels wide", -1));
+ Tcl_SetErrorCode(interp, "TK", "CANVAS", "PS", "MEMLIMIT", NULL);
+ goto error;
+ }
+
+ rowsAtOnce = 60000/width;
+ if (rowsAtOnce < 1) {
+ rowsAtOnce = 1;
+ }
+
+ Tcl_AppendPrintfToObj(psObj, "%.15g %.15g translate\n", x, y+height);
+
+ for (curRow = 0; curRow < height; curRow += rowsAtOnce) {
+ rowsThisTime = rowsAtOnce;
+ if (rowsThisTime > (height - curRow)) {
+ rowsThisTime = height - curRow;
+ }
+
+ Tcl_AppendPrintfToObj(psObj,
+ "0 -%.15g translate\n%d %d true matrix {\n",
+ (double) rowsThisTime, width, rowsThisTime);
+
+ Tcl_ResetResult(interp);
+ if (Tk_CanvasPsBitmap(interp, canvas, bitmap,
+ 0, curRow, width, rowsThisTime) != TCL_OK) {
+ goto error;
+ }
+ Tcl_AppendObjToObj(psObj, Tcl_GetObjResult(interp));
+
+ Tcl_AppendToObj(psObj, "\n} imagemask\n", -1);
+ }
+ }
+
+ /*
+ * Plug the accumulated postscript back into the result.
+ */
+
+ (void) Tcl_RestoreInterpState(interp, interpState);
+ Tcl_AppendObjToObj(Tcl_GetObjResult(interp), psObj);
+ Tcl_DecrRefCount(psObj);
+ return TCL_OK;
+
+ error:
+ Tcl_DiscardInterpState(interpState);
+ Tcl_DecrRefCount(psObj);
+ return TCL_ERROR;
+}
+
+/*
+ * Local Variables:
+ * mode: c
+ * c-basic-offset: 4
+ * fill-column: 78
+ * End:
+ */
diff --git a/tk8.6/generic/tkCanvImg.c b/tk8.6/generic/tkCanvImg.c
new file mode 100644
index 0000000..899741a
--- /dev/null
+++ b/tk8.6/generic/tkCanvImg.c
@@ -0,0 +1,883 @@
+/*
+ * tkCanvImg.c --
+ *
+ * This file implements image items for canvas widgets.
+ *
+ * Copyright (c) 1994 The Regents of the University of California.
+ * Copyright (c) 1994-1997 Sun Microsystems, Inc.
+ *
+ * See the file "license.terms" for information on usage and redistribution of
+ * this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ */
+
+#include "tkInt.h"
+#include "tkCanvas.h"
+
+/*
+ * The structure below defines the record for each image item.
+ */
+
+typedef struct ImageItem {
+ Tk_Item header; /* Generic stuff that's the same for all
+ * types. MUST BE FIRST IN STRUCTURE. */
+ Tk_Canvas canvas; /* Canvas containing the image. */
+ double x, y; /* Coordinates of positioning point for
+ * image. */
+ Tk_Anchor anchor; /* Where to anchor image relative to (x,y). */
+ char *imageString; /* String describing -image option
+ * (malloc-ed). NULL means no image right
+ * now. */
+ char *activeImageString; /* String describing -activeimage option.
+ * NULL means no image right now. */
+ char *disabledImageString; /* String describing -disabledimage option.
+ * NULL means no image right now. */
+ Tk_Image image; /* Image to display in window, or NULL if no
+ * image at present. */
+ Tk_Image activeImage; /* Image to display in window, or NULL if no
+ * image at present. */
+ Tk_Image disabledImage; /* Image to display in window, or NULL if no
+ * image at present. */
+} ImageItem;
+
+/*
+ * Information used for parsing configuration specs:
+ */
+
+static const Tk_CustomOption stateOption = {
+ TkStateParseProc, TkStatePrintProc, INT2PTR(2)
+};
+static const Tk_CustomOption tagsOption = {
+ Tk_CanvasTagsParseProc, Tk_CanvasTagsPrintProc, NULL
+};
+
+static const Tk_ConfigSpec configSpecs[] = {
+ {TK_CONFIG_STRING, "-activeimage", NULL, NULL,
+ NULL, Tk_Offset(ImageItem, activeImageString), TK_CONFIG_NULL_OK, NULL},
+ {TK_CONFIG_ANCHOR, "-anchor", NULL, NULL,
+ "center", Tk_Offset(ImageItem, anchor), TK_CONFIG_DONT_SET_DEFAULT, NULL},
+ {TK_CONFIG_STRING, "-disabledimage", NULL, NULL,
+ NULL, Tk_Offset(ImageItem, disabledImageString), TK_CONFIG_NULL_OK, NULL},
+ {TK_CONFIG_STRING, "-image", NULL, NULL,
+ NULL, Tk_Offset(ImageItem, imageString), TK_CONFIG_NULL_OK, NULL},
+ {TK_CONFIG_CUSTOM, "-state", NULL, NULL,
+ NULL, Tk_Offset(Tk_Item, state), TK_CONFIG_NULL_OK, &stateOption},
+ {TK_CONFIG_CUSTOM, "-tags", NULL, NULL,
+ NULL, 0, TK_CONFIG_NULL_OK, &tagsOption},
+ {TK_CONFIG_END, NULL, NULL, NULL, NULL, 0, 0, NULL}
+};
+
+/*
+ * Prototypes for functions defined in this file:
+ */
+
+static void ImageChangedProc(ClientData clientData,
+ int x, int y, int width, int height, int imgWidth,
+ int imgHeight);
+static int ImageCoords(Tcl_Interp *interp,
+ Tk_Canvas canvas, Tk_Item *itemPtr, int argc,
+ Tcl_Obj *const argv[]);
+static int ImageToArea(Tk_Canvas canvas,
+ Tk_Item *itemPtr, double *rectPtr);
+static double ImageToPoint(Tk_Canvas canvas,
+ Tk_Item *itemPtr, double *coordPtr);
+static int ImageToPostscript(Tcl_Interp *interp,
+ Tk_Canvas canvas, Tk_Item *itemPtr, int prepass);
+static void ComputeImageBbox(Tk_Canvas canvas, ImageItem *imgPtr);
+static int ConfigureImage(Tcl_Interp *interp,
+ Tk_Canvas canvas, Tk_Item *itemPtr, int argc,
+ Tcl_Obj *const argv[], int flags);
+static int CreateImage(Tcl_Interp *interp,
+ Tk_Canvas canvas, struct Tk_Item *itemPtr,
+ int argc, Tcl_Obj *const argv[]);
+static void DeleteImage(Tk_Canvas canvas,
+ Tk_Item *itemPtr, Display *display);
+static void DisplayImage(Tk_Canvas canvas,
+ Tk_Item *itemPtr, Display *display, Drawable dst,
+ int x, int y, int width, int height);
+static void ScaleImage(Tk_Canvas canvas,
+ Tk_Item *itemPtr, double originX, double originY,
+ double scaleX, double scaleY);
+static void TranslateImage(Tk_Canvas canvas,
+ Tk_Item *itemPtr, double deltaX, double deltaY);
+
+/*
+ * The structures below defines the image item type in terms of functions that
+ * can be invoked by generic item code.
+ */
+
+Tk_ItemType tkImageType = {
+ "image", /* name */
+ sizeof(ImageItem), /* itemSize */
+ CreateImage, /* createProc */
+ configSpecs, /* configSpecs */
+ ConfigureImage, /* configureProc */
+ ImageCoords, /* coordProc */
+ DeleteImage, /* deleteProc */
+ DisplayImage, /* displayProc */
+ TK_CONFIG_OBJS, /* flags */
+ ImageToPoint, /* pointProc */
+ ImageToArea, /* areaProc */
+ ImageToPostscript, /* postscriptProc */
+ ScaleImage, /* scaleProc */
+ TranslateImage, /* translateProc */
+ NULL, /* indexProc */
+ NULL, /* icursorProc */
+ NULL, /* selectionProc */
+ NULL, /* insertProc */
+ NULL, /* dTextProc */
+ NULL, /* nextPtr */
+ NULL, 0, NULL, NULL
+};
+
+/*
+ *--------------------------------------------------------------
+ *
+ * CreateImage --
+ *
+ * This function is invoked to create a new image item in a canvas.
+ *
+ * Results:
+ * A standard Tcl return value. If an error occurred in creating the
+ * item, then an error message is left in the interp's result; in this
+ * case itemPtr is left uninitialized, so it can be safely freed by the
+ * caller.
+ *
+ * Side effects:
+ * A new image item is created.
+ *
+ *--------------------------------------------------------------
+ */
+
+static int
+CreateImage(
+ Tcl_Interp *interp, /* Interpreter for error reporting. */
+ Tk_Canvas canvas, /* Canvas to hold new item. */
+ Tk_Item *itemPtr, /* Record to hold new item; header has been
+ * initialized by caller. */
+ int objc, /* Number of arguments in objv. */
+ Tcl_Obj *const objv[]) /* Arguments describing rectangle. */
+{
+ ImageItem *imgPtr = (ImageItem *) itemPtr;
+ int i;
+
+ if (objc == 0) {
+ Tcl_Panic("canvas did not pass any coords");
+ }
+
+ /*
+ * Initialize item's record.
+ */
+
+ imgPtr->canvas = canvas;
+ imgPtr->anchor = TK_ANCHOR_CENTER;
+ imgPtr->imageString = NULL;
+ imgPtr->activeImageString = NULL;
+ imgPtr->disabledImageString = NULL;
+ imgPtr->image = NULL;
+ imgPtr->activeImage = NULL;
+ imgPtr->disabledImage = NULL;
+
+ /*
+ * Process the arguments to fill in the item record. Only 1 (list) or 2 (x
+ * y) coords are allowed.
+ */
+
+ if (objc == 1) {
+ i = 1;
+ } else {
+ const char *arg = Tcl_GetString(objv[1]);
+ i = 2;
+ if ((arg[0] == '-') && (arg[1] >= 'a') && (arg[1] <= 'z')) {
+ i = 1;
+ }
+ }
+ if ((ImageCoords(interp, canvas, itemPtr, i, objv) != TCL_OK)) {
+ goto error;
+ }
+ if (ConfigureImage(interp, canvas, itemPtr, objc-i, objv+i, 0) == TCL_OK) {
+ return TCL_OK;
+ }
+
+ error:
+ DeleteImage(canvas, itemPtr, Tk_Display(Tk_CanvasTkwin(canvas)));
+ return TCL_ERROR;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * ImageCoords --
+ *
+ * This function is invoked to process the "coords" widget command on
+ * image items. See the user documentation for details on what it does.
+ *
+ * Results:
+ * Returns TCL_OK or TCL_ERROR, and sets the interp's result.
+ *
+ * Side effects:
+ * The coordinates for the given item may be changed.
+ *
+ *--------------------------------------------------------------
+ */
+
+static int
+ImageCoords(
+ Tcl_Interp *interp, /* Used for error reporting. */
+ Tk_Canvas canvas, /* Canvas containing item. */
+ Tk_Item *itemPtr, /* Item whose coordinates are to be read or
+ * modified. */
+ int objc, /* Number of coordinates supplied in objv. */
+ Tcl_Obj *const objv[]) /* Array of coordinates: x1, y1, x2, y2, ... */
+{
+ ImageItem *imgPtr = (ImageItem *) itemPtr;
+
+ if (objc == 0) {
+ Tcl_Obj *objs[2];
+
+ objs[0] = Tcl_NewDoubleObj(imgPtr->x);
+ objs[1] = Tcl_NewDoubleObj(imgPtr->y);
+ Tcl_SetObjResult(interp, Tcl_NewListObj(2, objs));
+ } else if (objc < 3) {
+ if (objc==1) {
+ if (Tcl_ListObjGetElements(interp, objv[0], &objc,
+ (Tcl_Obj ***) &objv) != TCL_OK) {
+ return TCL_ERROR;
+ } else if (objc != 2) {
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "wrong # coordinates: expected 2, got %d", objc));
+ Tcl_SetErrorCode(interp, "TK", "CANVAS", "COORDS", "IMAGE",
+ NULL);
+ return TCL_ERROR;
+ }
+ }
+ if ((Tk_CanvasGetCoordFromObj(interp, canvas, objv[0],
+ &imgPtr->x) != TCL_OK)
+ || (Tk_CanvasGetCoordFromObj(interp, canvas, objv[1],
+ &imgPtr->y) != TCL_OK)) {
+ return TCL_ERROR;
+ }
+ ComputeImageBbox(canvas, imgPtr);
+ } else {
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "wrong # coordinates: expected 0 or 2, got %d", objc));
+ Tcl_SetErrorCode(interp, "TK", "CANVAS", "COORDS", "IMAGE", NULL);
+ return TCL_ERROR;
+ }
+ return TCL_OK;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * ConfigureImage --
+ *
+ * This function is invoked to configure various aspects of an image
+ * item, such as its anchor position.
+ *
+ * Results:
+ * A standard Tcl result code. If an error occurs, then an error message
+ * is left in the interp's result.
+ *
+ * Side effects:
+ * Configuration information may be set for itemPtr.
+ *
+ *--------------------------------------------------------------
+ */
+
+static int
+ConfigureImage(
+ Tcl_Interp *interp, /* Used for error reporting. */
+ Tk_Canvas canvas, /* Canvas containing itemPtr. */
+ Tk_Item *itemPtr, /* Image item to reconfigure. */
+ int objc, /* Number of elements in objv. */
+ Tcl_Obj *const objv[], /* Arguments describing things to configure. */
+ int flags) /* Flags to pass to Tk_ConfigureWidget. */
+{
+ ImageItem *imgPtr = (ImageItem *) itemPtr;
+ Tk_Window tkwin;
+ Tk_Image image;
+
+ tkwin = Tk_CanvasTkwin(canvas);
+ if (TCL_OK != Tk_ConfigureWidget(interp, tkwin, configSpecs, objc,
+ (const char **) objv, (char *) imgPtr, flags|TK_CONFIG_OBJS)) {
+ return TCL_ERROR;
+ }
+
+ /*
+ * Create the image. Save the old image around and don't free it until
+ * after the new one is allocated. This keeps the reference count from
+ * going to zero so the image doesn't have to be recreated if it hasn't
+ * changed.
+ */
+
+ if (imgPtr->activeImageString != NULL) {
+ itemPtr->redraw_flags |= TK_ITEM_STATE_DEPENDANT;
+ } else {
+ itemPtr->redraw_flags &= ~TK_ITEM_STATE_DEPENDANT;
+ }
+ if (imgPtr->imageString != NULL) {
+ image = Tk_GetImage(interp, tkwin, imgPtr->imageString,
+ ImageChangedProc, imgPtr);
+ if (image == NULL) {
+ return TCL_ERROR;
+ }
+ } else {
+ image = NULL;
+ }
+ if (imgPtr->image != NULL) {
+ Tk_FreeImage(imgPtr->image);
+ }
+ imgPtr->image = image;
+ if (imgPtr->activeImageString != NULL) {
+ image = Tk_GetImage(interp, tkwin, imgPtr->activeImageString,
+ ImageChangedProc, 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, imgPtr);
+ if (image == NULL) {
+ return TCL_ERROR;
+ }
+ } else {
+ image = NULL;
+ }
+ if (imgPtr->disabledImage != NULL) {
+ Tk_FreeImage(imgPtr->disabledImage);
+ }
+ imgPtr->disabledImage = image;
+ ComputeImageBbox(canvas, imgPtr);
+ return TCL_OK;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * DeleteImage --
+ *
+ * This function is called to clean up the data structure associated with
+ * a image item.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Resources associated with itemPtr are released.
+ *
+ *--------------------------------------------------------------
+ */
+
+static void
+DeleteImage(
+ Tk_Canvas canvas, /* Info about overall canvas widget. */
+ Tk_Item *itemPtr, /* Item that is being deleted. */
+ Display *display) /* Display containing window for canvas. */
+{
+ ImageItem *imgPtr = (ImageItem *) itemPtr;
+
+ if (imgPtr->imageString != NULL) {
+ ckfree(imgPtr->imageString);
+ }
+ if (imgPtr->activeImageString != NULL) {
+ ckfree(imgPtr->activeImageString);
+ }
+ if (imgPtr->disabledImageString != NULL) {
+ ckfree(imgPtr->disabledImageString);
+ }
+ if (imgPtr->image != NULL) {
+ Tk_FreeImage(imgPtr->image);
+ }
+ if (imgPtr->activeImage != NULL) {
+ Tk_FreeImage(imgPtr->activeImage);
+ }
+ if (imgPtr->disabledImage != NULL) {
+ Tk_FreeImage(imgPtr->disabledImage);
+ }
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * ComputeImageBbox --
+ *
+ * This function is invoked to compute the bounding box of all the pixels
+ * that may be drawn as part of a image item. This function is where the
+ * child image's placement is computed.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The fields x1, y1, x2, and y2 are updated in the header for itemPtr.
+ *
+ *--------------------------------------------------------------
+ */
+
+ /* ARGSUSED */
+static void
+ComputeImageBbox(
+ Tk_Canvas canvas, /* Canvas that contains item. */
+ ImageItem *imgPtr) /* Item whose bbox is to be recomputed. */
+{
+ int width, height;
+ int x, y;
+ Tk_Image image;
+ Tk_State state = imgPtr->header.state;
+
+ if(state == TK_STATE_NULL) {
+ state = Canvas(canvas)->canvas_state;
+ }
+ image = imgPtr->image;
+ if (Canvas(canvas)->currentItemPtr == (Tk_Item *)imgPtr) {
+ if (imgPtr->activeImage != NULL) {
+ image = imgPtr->activeImage;
+ }
+ } else if (state == TK_STATE_DISABLED) {
+ if (imgPtr->disabledImage != NULL) {
+ image = imgPtr->disabledImage;
+ }
+ }
+
+ x = (int) (imgPtr->x + ((imgPtr->x >= 0) ? 0.5 : - 0.5));
+ y = (int) (imgPtr->y + ((imgPtr->y >= 0) ? 0.5 : - 0.5));
+
+ if ((state == TK_STATE_HIDDEN) || (image == None)) {
+ imgPtr->header.x1 = imgPtr->header.x2 = x;
+ imgPtr->header.y1 = imgPtr->header.y2 = y;
+ return;
+ }
+
+ /*
+ * Compute location and size of image, using anchor information.
+ */
+
+ Tk_SizeOfImage(image, &width, &height);
+ switch (imgPtr->anchor) {
+ case TK_ANCHOR_N:
+ x -= width/2;
+ break;
+ case TK_ANCHOR_NE:
+ x -= width;
+ break;
+ case TK_ANCHOR_E:
+ x -= width;
+ y -= height/2;
+ break;
+ case TK_ANCHOR_SE:
+ x -= width;
+ y -= height;
+ break;
+ case TK_ANCHOR_S:
+ x -= width/2;
+ y -= height;
+ break;
+ case TK_ANCHOR_SW:
+ y -= height;
+ break;
+ case TK_ANCHOR_W:
+ y -= height/2;
+ break;
+ case TK_ANCHOR_NW:
+ break;
+ case TK_ANCHOR_CENTER:
+ x -= width/2;
+ y -= height/2;
+ break;
+ }
+
+ /*
+ * Store the information in the item header.
+ */
+
+ imgPtr->header.x1 = x;
+ imgPtr->header.y1 = y;
+ imgPtr->header.x2 = x + width;
+ imgPtr->header.y2 = y + height;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * DisplayImage --
+ *
+ * This function is invoked to draw a image item in a given drawable.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * ItemPtr is drawn in drawable using the transformation information in
+ * canvas.
+ *
+ *--------------------------------------------------------------
+ */
+
+static void
+DisplayImage(
+ 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, int y, int width, int height)
+ /* Describes region of canvas that must be
+ * redisplayed (not used). */
+{
+ ImageItem *imgPtr = (ImageItem *) itemPtr;
+ short drawableX, drawableY;
+ Tk_Image image;
+ Tk_State state = itemPtr->state;
+
+ if (state == TK_STATE_NULL) {
+ state = Canvas(canvas)->canvas_state;
+ }
+
+ image = imgPtr->image;
+ if (Canvas(canvas)->currentItemPtr == itemPtr) {
+ if (imgPtr->activeImage != NULL) {
+ image = imgPtr->activeImage;
+ }
+ } else if (state == TK_STATE_DISABLED) {
+ if (imgPtr->disabledImage != NULL) {
+ image = imgPtr->disabledImage;
+ }
+ }
+
+ if (image == NULL) {
+ return;
+ }
+
+ /*
+ * Translate the coordinates to those of the image, then redisplay it.
+ */
+
+ Tk_CanvasDrawableCoords(canvas, (double) x, (double) y,
+ &drawableX, &drawableY);
+ Tk_RedrawImage(image, x - imgPtr->header.x1, y - imgPtr->header.y1,
+ width, height, drawable, drawableX, drawableY);
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * ImageToPoint --
+ *
+ * Computes the distance from a given point to a given rectangle, in
+ * canvas units.
+ *
+ * Results:
+ * The return value is 0 if the point whose x and y coordinates are
+ * coordPtr[0] and coordPtr[1] is inside the image. If the point isn't
+ * inside the image then the return value is the distance from the point
+ * to the image.
+ *
+ * Side effects:
+ * None.
+ *
+ *--------------------------------------------------------------
+ */
+
+static double
+ImageToPoint(
+ Tk_Canvas canvas, /* Canvas containing item. */
+ Tk_Item *itemPtr, /* Item to check against point. */
+ double *coordPtr) /* Pointer to x and y coordinates. */
+{
+ ImageItem *imgPtr = (ImageItem *) itemPtr;
+ double x1, x2, y1, y2, xDiff, yDiff;
+
+ x1 = imgPtr->header.x1;
+ y1 = imgPtr->header.y1;
+ x2 = imgPtr->header.x2;
+ y2 = imgPtr->header.y2;
+
+ /*
+ * Point is outside rectangle.
+ */
+
+ if (coordPtr[0] < x1) {
+ xDiff = x1 - coordPtr[0];
+ } else if (coordPtr[0] > x2) {
+ xDiff = coordPtr[0] - x2;
+ } else {
+ xDiff = 0;
+ }
+
+ if (coordPtr[1] < y1) {
+ yDiff = y1 - coordPtr[1];
+ } else if (coordPtr[1] > y2) {
+ yDiff = coordPtr[1] - y2;
+ } else {
+ yDiff = 0;
+ }
+
+ return hypot(xDiff, yDiff);
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * ImageToArea --
+ *
+ * This function is called to determine whether an item lies entirely
+ * inside, entirely outside, or overlapping a given rectangle.
+ *
+ * Results:
+ * -1 is returned if the item is entirely outside the area given by
+ * rectPtr, 0 if it overlaps, and 1 if it is entirely inside the given
+ * area.
+ *
+ * Side effects:
+ * None.
+ *
+ *--------------------------------------------------------------
+ */
+
+static int
+ImageToArea(
+ Tk_Canvas canvas, /* Canvas containing item. */
+ Tk_Item *itemPtr, /* Item to check against rectangle. */
+ double *rectPtr) /* Pointer to array of four coordinates
+ * (x1,y1,x2,y2) describing rectangular
+ * area. */
+{
+ ImageItem *imgPtr = (ImageItem *) itemPtr;
+
+ if ((rectPtr[2] <= imgPtr->header.x1)
+ || (rectPtr[0] >= imgPtr->header.x2)
+ || (rectPtr[3] <= imgPtr->header.y1)
+ || (rectPtr[1] >= imgPtr->header.y2)) {
+ return -1;
+ }
+ if ((rectPtr[0] <= imgPtr->header.x1)
+ && (rectPtr[1] <= imgPtr->header.y1)
+ && (rectPtr[2] >= imgPtr->header.x2)
+ && (rectPtr[3] >= imgPtr->header.y2)) {
+ return 1;
+ }
+ return 0;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * ImageToPostscript --
+ *
+ * This function 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(
+ 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);
+ double x, y;
+ int width, height;
+ Tk_Image image;
+ Tk_State state = itemPtr->state;
+
+ if (state == TK_STATE_NULL) {
+ state = Canvas(canvas)->canvas_state;
+ }
+
+ image = imgPtr->image;
+ if (Canvas(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) {
+ /*
+ * Image item without actual image specified.
+ */
+
+ return TCL_OK;
+ }
+ 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 (!prepass) {
+ Tcl_Obj *psObj = Tcl_GetObjResult(interp);
+
+ if (Tcl_IsShared(psObj)) {
+ psObj = Tcl_DuplicateObj(psObj);
+ Tcl_SetObjResult(interp, psObj);
+ }
+
+ Tcl_AppendPrintfToObj(psObj, "%.15g %.15g translate\n", x, y);
+ }
+
+ return Tk_PostscriptImage(image, interp, canvasWin,
+ ((TkCanvas *) canvas)->psInfo, 0, 0, width, height, prepass);
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * ScaleImage --
+ *
+ * This function is invoked to rescale an item.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The item referred to by itemPtr is rescaled so that the following
+ * transformation is applied to all point coordinates:
+ * x' = originX + scaleX*(x-originX)
+ * y' = originY + scaleY*(y-originY)
+ *
+ *--------------------------------------------------------------
+ */
+
+static void
+ScaleImage(
+ Tk_Canvas canvas, /* Canvas containing rectangle. */
+ Tk_Item *itemPtr, /* Rectangle to be scaled. */
+ double originX, double originY,
+ /* Origin about which to scale rect. */
+ double scaleX, /* Amount to scale in X direction. */
+ double scaleY) /* Amount to scale in Y direction. */
+{
+ ImageItem *imgPtr = (ImageItem *) itemPtr;
+
+ imgPtr->x = originX + scaleX*(imgPtr->x - originX);
+ imgPtr->y = originY + scaleY*(imgPtr->y - originY);
+ ComputeImageBbox(canvas, imgPtr);
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * TranslateImage --
+ *
+ * This function is called to move an item by a given amount.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The position of the item is offset by (xDelta, yDelta), and the
+ * bounding box is updated in the generic part of the item structure.
+ *
+ *--------------------------------------------------------------
+ */
+
+static void
+TranslateImage(
+ Tk_Canvas canvas, /* Canvas containing item. */
+ Tk_Item *itemPtr, /* Item that is being moved. */
+ double deltaX, double deltaY)
+ /* Amount by which item is to be moved. */
+{
+ ImageItem *imgPtr = (ImageItem *) itemPtr;
+
+ imgPtr->x += deltaX;
+ imgPtr->y += deltaY;
+ ComputeImageBbox(canvas, imgPtr);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ImageChangedProc --
+ *
+ * This function is invoked by the image code whenever the manager for an
+ * image does something that affects the image's size or how it is
+ * displayed.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Arranges for the canvas to get redisplayed.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+ImageChangedProc(
+ ClientData clientData, /* Pointer to canvas item for image. */
+ int x, int y, /* Upper left pixel (within image) that must
+ * be redisplayed. */
+ int width, int height, /* Dimensions of area to redisplay (may be <=
+ * 0). */
+ int imgWidth, int imgHeight)/* New dimensions of image. */
+{
+ ImageItem *imgPtr = clientData;
+
+ /*
+ * If the image's size changed and it's not anchored at its northwest
+ * corner then just redisplay the entire area of the image. This is a bit
+ * over-conservative, but we need to do something because a size change
+ * also means a position change.
+ */
+
+ if (((imgPtr->header.x2 - imgPtr->header.x1) != imgWidth)
+ || ((imgPtr->header.y2 - imgPtr->header.y1) != imgHeight)) {
+ x = y = 0;
+ width = imgWidth;
+ height = imgHeight;
+ Tk_CanvasEventuallyRedraw(imgPtr->canvas, imgPtr->header.x1,
+ imgPtr->header.y1, imgPtr->header.x2, imgPtr->header.y2);
+ }
+ ComputeImageBbox(imgPtr->canvas, imgPtr);
+ Tk_CanvasEventuallyRedraw(imgPtr->canvas, imgPtr->header.x1 + x,
+ imgPtr->header.y1 + y, (int) (imgPtr->header.x1 + x + width),
+ (int) (imgPtr->header.y1 + y + height));
+}
+
+/*
+ * Local Variables:
+ * mode: c
+ * c-basic-offset: 4
+ * fill-column: 78
+ * End:
+ */
diff --git a/tk8.6/generic/tkCanvLine.c b/tk8.6/generic/tkCanvLine.c
new file mode 100644
index 0000000..087aa56
--- /dev/null
+++ b/tk8.6/generic/tkCanvLine.c
@@ -0,0 +1,2518 @@
+/*
+ * tkCanvLine.c --
+ *
+ * This file implements line items for canvas widgets.
+ *
+ * Copyright (c) 1991-1994 The Regents of the University of California.
+ * Copyright (c) 1994-1997 Sun Microsystems, Inc.
+ * Copyright (c) 1998-1999 by Scriptics Corporation.
+ *
+ * See the file "license.terms" for information on usage and redistribution of
+ * this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ */
+
+#include "tkInt.h"
+#include "tkCanvas.h"
+
+/*
+ * The structure below defines the record for each line item.
+ */
+
+typedef enum {
+ ARROWS_NONE, ARROWS_FIRST, ARROWS_LAST, ARROWS_BOTH
+} Arrows;
+
+typedef struct LineItem {
+ Tk_Item header; /* Generic stuff that's the same for all
+ * types. MUST BE FIRST IN STRUCTURE. */
+ Tk_Outline outline; /* Outline structure */
+ Tk_Canvas canvas; /* Canvas containing item. Needed for parsing
+ * arrow shapes. */
+ int numPoints; /* Number of points in line (always >= 0). */
+ double *coordPtr; /* Pointer to malloc-ed array containing x-
+ * and y-coords of all points in line.
+ * X-coords are even-valued indices, y-coords
+ * are corresponding odd-valued indices. If
+ * the line has arrowheads then the first and
+ * last points have been adjusted to refer to
+ * the necks of the arrowheads rather than
+ * their tips. The actual endpoints are stored
+ * in the *firstArrowPtr and *lastArrowPtr, if
+ * they exist. */
+ int capStyle; /* Cap style for line. */
+ int joinStyle; /* Join style for line. */
+ GC arrowGC; /* Graphics context for drawing arrowheads. */
+ Arrows arrow; /* Indicates whether or not to draw arrowheads:
+ * "none", "first", "last", or "both". */
+ float arrowShapeA; /* Distance from tip of arrowhead to center. */
+ float arrowShapeB; /* Distance from tip of arrowhead to trailing
+ * point, measured along shaft. */
+ float arrowShapeC; /* Distance of trailing points from outside
+ * edge of shaft. */
+ double *firstArrowPtr; /* Points to array of PTS_IN_ARROW points
+ * describing polygon for arrowhead at first
+ * point in line. First point of arrowhead is
+ * tip. Malloc'ed. NULL means no arrowhead at
+ * first point. */
+ double *lastArrowPtr; /* Points to polygon for arrowhead at last
+ * point in line (PTS_IN_ARROW points, first
+ * of which is tip). Malloc'ed. NULL means no
+ * arrowhead at last point. */
+ const Tk_SmoothMethod *smooth; /* Non-zero means draw line smoothed (i.e.
+ * with Bezier splines). */
+ int splineSteps; /* Number of steps in each spline segment. */
+} LineItem;
+
+/*
+ * Number of points in an arrowHead:
+ */
+
+#define PTS_IN_ARROW 6
+
+/*
+ * Prototypes for functions defined in this file:
+ */
+
+static int ArrowheadPostscript(Tcl_Interp *interp,
+ Tk_Canvas canvas, LineItem *linePtr,
+ double *arrowPtr, Tcl_Obj *psObj);
+static void ComputeLineBbox(Tk_Canvas canvas, LineItem *linePtr);
+static int ConfigureLine(Tcl_Interp *interp,
+ Tk_Canvas canvas, Tk_Item *itemPtr, int objc,
+ Tcl_Obj *const objv[], int flags);
+static int ConfigureArrows(Tk_Canvas canvas, LineItem *linePtr);
+static int CreateLine(Tcl_Interp *interp,
+ Tk_Canvas canvas, struct Tk_Item *itemPtr,
+ int objc, Tcl_Obj *const objv[]);
+static void DeleteLine(Tk_Canvas canvas,
+ Tk_Item *itemPtr, Display *display);
+static void DisplayLine(Tk_Canvas canvas,
+ Tk_Item *itemPtr, Display *display, Drawable dst,
+ int x, int y, int width, int height);
+static int GetLineIndex(Tcl_Interp *interp,
+ Tk_Canvas canvas, Tk_Item *itemPtr,
+ Tcl_Obj *obj, int *indexPtr);
+static int LineCoords(Tcl_Interp *interp,
+ Tk_Canvas canvas, Tk_Item *itemPtr,
+ int objc, Tcl_Obj *const objv[]);
+static void LineDeleteCoords(Tk_Canvas canvas,
+ Tk_Item *itemPtr, int first, int last);
+static void LineInsert(Tk_Canvas canvas,
+ Tk_Item *itemPtr, int beforeThis, Tcl_Obj *obj);
+static int LineToArea(Tk_Canvas canvas,
+ Tk_Item *itemPtr, double *rectPtr);
+static double LineToPoint(Tk_Canvas canvas,
+ Tk_Item *itemPtr, double *coordPtr);
+static int LineToPostscript(Tcl_Interp *interp,
+ Tk_Canvas canvas, Tk_Item *itemPtr, int prepass);
+static int ArrowParseProc(ClientData clientData,
+ Tcl_Interp *interp, Tk_Window tkwin,
+ const char *value, char *recordPtr, int offset);
+static const char * ArrowPrintProc(ClientData clientData,
+ Tk_Window tkwin, char *recordPtr, int offset,
+ Tcl_FreeProc **freeProcPtr);
+static int ParseArrowShape(ClientData clientData,
+ Tcl_Interp *interp, Tk_Window tkwin,
+ const char *value, char *recordPtr, int offset);
+static const char * PrintArrowShape(ClientData clientData,
+ Tk_Window tkwin, char *recordPtr, int offset,
+ Tcl_FreeProc **freeProcPtr);
+static void ScaleLine(Tk_Canvas canvas,
+ Tk_Item *itemPtr, double originX, double originY,
+ double scaleX, double scaleY);
+static void TranslateLine(Tk_Canvas canvas,
+ Tk_Item *itemPtr, double deltaX, double deltaY);
+
+/*
+ * Information used for parsing configuration specs. If you change any of the
+ * default strings, be sure to change the corresponding default values in
+ * CreateLine.
+ */
+
+static const Tk_CustomOption arrowShapeOption = {
+ ParseArrowShape, PrintArrowShape, NULL
+};
+static const Tk_CustomOption arrowOption = {
+ ArrowParseProc, ArrowPrintProc, NULL
+};
+static const Tk_CustomOption smoothOption = {
+ TkSmoothParseProc, TkSmoothPrintProc, NULL
+};
+static const Tk_CustomOption stateOption = {
+ TkStateParseProc, TkStatePrintProc, INT2PTR(2)
+};
+static const Tk_CustomOption tagsOption = {
+ Tk_CanvasTagsParseProc, Tk_CanvasTagsPrintProc, NULL
+};
+static const Tk_CustomOption dashOption = {
+ TkCanvasDashParseProc, TkCanvasDashPrintProc, NULL
+};
+static const Tk_CustomOption offsetOption = {
+ TkOffsetParseProc, TkOffsetPrintProc,
+ INT2PTR(TK_OFFSET_RELATIVE|TK_OFFSET_INDEX)
+};
+static const Tk_CustomOption pixelOption = {
+ TkPixelParseProc, TkPixelPrintProc, NULL
+};
+
+static const Tk_ConfigSpec configSpecs[] = {
+ {TK_CONFIG_CUSTOM, "-activedash", NULL, NULL,
+ NULL, Tk_Offset(LineItem, outline.activeDash),
+ TK_CONFIG_NULL_OK, &dashOption},
+ {TK_CONFIG_COLOR, "-activefill", NULL, NULL,
+ NULL, Tk_Offset(LineItem, outline.activeColor), TK_CONFIG_NULL_OK, NULL},
+ {TK_CONFIG_BITMAP, "-activestipple", NULL, NULL,
+ NULL, Tk_Offset(LineItem, outline.activeStipple), TK_CONFIG_NULL_OK, NULL},
+ {TK_CONFIG_CUSTOM, "-activewidth", NULL, NULL,
+ "0.0", Tk_Offset(LineItem, outline.activeWidth),
+ TK_CONFIG_DONT_SET_DEFAULT, &pixelOption},
+ {TK_CONFIG_CUSTOM, "-arrow", NULL, NULL,
+ "none", Tk_Offset(LineItem, arrow),
+ TK_CONFIG_DONT_SET_DEFAULT, &arrowOption},
+ {TK_CONFIG_CUSTOM, "-arrowshape", NULL, NULL,
+ "8 10 3", Tk_Offset(LineItem, arrowShapeA),
+ TK_CONFIG_DONT_SET_DEFAULT, &arrowShapeOption},
+ {TK_CONFIG_CAP_STYLE, "-capstyle", NULL, NULL,
+ "butt", Tk_Offset(LineItem, capStyle), TK_CONFIG_DONT_SET_DEFAULT, NULL},
+ {TK_CONFIG_COLOR, "-fill", NULL, NULL,
+ "black", Tk_Offset(LineItem, outline.color), TK_CONFIG_NULL_OK, NULL},
+ {TK_CONFIG_CUSTOM, "-dash", NULL, NULL,
+ NULL, Tk_Offset(LineItem, outline.dash),
+ TK_CONFIG_NULL_OK, &dashOption},
+ {TK_CONFIG_PIXELS, "-dashoffset", NULL, NULL,
+ "0", Tk_Offset(LineItem, outline.offset), TK_CONFIG_DONT_SET_DEFAULT, NULL},
+ {TK_CONFIG_CUSTOM, "-disableddash", NULL, NULL,
+ NULL, Tk_Offset(LineItem, outline.disabledDash),
+ TK_CONFIG_NULL_OK, &dashOption},
+ {TK_CONFIG_COLOR, "-disabledfill", NULL, NULL,
+ NULL, Tk_Offset(LineItem, outline.disabledColor), TK_CONFIG_NULL_OK, NULL},
+ {TK_CONFIG_BITMAP, "-disabledstipple", NULL, NULL,
+ NULL, Tk_Offset(LineItem, outline.disabledStipple), TK_CONFIG_NULL_OK, NULL},
+ {TK_CONFIG_CUSTOM, "-disabledwidth", NULL, NULL,
+ "0.0", Tk_Offset(LineItem, outline.disabledWidth),
+ TK_CONFIG_DONT_SET_DEFAULT, &pixelOption},
+ {TK_CONFIG_JOIN_STYLE, "-joinstyle", NULL, NULL,
+ "round", Tk_Offset(LineItem, joinStyle), TK_CONFIG_DONT_SET_DEFAULT, NULL},
+ {TK_CONFIG_CUSTOM, "-offset", NULL, NULL,
+ "0,0", Tk_Offset(LineItem, outline.tsoffset),
+ TK_CONFIG_DONT_SET_DEFAULT, &offsetOption},
+ {TK_CONFIG_CUSTOM, "-smooth", NULL, NULL,
+ "0", Tk_Offset(LineItem, smooth),
+ TK_CONFIG_DONT_SET_DEFAULT, &smoothOption},
+ {TK_CONFIG_INT, "-splinesteps", NULL, NULL,
+ "12", Tk_Offset(LineItem, splineSteps), TK_CONFIG_DONT_SET_DEFAULT, NULL},
+ {TK_CONFIG_CUSTOM, "-state", NULL, NULL,
+ NULL, Tk_Offset(Tk_Item, state), TK_CONFIG_NULL_OK, &stateOption},
+ {TK_CONFIG_BITMAP, "-stipple", NULL, NULL,
+ NULL, Tk_Offset(LineItem, outline.stipple), TK_CONFIG_NULL_OK, NULL},
+ {TK_CONFIG_CUSTOM, "-tags", NULL, NULL,
+ NULL, 0, TK_CONFIG_NULL_OK, &tagsOption},
+ {TK_CONFIG_CUSTOM, "-width", NULL, NULL,
+ "1.0", Tk_Offset(LineItem, outline.width),
+ TK_CONFIG_DONT_SET_DEFAULT, &pixelOption},
+ {TK_CONFIG_END, NULL, NULL, NULL, NULL, 0, 0, NULL}
+};
+
+/*
+ * The structures below defines the line item type by means of functions that
+ * can be invoked by generic item code.
+ */
+
+Tk_ItemType tkLineType = {
+ "line", /* name */
+ sizeof(LineItem), /* itemSize */
+ CreateLine, /* createProc */
+ configSpecs, /* configSpecs */
+ ConfigureLine, /* configureProc */
+ LineCoords, /* coordProc */
+ DeleteLine, /* deleteProc */
+ DisplayLine, /* displayProc */
+ TK_CONFIG_OBJS | TK_MOVABLE_POINTS, /* flags */
+ LineToPoint, /* pointProc */
+ LineToArea, /* areaProc */
+ LineToPostscript, /* postscriptProc */
+ ScaleLine, /* scaleProc */
+ TranslateLine, /* translateProc */
+ GetLineIndex, /* indexProc */
+ NULL, /* icursorProc */
+ NULL, /* selectionProc */
+ LineInsert, /* insertProc */
+ LineDeleteCoords, /* dTextProc */
+ NULL, /* nextPtr */
+ NULL, 0, NULL, NULL
+};
+
+/*
+ * The definition below determines how large are static arrays used to hold
+ * spline points (splines larger than this have to have their arrays
+ * malloc-ed).
+ */
+
+#define MAX_STATIC_POINTS 200
+
+/*
+ *--------------------------------------------------------------
+ *
+ * CreateLine --
+ *
+ * This function is invoked to create a new line item in a canvas.
+ *
+ * Results:
+ * A standard Tcl return value. If an error occurred in creating the
+ * item, then an error message is left in the interp's result; in this
+ * case itemPtr is left uninitialized, so it can be safely freed by the
+ * caller.
+ *
+ * Side effects:
+ * A new line item is created.
+ *
+ *--------------------------------------------------------------
+ */
+
+static int
+CreateLine(
+ Tcl_Interp *interp, /* Interpreter for error reporting. */
+ Tk_Canvas canvas, /* Canvas to hold new item. */
+ Tk_Item *itemPtr, /* Record to hold new item; header has been
+ * initialized by caller. */
+ int objc, /* Number of arguments in objv. */
+ Tcl_Obj *const objv[]) /* Arguments describing line. */
+{
+ LineItem *linePtr = (LineItem *) itemPtr;
+ int i;
+
+ if (objc == 0) {
+ Tcl_Panic("canvas did not pass any coords");
+ }
+
+ /*
+ * Carry out initialization that is needed to set defaults and to allow
+ * proper cleanup after errors during the the remainder of this function.
+ */
+
+ Tk_CreateOutline(&linePtr->outline);
+ linePtr->canvas = canvas;
+ linePtr->numPoints = 0;
+ linePtr->coordPtr = NULL;
+ linePtr->capStyle = CapButt;
+ linePtr->joinStyle = JoinRound;
+ linePtr->arrowGC = None;
+ linePtr->arrow = ARROWS_NONE;
+ linePtr->arrowShapeA = (float)8.0;
+ linePtr->arrowShapeB = (float)10.0;
+ linePtr->arrowShapeC = (float)3.0;
+ linePtr->firstArrowPtr = NULL;
+ linePtr->lastArrowPtr = NULL;
+ linePtr->smooth = NULL;
+ linePtr->splineSteps = 12;
+
+ /*
+ * Count the number of points and then parse them into a point array.
+ * Leading arguments are assumed to be points if they start with a digit
+ * or a minus sign followed by a digit.
+ */
+
+ for (i = 1; i < objc; i++) {
+ const char *arg = Tcl_GetString(objv[i]);
+
+ if ((arg[0] == '-') && (arg[1] >= 'a') && (arg[1] <= 'z')) {
+ break;
+ }
+ }
+ if (LineCoords(interp, canvas, itemPtr, i, objv) != TCL_OK) {
+ goto error;
+ }
+ if (ConfigureLine(interp, canvas, itemPtr, objc-i, objv+i, 0) == TCL_OK) {
+ return TCL_OK;
+ }
+
+ error:
+ DeleteLine(canvas, itemPtr, Tk_Display(Tk_CanvasTkwin(canvas)));
+ return TCL_ERROR;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * LineCoords --
+ *
+ * This function is invoked to process the "coords" widget command on
+ * lines. See the user documentation for details on what it does.
+ *
+ * Results:
+ * Returns TCL_OK or TCL_ERROR, and sets the interp's result.
+ *
+ * Side effects:
+ * The coordinates for the given item may be changed.
+ *
+ *--------------------------------------------------------------
+ */
+
+static int
+LineCoords(
+ Tcl_Interp *interp, /* Used for error reporting. */
+ Tk_Canvas canvas, /* Canvas containing item. */
+ Tk_Item *itemPtr, /* Item whose coordinates are to be read or
+ * modified. */
+ int objc, /* Number of coordinates supplied in objv. */
+ Tcl_Obj *const objv[]) /* Array of coordinates: x1, y1, x2, y2, ... */
+{
+ LineItem *linePtr = (LineItem *) itemPtr;
+ int i, numPoints;
+ double *coordPtr;
+
+ if (objc == 0) {
+ int numCoords;
+ Tcl_Obj *subobj, *obj = Tcl_NewObj();
+
+ numCoords = 2*linePtr->numPoints;
+ if (linePtr->firstArrowPtr != NULL) {
+ coordPtr = linePtr->firstArrowPtr;
+ } else {
+ coordPtr = linePtr->coordPtr;
+ }
+ for (i = 0; i < numCoords; i++, coordPtr++) {
+ if (i == 2) {
+ coordPtr = linePtr->coordPtr+2;
+ }
+ if ((linePtr->lastArrowPtr != NULL) && (i == (numCoords-2))) {
+ coordPtr = linePtr->lastArrowPtr;
+ }
+ subobj = Tcl_NewDoubleObj(*coordPtr);
+ Tcl_ListObjAppendElement(interp, obj, subobj);
+ }
+ Tcl_SetObjResult(interp, obj);
+ return TCL_OK;
+ }
+ if (objc == 1) {
+ if (Tcl_ListObjGetElements(interp, objv[0], &objc,
+ (Tcl_Obj ***) &objv) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ }
+ if (objc & 1) {
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "wrong # coordinates: expected an even number, got %d",
+ objc));
+ Tcl_SetErrorCode(interp, "TK", "CANVAS", "COORDS", "LINE", NULL);
+ return TCL_ERROR;
+ } else if (objc < 4) {
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "wrong # coordinates: expected at least 4, got %d", objc));
+ Tcl_SetErrorCode(interp, "TK", "CANVAS", "COORDS", "LINE", NULL);
+ return TCL_ERROR;
+ }
+
+ numPoints = objc/2;
+ if (linePtr->numPoints != numPoints) {
+ coordPtr = ckalloc(sizeof(double) * objc);
+ if (linePtr->coordPtr != NULL) {
+ ckfree(linePtr->coordPtr);
+ }
+ linePtr->coordPtr = coordPtr;
+ linePtr->numPoints = numPoints;
+ }
+ coordPtr = linePtr->coordPtr;
+ for (i = 0; i < objc ; i++) {
+ if (Tk_CanvasGetCoordFromObj(interp, canvas, objv[i],
+ coordPtr++) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ }
+
+ /*
+ * Update arrowheads by throwing away any existing arrow-head information
+ * and calling ConfigureArrows to recompute it.
+ */
+
+ if (linePtr->firstArrowPtr != NULL) {
+ ckfree(linePtr->firstArrowPtr);
+ linePtr->firstArrowPtr = NULL;
+ }
+ if (linePtr->lastArrowPtr != NULL) {
+ ckfree(linePtr->lastArrowPtr);
+ linePtr->lastArrowPtr = NULL;
+ }
+ if (linePtr->arrow != ARROWS_NONE) {
+ ConfigureArrows(canvas, linePtr);
+ }
+ ComputeLineBbox(canvas, linePtr);
+ return TCL_OK;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * ConfigureLine --
+ *
+ * This function is invoked to configure various aspects of a line item
+ * such as its background color.
+ *
+ * Results:
+ * A standard Tcl result code. If an error occurs, then an error message
+ * is left in the interp's result.
+ *
+ * Side effects:
+ * Configuration information, such as colors and stipple patterns, may be
+ * set for itemPtr.
+ *
+ *--------------------------------------------------------------
+ */
+
+static int
+ConfigureLine(
+ Tcl_Interp *interp, /* Used for error reporting. */
+ Tk_Canvas canvas, /* Canvas containing itemPtr. */
+ Tk_Item *itemPtr, /* Line item to reconfigure. */
+ int objc, /* Number of elements in objv. */
+ Tcl_Obj *const objv[], /* Arguments describing things to configure. */
+ int flags) /* Flags to pass to Tk_ConfigureWidget. */
+{
+ LineItem *linePtr = (LineItem *) itemPtr;
+ XGCValues gcValues;
+ GC newGC, arrowGC;
+ unsigned long mask;
+ Tk_Window tkwin;
+ Tk_State state;
+
+ tkwin = Tk_CanvasTkwin(canvas);
+ if (TCL_OK != Tk_ConfigureWidget(interp, tkwin, configSpecs, objc,
+ (const char **) objv, (char *) linePtr, flags|TK_CONFIG_OBJS)) {
+ return TCL_ERROR;
+ }
+
+ /*
+ * A few of the options require additional processing, such as graphics
+ * contexts.
+ */
+
+ state = itemPtr->state;
+
+ if (state == TK_STATE_NULL) {
+ state = Canvas(canvas)->canvas_state;
+ }
+
+ if (linePtr->outline.activeWidth > linePtr->outline.width ||
+ linePtr->outline.activeDash.number != 0 ||
+ linePtr->outline.activeColor != NULL ||
+ linePtr->outline.activeStipple != None) {
+ itemPtr->redraw_flags |= TK_ITEM_STATE_DEPENDANT;
+ } else {
+ itemPtr->redraw_flags &= ~TK_ITEM_STATE_DEPENDANT;
+ }
+ mask = Tk_ConfigOutlineGC(&gcValues, canvas, itemPtr, &linePtr->outline);
+ if (mask) {
+ if (linePtr->arrow == ARROWS_NONE) {
+ gcValues.cap_style = linePtr->capStyle;
+ mask |= GCCapStyle;
+ }
+ gcValues.join_style = linePtr->joinStyle;
+ mask |= GCJoinStyle;
+ newGC = Tk_GetGC(tkwin, mask, &gcValues);
+#ifdef MAC_OSX_TK
+ /*
+ * Mac OS X CG drawing needs access to linewidth even for arrow fills
+ * (as linewidth controls antialiasing).
+ */
+
+ mask |= GCLineWidth;
+#else
+ gcValues.line_width = 0;
+#endif
+ arrowGC = Tk_GetGC(tkwin, mask, &gcValues);
+ } else {
+ newGC = arrowGC = None;
+ }
+ if (linePtr->outline.gc != None) {
+ Tk_FreeGC(Tk_Display(tkwin), linePtr->outline.gc);
+ }
+ if (linePtr->arrowGC != None) {
+ Tk_FreeGC(Tk_Display(tkwin), linePtr->arrowGC);
+ }
+ linePtr->outline.gc = newGC;
+ linePtr->arrowGC = arrowGC;
+
+ /*
+ * Keep spline parameters within reasonable limits.
+ */
+
+ if (linePtr->splineSteps < 1) {
+ linePtr->splineSteps = 1;
+ } else if (linePtr->splineSteps > 100) {
+ linePtr->splineSteps = 100;
+ }
+
+ if ((!linePtr->numPoints) || (state == TK_STATE_HIDDEN)) {
+ ComputeLineBbox(canvas, linePtr);
+ return TCL_OK;
+ }
+
+ /*
+ * Setup arrowheads, if needed. If arrowheads are turned off, restore the
+ * line's endpoints (they were shortened when the arrowheads were added).
+ */
+
+ if ((linePtr->firstArrowPtr != NULL) && (linePtr->arrow != ARROWS_FIRST)
+ && (linePtr->arrow != ARROWS_BOTH)) {
+ linePtr->coordPtr[0] = linePtr->firstArrowPtr[0];
+ linePtr->coordPtr[1] = linePtr->firstArrowPtr[1];
+ ckfree(linePtr->firstArrowPtr);
+ linePtr->firstArrowPtr = NULL;
+ }
+ if ((linePtr->lastArrowPtr != NULL) && (linePtr->arrow != ARROWS_LAST)
+ && (linePtr->arrow != ARROWS_BOTH)) {
+ int i;
+
+ i = 2*(linePtr->numPoints-1);
+ linePtr->coordPtr[i] = linePtr->lastArrowPtr[0];
+ linePtr->coordPtr[i+1] = linePtr->lastArrowPtr[1];
+ ckfree(linePtr->lastArrowPtr);
+ linePtr->lastArrowPtr = NULL;
+ }
+ if (linePtr->arrow != ARROWS_NONE) {
+ ConfigureArrows(canvas, linePtr);
+ }
+
+ /*
+ * Recompute bounding box for line.
+ */
+
+ ComputeLineBbox(canvas, linePtr);
+
+ return TCL_OK;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * DeleteLine --
+ *
+ * This function is called to clean up the data structure associated with
+ * a line item.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Resources associated with itemPtr are released.
+ *
+ *--------------------------------------------------------------
+ */
+
+static void
+DeleteLine(
+ Tk_Canvas canvas, /* Info about overall canvas widget. */
+ Tk_Item *itemPtr, /* Item that is being deleted. */
+ Display *display) /* Display containing window for canvas. */
+{
+ LineItem *linePtr = (LineItem *) itemPtr;
+
+ Tk_DeleteOutline(display, &linePtr->outline);
+ if (linePtr->coordPtr != NULL) {
+ ckfree(linePtr->coordPtr);
+ }
+ if (linePtr->arrowGC != None) {
+ Tk_FreeGC(display, linePtr->arrowGC);
+ }
+ if (linePtr->firstArrowPtr != NULL) {
+ ckfree(linePtr->firstArrowPtr);
+ }
+ if (linePtr->lastArrowPtr != NULL) {
+ ckfree(linePtr->lastArrowPtr);
+ }
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * ComputeLineBbox --
+ *
+ * This function is invoked to compute the bounding box of all the pixels
+ * that may be drawn as part of a line.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The fields x1, y1, x2, and y2 are updated in the header for itemPtr.
+ *
+ *--------------------------------------------------------------
+ */
+
+static void
+ComputeLineBbox(
+ Tk_Canvas canvas, /* Canvas that contains item. */
+ LineItem *linePtr) /* Item whose bbos is to be recomputed. */
+{
+ double *coordPtr;
+ int i, intWidth;
+ double width;
+ Tk_State state = linePtr->header.state;
+ Tk_TSOffset *tsoffset;
+
+ if (state == TK_STATE_NULL) {
+ state = Canvas(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 (Canvas(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[0];
+ linePtr->header.y1 = linePtr->header.y2 = (int) coordPtr[1];
+
+ /*
+ * Compute the bounding box of all the points in the line, then expand in
+ * all directions by the line's width to take care of butting or rounded
+ * corners and projecting or rounded caps. This expansion is an
+ * overestimate (worst-case is square root of two over two) but it's
+ * simple. Don't do anything special for curves. This causes an additional
+ * overestimate in the bounding box, but is faster.
+ */
+
+ for (i = 1, coordPtr = linePtr->coordPtr+2; i < linePtr->numPoints;
+ i++, coordPtr += 2) {
+ TkIncludePoint((Tk_Item *) linePtr, coordPtr);
+ }
+ width = linePtr->outline.width;
+ if (width < 1.0) {
+ width = 1.0;
+ }
+ if (linePtr->arrow != ARROWS_NONE) {
+ if (linePtr->arrow != ARROWS_LAST) {
+ TkIncludePoint((Tk_Item *) linePtr, linePtr->firstArrowPtr);
+ }
+ if (linePtr->arrow != ARROWS_FIRST) {
+ TkIncludePoint((Tk_Item *) linePtr, linePtr->lastArrowPtr);
+ }
+ }
+
+ tsoffset = &linePtr->outline.tsoffset;
+ if (tsoffset->flags & TK_OFFSET_INDEX) {
+ double *coordPtr = linePtr->coordPtr
+ + (tsoffset->flags & ~TK_OFFSET_INDEX);
+
+ if (tsoffset->flags <= 0) {
+ coordPtr = linePtr->coordPtr;
+ if ((linePtr->arrow == ARROWS_FIRST)
+ || (linePtr->arrow == ARROWS_BOTH)) {
+ coordPtr = linePtr->firstArrowPtr;
+ }
+ }
+ if (tsoffset->flags > (linePtr->numPoints * 2)) {
+ coordPtr = linePtr->coordPtr + (linePtr->numPoints * 2);
+ if ((linePtr->arrow == ARROWS_LAST)
+ || (linePtr->arrow == ARROWS_BOTH)) {
+ coordPtr = linePtr->lastArrowPtr;
+ }
+ }
+ tsoffset->xoffset = (int) (coordPtr[0] + 0.5);
+ tsoffset->yoffset = (int) (coordPtr[1] + 0.5);
+ } else {
+ if (tsoffset->flags & TK_OFFSET_LEFT) {
+ tsoffset->xoffset = linePtr->header.x1;
+ } else if (tsoffset->flags & TK_OFFSET_CENTER) {
+ tsoffset->xoffset = (linePtr->header.x1 + linePtr->header.x2)/2;
+ } else if (tsoffset->flags & TK_OFFSET_RIGHT) {
+ tsoffset->xoffset = linePtr->header.x2;
+ }
+ if (tsoffset->flags & TK_OFFSET_TOP) {
+ tsoffset->yoffset = linePtr->header.y1;
+ } else if (tsoffset->flags & TK_OFFSET_MIDDLE) {
+ tsoffset->yoffset = (linePtr->header.y1 + linePtr->header.y2)/2;
+ } else if (tsoffset->flags & TK_OFFSET_BOTTOM) {
+ tsoffset->yoffset = linePtr->header.y2;
+ }
+ }
+
+ intWidth = (int) (width + 0.5);
+ linePtr->header.x1 -= intWidth;
+ linePtr->header.x2 += intWidth;
+ linePtr->header.y1 -= intWidth;
+ linePtr->header.y2 += intWidth;
+
+ if (linePtr->numPoints == 1) {
+ linePtr->header.x1 -= 1;
+ linePtr->header.x2 += 1;
+ linePtr->header.y1 -= 1;
+ linePtr->header.y2 += 1;
+ return;
+ }
+
+ /*
+ * For mitered lines, make a second pass through all the points. Compute
+ * the locations of the two miter vertex points and add those into the
+ * bounding box.
+ */
+
+ if (linePtr->joinStyle == JoinMiter) {
+ for (i = linePtr->numPoints, coordPtr = linePtr->coordPtr; i >= 3;
+ i--, coordPtr += 2) {
+ double miter[4];
+ int j;
+
+ if (TkGetMiterPoints(coordPtr, coordPtr+2, coordPtr+4,
+ width, miter, miter+2)) {
+ for (j = 0; j < 4; j += 2) {
+ TkIncludePoint((Tk_Item *) linePtr, miter+j);
+ }
+ }
+ }
+ }
+
+ /*
+ * Add in the sizes of arrowheads, if any.
+ */
+
+ if (linePtr->arrow != ARROWS_NONE) {
+ if (linePtr->arrow != ARROWS_LAST) {
+ for (i = 0, coordPtr = linePtr->firstArrowPtr; i < PTS_IN_ARROW;
+ i++, coordPtr += 2) {
+ TkIncludePoint((Tk_Item *) linePtr, coordPtr);
+ }
+ }
+ if (linePtr->arrow != ARROWS_FIRST) {
+ for (i = 0, coordPtr = linePtr->lastArrowPtr; i < PTS_IN_ARROW;
+ i++, coordPtr += 2) {
+ TkIncludePoint((Tk_Item *) linePtr, coordPtr);
+ }
+ }
+ }
+
+ /*
+ * Add one more pixel of fudge factor just to be safe (e.g. X may round
+ * differently than we do).
+ */
+
+ linePtr->header.x1 -= 1;
+ linePtr->header.x2 += 1;
+ linePtr->header.y1 -= 1;
+ linePtr->header.y2 += 1;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * DisplayLine --
+ *
+ * This function is invoked to draw a line item in a given drawable.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * ItemPtr is drawn in drawable using the transformation information in
+ * canvas.
+ *
+ *--------------------------------------------------------------
+ */
+
+static void
+DisplayLine(
+ 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, int y, int width, int height)
+ /* Describes region of canvas that must be
+ * redisplayed (not used). */
+{
+ LineItem *linePtr = (LineItem *) itemPtr;
+ XPoint staticPoints[MAX_STATIC_POINTS*3];
+ XPoint *pointPtr;
+ double linewidth;
+ int numPoints;
+ Tk_State state = itemPtr->state;
+
+ if ((!linePtr->numPoints) || (linePtr->outline.gc == None)) {
+ return;
+ }
+
+ if (state == TK_STATE_NULL) {
+ state = Canvas(canvas)->canvas_state;
+ }
+ linewidth = linePtr->outline.width;
+ if (Canvas(canvas)->currentItemPtr == itemPtr) {
+ if (linePtr->outline.activeWidth != linewidth) {
+ linewidth = linePtr->outline.activeWidth;
+ }
+ } else if (state == TK_STATE_DISABLED) {
+ if (linePtr->outline.disabledWidth != linewidth) {
+ linewidth = linePtr->outline.disabledWidth;
+ }
+ }
+ /*
+ * Build up an array of points in screen coordinates. Use a static array
+ * unless the line has an enormous number of points; in this case,
+ * dynamically allocate an array. For smoothed lines, generate the curve
+ * points on each redisplay.
+ */
+
+ if ((linePtr->smooth) && (linePtr->numPoints > 2)) {
+ numPoints = linePtr->smooth->coordProc(canvas, NULL,
+ linePtr->numPoints, linePtr->splineSteps, NULL, NULL);
+ } else {
+ numPoints = linePtr->numPoints;
+ }
+
+ if (numPoints <= MAX_STATIC_POINTS) {
+ pointPtr = staticPoints;
+ } else {
+ pointPtr = ckalloc(numPoints * 3 * sizeof(XPoint));
+ }
+
+ if ((linePtr->smooth) && (linePtr->numPoints > 2)) {
+ numPoints = linePtr->smooth->coordProc(canvas, linePtr->coordPtr,
+ linePtr->numPoints, linePtr->splineSteps, pointPtr, NULL);
+ } else {
+ numPoints = TkCanvTranslatePath((TkCanvas *) canvas, numPoints,
+ linePtr->coordPtr, 0, pointPtr);
+ }
+
+ /*
+ * Display line, the free up line storage if it was dynamically allocated.
+ * If we're stippling, then modify the stipple offset in the GC. Be sure
+ * to reset the offset when done, since the GC is supposed to be
+ * read-only.
+ */
+
+ if (Tk_ChangeOutlineGC(canvas, itemPtr, &linePtr->outline)) {
+ Tk_CanvasSetOffset(canvas, linePtr->arrowGC,
+ &linePtr->outline.tsoffset);
+ }
+ if (numPoints > 1) {
+ XDrawLines(display, drawable, linePtr->outline.gc, pointPtr, numPoints,
+ CoordModeOrigin);
+ } else {
+ int intwidth = (int) (linewidth + 0.5);
+
+ if (intwidth < 1) {
+ intwidth = 1;
+ }
+ XFillArc(display, drawable, linePtr->outline.gc,
+ pointPtr->x - intwidth/2, pointPtr->y - intwidth/2,
+ (unsigned) intwidth+1, (unsigned) intwidth+1, 0, 64*360);
+ }
+ if (pointPtr != staticPoints) {
+ ckfree(pointPtr);
+ }
+
+ /*
+ * Display arrowheads, if they are wanted.
+ */
+
+ if (linePtr->firstArrowPtr != NULL) {
+ TkFillPolygon(canvas, linePtr->firstArrowPtr, PTS_IN_ARROW,
+ display, drawable, linePtr->arrowGC, NULL);
+ }
+ if (linePtr->lastArrowPtr != NULL) {
+ TkFillPolygon(canvas, linePtr->lastArrowPtr, PTS_IN_ARROW,
+ display, drawable, linePtr->arrowGC, NULL);
+ }
+ if (Tk_ResetOutlineGC(canvas, itemPtr, &linePtr->outline)) {
+ XSetTSOrigin(display, linePtr->arrowGC, 0, 0);
+ }
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * LineInsert --
+ *
+ * Insert coords into a line item at a given index.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The coords in the given item is modified.
+ *
+ *--------------------------------------------------------------
+ */
+
+static void
+LineInsert(
+ Tk_Canvas canvas, /* Canvas containing text item. */
+ Tk_Item *itemPtr, /* Line item to be modified. */
+ int beforeThis, /* Index before which new coordinates are to
+ * be inserted. */
+ Tcl_Obj *obj) /* New coordinates to be inserted. */
+{
+ LineItem *linePtr = (LineItem *) itemPtr;
+ int length, objc, i;
+ double *newCoordPtr, *coordPtr;
+ Tk_State state = itemPtr->state;
+ Tcl_Obj **objv;
+
+ if (state == TK_STATE_NULL) {
+ state = Canvas(canvas)->canvas_state;
+ }
+
+ if (!obj || (Tcl_ListObjGetElements(NULL, obj, &objc, &objv) != TCL_OK)
+ || !objc || objc&1) {
+ return;
+ }
+ length = 2*linePtr->numPoints;
+ if (beforeThis < 0) {
+ beforeThis = 0;
+ }
+ if (beforeThis > length) {
+ beforeThis = length;
+ }
+ if (linePtr->firstArrowPtr != NULL) {
+ linePtr->coordPtr[0] = linePtr->firstArrowPtr[0];
+ linePtr->coordPtr[1] = linePtr->firstArrowPtr[1];
+ }
+ if (linePtr->lastArrowPtr != NULL) {
+ linePtr->coordPtr[length-2] = linePtr->lastArrowPtr[0];
+ linePtr->coordPtr[length-1] = linePtr->lastArrowPtr[1];
+ }
+ newCoordPtr = ckalloc(sizeof(double) * (length + objc));
+ for (i=0; i<beforeThis; i++) {
+ newCoordPtr[i] = linePtr->coordPtr[i];
+ }
+ for (i=0; i<objc; i++) {
+ if (Tcl_GetDoubleFromObj(NULL, objv[i],
+ &newCoordPtr[i + beforeThis]) != TCL_OK) {
+ Tcl_ResetResult(Canvas(canvas)->interp);
+ ckfree(newCoordPtr);
+ return;
+ }
+ }
+
+ for (i=beforeThis; i<length; i++) {
+ newCoordPtr[i+objc] = linePtr->coordPtr[i];
+ }
+ if (linePtr->coordPtr) {
+ ckfree(linePtr->coordPtr);
+ }
+ linePtr->coordPtr = newCoordPtr;
+ length += objc ;
+ linePtr->numPoints = length / 2;
+
+ if ((length > 3) && (state != TK_STATE_HIDDEN)) {
+ /*
+ * This is some optimizing code that will result that only the part of
+ * the polygon that changed (and the objects that are overlapping with
+ * that part) need to be redrawn. A special flag is set that instructs
+ * the general canvas code not to redraw the whole object. If this
+ * flag is not set, the canvas will do the redrawing, otherwise I have
+ * to do it here.
+ */
+
+ itemPtr->redraw_flags |= TK_ITEM_DONT_REDRAW;
+
+ if (beforeThis > 0) {
+ beforeThis -= 2;
+ objc += 2;
+ }
+ if (beforeThis+objc < length) {
+ objc += 2;
+ }
+ if (linePtr->smooth) {
+ if (beforeThis > 0) {
+ beforeThis -= 2;
+ objc += 2;
+ }
+ if (beforeThis+objc+2 < length) {
+ objc += 2;
+ }
+ }
+ itemPtr->x1 = itemPtr->x2 = (int) linePtr->coordPtr[beforeThis];
+ itemPtr->y1 = itemPtr->y2 = (int) linePtr->coordPtr[beforeThis+1];
+ if ((linePtr->firstArrowPtr != NULL) && (beforeThis < 1)) {
+ /*
+ * Include old first arrow.
+ */
+
+ for (i = 0, coordPtr = linePtr->firstArrowPtr; i < PTS_IN_ARROW;
+ i++, coordPtr += 2) {
+ TkIncludePoint(itemPtr, coordPtr);
+ }
+ }
+ if ((linePtr->lastArrowPtr != NULL) && (beforeThis+objc >= length)) {
+ /*
+ * Include old last arrow.
+ */
+
+ for (i = 0, coordPtr = linePtr->lastArrowPtr; i < PTS_IN_ARROW;
+ i++, coordPtr += 2) {
+ TkIncludePoint(itemPtr, coordPtr);
+ }
+ }
+ coordPtr = linePtr->coordPtr + beforeThis + 2;
+ for (i=2; i<objc; i+=2) {
+ TkIncludePoint(itemPtr, coordPtr);
+ coordPtr += 2;
+ }
+ }
+ if (linePtr->firstArrowPtr != NULL) {
+ ckfree(linePtr->firstArrowPtr);
+ linePtr->firstArrowPtr = NULL;
+ }
+ if (linePtr->lastArrowPtr != NULL) {
+ ckfree(linePtr->lastArrowPtr);
+ linePtr->lastArrowPtr = NULL;
+ }
+ if (linePtr->arrow != ARROWS_NONE) {
+ ConfigureArrows(canvas, linePtr);
+ }
+
+ if (itemPtr->redraw_flags & TK_ITEM_DONT_REDRAW) {
+ double width;
+ int intWidth;
+
+ if ((linePtr->firstArrowPtr != NULL) && (beforeThis > 2)) {
+ /*
+ * Include new first arrow.
+ */
+
+ for (i = 0, coordPtr = linePtr->firstArrowPtr; i < PTS_IN_ARROW;
+ i++, coordPtr += 2) {
+ TkIncludePoint(itemPtr, coordPtr);
+ }
+ }
+ if ((linePtr->lastArrowPtr != NULL) && (beforeThis+objc < length-2)) {
+ /*
+ * Include new right arrow.
+ */
+
+ for (i = 0, coordPtr = linePtr->lastArrowPtr; i < PTS_IN_ARROW;
+ i++, coordPtr += 2) {
+ TkIncludePoint(itemPtr, coordPtr);
+ }
+ }
+ width = linePtr->outline.width;
+ if (Canvas(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(
+ 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 = Canvas(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(linePtr->firstArrowPtr);
+ linePtr->firstArrowPtr = NULL;
+ }
+ if (linePtr->lastArrowPtr != NULL) {
+ ckfree(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 (Canvas(canvas)->currentItemPtr == itemPtr) {
+ if (linePtr->outline.activeWidth > width) {
+ width = linePtr->outline.activeWidth;
+ }
+ } else if (state == TK_STATE_DISABLED) {
+ if (linePtr->outline.disabledWidth > 0) {
+ width = linePtr->outline.disabledWidth;
+ }
+ }
+ intWidth = (int) (width + 0.5);
+ if (intWidth < 1) {
+ intWidth = 1;
+ }
+ itemPtr->x1 -= intWidth;
+ itemPtr->y1 -= intWidth;
+ itemPtr->x2 += intWidth;
+ itemPtr->y2 += intWidth;
+ Tk_CanvasEventuallyRedraw(canvas, itemPtr->x1, itemPtr->y1,
+ itemPtr->x2, itemPtr->y2);
+ }
+ ComputeLineBbox(canvas, linePtr);
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * LineToPoint --
+ *
+ * Computes the distance from a given point to a given line, in canvas
+ * units.
+ *
+ * Results:
+ * The return value is 0 if the point whose x and y coordinates are
+ * pointPtr[0] and pointPtr[1] is inside the line. If the point isn't
+ * inside the line then the return value is the distance from the point
+ * to the line.
+ *
+ * Side effects:
+ * None.
+ *
+ *--------------------------------------------------------------
+ */
+
+ /* ARGSUSED */
+static double
+LineToPoint(
+ Tk_Canvas canvas, /* Canvas containing item. */
+ Tk_Item *itemPtr, /* Item to check against point. */
+ double *pointPtr) /* Pointer to x and y coordinates. */
+{
+ Tk_State state = itemPtr->state;
+ LineItem *linePtr = (LineItem *) itemPtr;
+ double *coordPtr, *linePoints;
+ double staticSpace[2*MAX_STATIC_POINTS];
+ double poly[10];
+ double bestDist, dist, width;
+ int numPoints, count;
+ int changedMiterToBevel; /* Non-zero means that a mitered corner had to
+ * be treated as beveled after all because the
+ * angle was < 11 degrees. */
+
+ bestDist = 1.0e36;
+
+ /*
+ * Handle smoothed lines by generating an expanded set of points against
+ * which to do the check.
+ */
+
+ if (state == TK_STATE_NULL) {
+ state = Canvas(canvas)->canvas_state;
+ }
+
+ width = linePtr->outline.width;
+ if (Canvas(canvas)->currentItemPtr == itemPtr) {
+ if (linePtr->outline.activeWidth > width) {
+ width = linePtr->outline.activeWidth;
+ }
+ } else if (state == TK_STATE_DISABLED) {
+ if (linePtr->outline.disabledWidth > 0) {
+ width = linePtr->outline.disabledWidth;
+ }
+ }
+
+ if ((linePtr->smooth) && (linePtr->numPoints > 2)) {
+ numPoints = linePtr->smooth->coordProc(canvas, NULL,
+ linePtr->numPoints, linePtr->splineSteps, NULL, NULL);
+ if (numPoints <= MAX_STATIC_POINTS) {
+ linePoints = staticSpace;
+ } else {
+ linePoints = ckalloc(2 * numPoints * sizeof(double));
+ }
+ numPoints = linePtr->smooth->coordProc(canvas, linePtr->coordPtr,
+ linePtr->numPoints, linePtr->splineSteps, NULL, linePoints);
+ } else {
+ numPoints = linePtr->numPoints;
+ linePoints = linePtr->coordPtr;
+ }
+
+ if (width < 1.0) {
+ width = 1.0;
+ }
+
+ if (!numPoints || itemPtr->state == TK_STATE_HIDDEN) {
+ return bestDist;
+ } else if (numPoints == 1) {
+ bestDist = hypot(linePoints[0]-pointPtr[0], linePoints[1]-pointPtr[1])
+ - width/2.0;
+ if (bestDist < 0) {
+ bestDist = 0;
+ }
+ return bestDist;
+ }
+
+ /*
+ * The overall idea is to iterate through all of the edges of the line,
+ * computing a polygon for each edge and testing the point against that
+ * polygon. In addition, there are additional tests to deal with rounded
+ * joints and caps.
+ */
+
+ changedMiterToBevel = 0;
+ for (count = numPoints, coordPtr = linePoints; count >= 2;
+ count--, coordPtr += 2) {
+ /*
+ * If rounding is done around the first point then compute the
+ * distance between the point and the point.
+ */
+
+ if (((linePtr->capStyle == CapRound) && (count == numPoints))
+ || ((linePtr->joinStyle == JoinRound)
+ && (count != numPoints))) {
+ dist = hypot(coordPtr[0] - pointPtr[0], coordPtr[1] - pointPtr[1])
+ - width/2.0;
+ if (dist <= 0.0) {
+ bestDist = 0.0;
+ goto done;
+ } else if (dist < bestDist) {
+ bestDist = dist;
+ }
+ }
+
+ /*
+ * Compute the polygonal shape corresponding to this edge, consisting
+ * of two points for the first point of the edge and two points for
+ * the last point of the edge.
+ */
+
+ if (count == numPoints) {
+ TkGetButtPoints(coordPtr+2, coordPtr, width,
+ linePtr->capStyle == CapProjecting, poly, poly+2);
+ } else if ((linePtr->joinStyle == JoinMiter) && !changedMiterToBevel) {
+ poly[0] = poly[6];
+ poly[1] = poly[7];
+ poly[2] = poly[4];
+ poly[3] = poly[5];
+ } else {
+ TkGetButtPoints(coordPtr+2, coordPtr, width, 0, poly, poly+2);
+
+ /*
+ * If this line uses beveled joints, then check the distance to a
+ * polygon comprising the last two points of the previous polygon
+ * and the first two from this polygon; this checks the wedges
+ * that fill the mitered joint.
+ */
+
+ if ((linePtr->joinStyle == JoinBevel) || changedMiterToBevel) {
+ poly[8] = poly[0];
+ poly[9] = poly[1];
+ dist = TkPolygonToPoint(poly, 5, pointPtr);
+ if (dist <= 0.0) {
+ bestDist = 0.0;
+ goto done;
+ } else if (dist < bestDist) {
+ bestDist = dist;
+ }
+ changedMiterToBevel = 0;
+ }
+ }
+ if (count == 2) {
+ TkGetButtPoints(coordPtr, coordPtr+2, width,
+ linePtr->capStyle == CapProjecting, poly+4, poly+6);
+ } else if (linePtr->joinStyle == JoinMiter) {
+ if (TkGetMiterPoints(coordPtr, coordPtr+2, coordPtr+4,
+ width, poly+4, poly+6) == 0) {
+ changedMiterToBevel = 1;
+ TkGetButtPoints(coordPtr, coordPtr+2, width, 0,
+ poly+4, poly+6);
+ }
+ } else {
+ TkGetButtPoints(coordPtr, coordPtr+2, width, 0,
+ poly+4, poly+6);
+ }
+ poly[8] = poly[0];
+ poly[9] = poly[1];
+ dist = TkPolygonToPoint(poly, 5, pointPtr);
+ if (dist <= 0.0) {
+ bestDist = 0.0;
+ goto done;
+ } else if (dist < bestDist) {
+ bestDist = dist;
+ }
+ }
+
+ /*
+ * If caps are rounded, check the distance to the cap around the final end
+ * point of the line.
+ */
+
+ if (linePtr->capStyle == CapRound) {
+ dist = hypot(coordPtr[0] - pointPtr[0], coordPtr[1] - pointPtr[1])
+ - width/2.0;
+ if (dist <= 0.0) {
+ bestDist = 0.0;
+ goto done;
+ } else if (dist < bestDist) {
+ bestDist = dist;
+ }
+ }
+
+ /*
+ * If there are arrowheads, check the distance to the arrowheads.
+ */
+
+ if (linePtr->arrow != ARROWS_NONE) {
+ if (linePtr->arrow != ARROWS_LAST) {
+ dist = TkPolygonToPoint(linePtr->firstArrowPtr, PTS_IN_ARROW,
+ pointPtr);
+ if (dist <= 0.0) {
+ bestDist = 0.0;
+ goto done;
+ } else if (dist < bestDist) {
+ bestDist = dist;
+ }
+ }
+ if (linePtr->arrow != ARROWS_FIRST) {
+ dist = TkPolygonToPoint(linePtr->lastArrowPtr, PTS_IN_ARROW,
+ pointPtr);
+ if (dist <= 0.0) {
+ bestDist = 0.0;
+ goto done;
+ } else if (dist < bestDist) {
+ bestDist = dist;
+ }
+ }
+ }
+
+ done:
+ if ((linePoints != staticSpace) && (linePoints != linePtr->coordPtr)) {
+ ckfree(linePoints);
+ }
+ return bestDist;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * LineToArea --
+ *
+ * This function is called to determine whether an item lies entirely
+ * inside, entirely outside, or overlapping a given rectangular area.
+ *
+ * Results:
+ * -1 is returned if the item is entirely outside the area, 0 if it
+ * overlaps, and 1 if it is entirely inside the given area.
+ *
+ * Side effects:
+ * None.
+ *
+ *--------------------------------------------------------------
+ */
+
+ /* ARGSUSED */
+static int
+LineToArea(
+ Tk_Canvas canvas, /* Canvas containing item. */
+ Tk_Item *itemPtr, /* Item to check against line. */
+ double *rectPtr)
+{
+ LineItem *linePtr = (LineItem *) itemPtr;
+ double staticSpace[2*MAX_STATIC_POINTS];
+ double *linePoints;
+ int numPoints, result;
+ double radius, width;
+ Tk_State state = itemPtr->state;
+
+ if (state == TK_STATE_NULL) {
+ state = Canvas(canvas)->canvas_state;
+ }
+ width = linePtr->outline.width;
+ if (Canvas(canvas)->currentItemPtr == itemPtr) {
+ if (linePtr->outline.activeWidth > width) {
+ width = linePtr->outline.activeWidth;
+ }
+ } else if (state == TK_STATE_DISABLED) {
+ if (linePtr->outline.disabledWidth > 0) {
+ width = linePtr->outline.disabledWidth;
+ }
+ }
+
+ radius = (width+1.0)/2.0;
+
+ if ((state == TK_STATE_HIDDEN) || !linePtr->numPoints) {
+ return -1;
+ } else if (linePtr->numPoints == 1) {
+ double oval[4];
+
+ oval[0] = linePtr->coordPtr[0]-radius;
+ oval[1] = linePtr->coordPtr[1]-radius;
+ oval[2] = linePtr->coordPtr[0]+radius;
+ oval[3] = linePtr->coordPtr[1]+radius;
+ return TkOvalToArea(oval, rectPtr);
+ }
+
+ /*
+ * Handle smoothed lines by generating an expanded set of points against
+ * which to do the check.
+ */
+
+ if ((linePtr->smooth) && (linePtr->numPoints > 2)) {
+ numPoints = linePtr->smooth->coordProc(canvas, NULL,
+ linePtr->numPoints, linePtr->splineSteps, NULL, NULL);
+ if (numPoints <= MAX_STATIC_POINTS) {
+ linePoints = staticSpace;
+ } else {
+ linePoints = ckalloc(2 * numPoints * sizeof(double));
+ }
+ numPoints = linePtr->smooth->coordProc(canvas, linePtr->coordPtr,
+ linePtr->numPoints, linePtr->splineSteps, NULL, linePoints);
+ } else {
+ numPoints = linePtr->numPoints;
+ linePoints = linePtr->coordPtr;
+ }
+
+ /*
+ * Check the segments of the line.
+ */
+
+ if (width < 1.0) {
+ width = 1.0;
+ }
+
+ result = TkThickPolyLineToArea(linePoints, numPoints, width,
+ linePtr->capStyle, linePtr->joinStyle, rectPtr);
+ if (result == 0) {
+ goto done;
+ }
+
+ /*
+ * Check arrowheads, if any.
+ */
+
+ if (linePtr->arrow != ARROWS_NONE) {
+ if (linePtr->arrow != ARROWS_LAST) {
+ if (TkPolygonToArea(linePtr->firstArrowPtr, PTS_IN_ARROW,
+ rectPtr) != result) {
+ result = 0;
+ goto done;
+ }
+ }
+ if (linePtr->arrow != ARROWS_FIRST) {
+ if (TkPolygonToArea(linePtr->lastArrowPtr, PTS_IN_ARROW,
+ rectPtr) != result) {
+ result = 0;
+ goto done;
+ }
+ }
+ }
+
+ done:
+ if ((linePoints != staticSpace) && (linePoints != linePtr->coordPtr)) {
+ ckfree(linePoints);
+ }
+ return result;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * ScaleLine --
+ *
+ * This function is invoked to rescale a line item.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The line referred to by itemPtr is rescaled so that the following
+ * transformation is applied to all point coordinates:
+ * x' = originX + scaleX*(x-originX)
+ * y' = originY + scaleY*(y-originY)
+ *
+ *--------------------------------------------------------------
+ */
+
+static void
+ScaleLine(
+ Tk_Canvas canvas, /* Canvas containing line. */
+ Tk_Item *itemPtr, /* Line to be scaled. */
+ double originX, double originY,
+ /* Origin about which to scale rect. */
+ double scaleX, /* Amount to scale in X direction. */
+ double scaleY) /* Amount to scale in Y direction. */
+{
+ LineItem *linePtr = (LineItem *) itemPtr;
+ double *coordPtr;
+ int i;
+
+ /*
+ * Delete any arrowheads before scaling all the points (so that the
+ * end-points of the line get restored).
+ */
+
+ if (linePtr->firstArrowPtr != NULL) {
+ linePtr->coordPtr[0] = linePtr->firstArrowPtr[0];
+ linePtr->coordPtr[1] = linePtr->firstArrowPtr[1];
+ ckfree(linePtr->firstArrowPtr);
+ linePtr->firstArrowPtr = NULL;
+ }
+ if (linePtr->lastArrowPtr != NULL) {
+ int i;
+
+ i = 2*(linePtr->numPoints-1);
+ linePtr->coordPtr[i] = linePtr->lastArrowPtr[0];
+ linePtr->coordPtr[i+1] = linePtr->lastArrowPtr[1];
+ ckfree(linePtr->lastArrowPtr);
+ linePtr->lastArrowPtr = NULL;
+ }
+ for (i = 0, coordPtr = linePtr->coordPtr; i < linePtr->numPoints;
+ i++, coordPtr += 2) {
+ coordPtr[0] = originX + scaleX*(*coordPtr - originX);
+ coordPtr[1] = originY + scaleY*(coordPtr[1] - originY);
+ }
+ if (linePtr->arrow != ARROWS_NONE) {
+ ConfigureArrows(canvas, linePtr);
+ }
+ ComputeLineBbox(canvas, linePtr);
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * GetLineIndex --
+ *
+ * Parse an index into a line item and return either its value or an
+ * error.
+ *
+ * Results:
+ * A standard Tcl result. If all went well, then *indexPtr is filled in
+ * with the index (into itemPtr) corresponding to string. Otherwise an
+ * error message is left in interp->result.
+ *
+ * Side effects:
+ * None.
+ *
+ *--------------------------------------------------------------
+ */
+
+static int
+GetLineIndex(
+ 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;
+ const char *string = Tcl_GetString(obj);
+
+ if (string[0] == 'e') {
+ if (strncmp(string, "end", obj->length) == 0) {
+ *indexPtr = 2*linePtr->numPoints;
+ } else {
+ goto badIndex;
+ }
+ } else if (string[0] == '@') {
+ int i;
+ double x, y, bestDist, dist, *coordPtr;
+ char *end;
+ const char *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;
+
+ /*
+ * Some of the paths here leave messages in interp->result, so we have to
+ * clear it out before storing our own message.
+ */
+
+ badIndex:
+ Tcl_ResetResult(interp);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf("bad index \"%s\"", string));
+ Tcl_SetErrorCode(interp, "TK", "CANVAS", "ITEM_INDEX", "LINE", NULL);
+ return TCL_ERROR;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * TranslateLine --
+ *
+ * This function is called to move a line by a given amount.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The position of the line is offset by (xDelta, yDelta), and the
+ * bounding box is updated in the generic part of the item structure.
+ *
+ *--------------------------------------------------------------
+ */
+
+static void
+TranslateLine(
+ Tk_Canvas canvas, /* Canvas containing item. */
+ Tk_Item *itemPtr, /* Item that is being moved. */
+ double deltaX, double deltaY)
+ /* Amount by which item is to be moved. */
+{
+ LineItem *linePtr = (LineItem *) itemPtr;
+ double *coordPtr;
+ int i;
+
+ for (i = 0, coordPtr = linePtr->coordPtr; i < linePtr->numPoints;
+ i++, coordPtr += 2) {
+ coordPtr[0] += deltaX;
+ coordPtr[1] += deltaY;
+ }
+ if (linePtr->firstArrowPtr != NULL) {
+ for (i = 0, coordPtr = linePtr->firstArrowPtr; i < PTS_IN_ARROW;
+ i++, coordPtr += 2) {
+ coordPtr[0] += deltaX;
+ coordPtr[1] += deltaY;
+ }
+ }
+ if (linePtr->lastArrowPtr != NULL) {
+ for (i = 0, coordPtr = linePtr->lastArrowPtr; i < PTS_IN_ARROW;
+ i++, coordPtr += 2) {
+ coordPtr[0] += deltaX;
+ coordPtr[1] += deltaY;
+ }
+ }
+ ComputeLineBbox(canvas, linePtr);
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * ParseArrowShape --
+ *
+ * This function is called back during option parsing to parse arrow
+ * shape information.
+ *
+ * Results:
+ * The return value is a standard Tcl result: TCL_OK means that the arrow
+ * shape information was parsed ok, and TCL_ERROR means it couldn't be
+ * parsed.
+ *
+ * Side effects:
+ * Arrow information in recordPtr is updated.
+ *
+ *--------------------------------------------------------------
+ */
+
+ /* ARGSUSED */
+static int
+ParseArrowShape(
+ ClientData clientData, /* Not used. */
+ Tcl_Interp *interp, /* Used for error reporting. */
+ Tk_Window tkwin, /* Not used. */
+ const char *value, /* Textual specification of arrow shape. */
+ char *recordPtr, /* Pointer to item record in which to store
+ * arrow information. */
+ int offset) /* Offset of shape information in widget
+ * record. */
+{
+ LineItem *linePtr = (LineItem *) recordPtr;
+ double a, b, c;
+ int argc;
+ const char **argv = NULL;
+
+ if (offset != Tk_Offset(LineItem, arrowShapeA)) {
+ Tcl_Panic("ParseArrowShape received bogus offset");
+ }
+
+ if (Tcl_SplitList(interp, (char *) value, &argc, &argv) != TCL_OK) {
+ goto syntaxError;
+ } else if (argc != 3) {
+ goto syntaxError;
+ }
+ if ((Tk_CanvasGetCoord(interp, linePtr->canvas, argv[0], &a) != TCL_OK)
+ || (Tk_CanvasGetCoord(interp, linePtr->canvas, argv[1], &b)
+ != TCL_OK)
+ || (Tk_CanvasGetCoord(interp, linePtr->canvas, argv[2], &c)
+ != TCL_OK)) {
+ goto syntaxError;
+ }
+
+ linePtr->arrowShapeA = (float) a;
+ linePtr->arrowShapeB = (float) b;
+ linePtr->arrowShapeC = (float) c;
+ ckfree(argv);
+ return TCL_OK;
+
+ syntaxError:
+ Tcl_ResetResult(interp);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "bad arrow shape \"%s\": must be list with three numbers",
+ value));
+ Tcl_SetErrorCode(interp, "TK", "CANVAS", "ARROW_SHAPE", NULL);
+ if (argv != NULL) {
+ ckfree(argv);
+ }
+ return TCL_ERROR;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * PrintArrowShape --
+ *
+ * This function is a callback invoked by the configuration code to
+ * return a printable value describing an arrow shape.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * None.
+ *
+ *--------------------------------------------------------------
+ */
+
+ /* ARGSUSED */
+static const char *
+PrintArrowShape(
+ ClientData clientData, /* Not used. */
+ Tk_Window tkwin, /* Window associated with linePtr's widget. */
+ char *recordPtr, /* Pointer to item record containing current
+ * shape information. */
+ int offset, /* Offset of arrow information in record. */
+ Tcl_FreeProc **freeProcPtr) /* Store address of function to call to free
+ * string here. */
+{
+ LineItem *linePtr = (LineItem *) recordPtr;
+ char *buffer = ckalloc(120);
+
+ sprintf(buffer, "%.5g %.5g %.5g", linePtr->arrowShapeA,
+ linePtr->arrowShapeB, linePtr->arrowShapeC);
+ *freeProcPtr = TCL_DYNAMIC;
+ return buffer;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * ArrowParseProc --
+ *
+ * This function 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 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_SetObjResult(interp, Tcl_ObjPrintf(
+ "bad arrow spec \"%s\": must be none, first, last, or both",
+ value));
+ Tcl_SetErrorCode(interp, "TK", "CANVAS", "ARROW", NULL);
+ *arrowPtr = ARROWS_NONE;
+ return TCL_ERROR;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * ArrowPrintProc --
+ *
+ * This function 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 function 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 const char *
+ArrowPrintProc(
+ ClientData clientData, /* Ignored. */
+ Tk_Window tkwin, /* Window containing canvas widget. */
+ char *widgRec, /* Pointer to record for item. */
+ int offset, /* Offset into item. */
+ Tcl_FreeProc **freeProcPtr) /* Pointer to variable to fill in with
+ * information about how to reclaim storage
+ * for return string. */
+{
+ register Arrows *arrowPtr = (Arrows *) (widgRec + offset);
+
+ switch (*arrowPtr) {
+ case ARROWS_FIRST:
+ return "first";
+ case ARROWS_LAST:
+ return "last";
+ case ARROWS_BOTH:
+ return "both";
+ default:
+ return "none";
+ }
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * ConfigureArrows --
+ *
+ * If arrowheads have been requested for a line, this function makes
+ * arrangements for the arrowheads.
+ *
+ * Results:
+ * Always returns TCL_OK.
+ *
+ * Side effects:
+ * Information in linePtr is set up for one or two arrowheads. The
+ * firstArrowPtr and lastArrowPtr polygons are allocated and initialized,
+ * if need be, and the end points of the line are adjusted so that a
+ * thick line doesn't stick out past the arrowheads.
+ *
+ *--------------------------------------------------------------
+ */
+
+ /* ARGSUSED */
+static int
+ConfigureArrows(
+ Tk_Canvas canvas, /* Canvas in which arrows will be displayed
+ * (interp and tkwin fields are needed). */
+ LineItem *linePtr) /* Item to configure for arrows. */
+{
+ double *poly, *coordPtr;
+ double dx, dy, length, sinTheta, cosTheta, temp;
+ double fracHeight; /* Line width as fraction of arrowhead
+ * width. */
+ double backup; /* Distance to backup end points so the line
+ * ends in the middle of the arrowhead. */
+ double vertX, vertY; /* Position of arrowhead vertex. */
+ double shapeA, shapeB, shapeC;
+ /* Adjusted coordinates (see explanation
+ * below). */
+ double width;
+ Tk_State state = linePtr->header.state;
+
+ if (linePtr->numPoints < 2) {
+ return TCL_OK;
+ }
+
+ if (state == TK_STATE_NULL) {
+ state = Canvas(canvas)->canvas_state;
+ }
+
+ width = linePtr->outline.width;
+ if (Canvas(canvas)->currentItemPtr == (Tk_Item *)linePtr) {
+ if (linePtr->outline.activeWidth > width) {
+ width = linePtr->outline.activeWidth;
+ }
+ } else if (state == TK_STATE_DISABLED) {
+ if (linePtr->outline.disabledWidth > 0) {
+ width = linePtr->outline.disabledWidth;
+ }
+ }
+
+ /*
+ * The code below makes a tiny increase in the shape parameters for the
+ * line. This is a bit of a hack, but it seems to result in displays that
+ * more closely approximate the specified parameters. Without the
+ * adjustment, the arrows come out smaller than expected.
+ */
+
+ shapeA = linePtr->arrowShapeA + 0.001;
+ shapeB = linePtr->arrowShapeB + 0.001;
+ shapeC = linePtr->arrowShapeC + width/2.0 + 0.001;
+
+ /*
+ * If there's an arrowhead on the first point of the line, compute its
+ * polygon and adjust the first point of the line so that the line doesn't
+ * stick out past the leading edge of the arrowhead.
+ */
+
+ fracHeight = (width/2.0)/shapeC;
+ backup = fracHeight*shapeB + shapeA*(1.0 - fracHeight)/2.0;
+ if (linePtr->arrow != ARROWS_LAST) {
+ poly = linePtr->firstArrowPtr;
+ if (poly == NULL) {
+ poly = ckalloc(2 * PTS_IN_ARROW * sizeof(double));
+ poly[0] = poly[10] = linePtr->coordPtr[0];
+ poly[1] = poly[11] = linePtr->coordPtr[1];
+ linePtr->firstArrowPtr = poly;
+ }
+ dx = poly[0] - linePtr->coordPtr[2];
+ dy = poly[1] - linePtr->coordPtr[3];
+ length = hypot(dx, dy);
+ if (length == 0) {
+ sinTheta = cosTheta = 0.0;
+ } else {
+ sinTheta = dy/length;
+ cosTheta = dx/length;
+ }
+ vertX = poly[0] - shapeA*cosTheta;
+ vertY = poly[1] - shapeA*sinTheta;
+ temp = shapeC*sinTheta;
+ poly[2] = poly[0] - shapeB*cosTheta + temp;
+ poly[8] = poly[2] - 2*temp;
+ temp = shapeC*cosTheta;
+ poly[3] = poly[1] - shapeB*sinTheta - temp;
+ poly[9] = poly[3] + 2*temp;
+ poly[4] = poly[2]*fracHeight + vertX*(1.0-fracHeight);
+ poly[5] = poly[3]*fracHeight + vertY*(1.0-fracHeight);
+ poly[6] = poly[8]*fracHeight + vertX*(1.0-fracHeight);
+ poly[7] = poly[9]*fracHeight + vertY*(1.0-fracHeight);
+
+ /*
+ * Polygon done. Now move the first point towards the second so that
+ * the corners at the end of the line are inside the arrowhead.
+ */
+
+ linePtr->coordPtr[0] = poly[0] - backup*cosTheta;
+ linePtr->coordPtr[1] = poly[1] - backup*sinTheta;
+ }
+
+ /*
+ * Similar arrowhead calculation for the last point of the line.
+ */
+
+ if (linePtr->arrow != ARROWS_FIRST) {
+ coordPtr = linePtr->coordPtr + 2*(linePtr->numPoints-2);
+ poly = linePtr->lastArrowPtr;
+ if (poly == NULL) {
+ poly = ckalloc(2 * PTS_IN_ARROW * sizeof(double));
+ poly[0] = poly[10] = coordPtr[2];
+ poly[1] = poly[11] = coordPtr[3];
+ linePtr->lastArrowPtr = poly;
+ }
+ dx = poly[0] - coordPtr[0];
+ dy = poly[1] - coordPtr[1];
+ length = hypot(dx, dy);
+ if (length == 0) {
+ sinTheta = cosTheta = 0.0;
+ } else {
+ sinTheta = dy/length;
+ cosTheta = dx/length;
+ }
+ vertX = poly[0] - shapeA*cosTheta;
+ vertY = poly[1] - shapeA*sinTheta;
+ temp = shapeC * sinTheta;
+ poly[2] = poly[0] - shapeB*cosTheta + temp;
+ poly[8] = poly[2] - 2*temp;
+ temp = shapeC * cosTheta;
+ poly[3] = poly[1] - shapeB*sinTheta - temp;
+ poly[9] = poly[3] + 2*temp;
+ poly[4] = poly[2]*fracHeight + vertX*(1.0-fracHeight);
+ poly[5] = poly[3]*fracHeight + vertY*(1.0-fracHeight);
+ poly[6] = poly[8]*fracHeight + vertX*(1.0-fracHeight);
+ poly[7] = poly[9]*fracHeight + vertY*(1.0-fracHeight);
+ coordPtr[2] = poly[0] - backup*cosTheta;
+ coordPtr[3] = poly[1] - backup*sinTheta;
+ }
+
+ return TCL_OK;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * LineToPostscript --
+ *
+ * This function is called to generate Postscript for line items.
+ *
+ * Results:
+ * The return value is a standard Tcl result. If an error occurs in
+ * generating Postscript then an error message is left in the interp's
+ * result, replacing whatever used to be there. If no error occurs, then
+ * Postscript for the item is appended to the result.
+ *
+ * Side effects:
+ * None.
+ *
+ *--------------------------------------------------------------
+ */
+
+static int
+LineToPostscript(
+ Tcl_Interp *interp, /* Leave Postscript or error message here. */
+ Tk_Canvas canvas, /* Information about overall canvas. */
+ Tk_Item *itemPtr, /* Item for which Postscript is wanted. */
+ int prepass) /* 1 means this is a prepass to collect font
+ * information; 0 means final Postscript is
+ * being created. */
+{
+ LineItem *linePtr = (LineItem *) itemPtr;
+ int style;
+ double width;
+ XColor *color;
+ Pixmap stipple;
+ Tk_State state = itemPtr->state;
+ Tcl_Obj *psObj;
+ Tcl_InterpState interpState;
+
+ if (state == TK_STATE_NULL) {
+ state = Canvas(canvas)->canvas_state;
+ }
+
+ width = linePtr->outline.width;
+ color = linePtr->outline.color;
+ stipple = linePtr->outline.stipple;
+ if (Canvas(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;
+ }
+
+ /*
+ * Make our working space.
+ */
+
+ psObj = Tcl_NewObj();
+ interpState = Tcl_SaveInterpState(interp, TCL_OK);
+
+ /*
+ * Check if we're just doing a "pixel".
+ */
+
+ if (linePtr->numPoints == 1) {
+ Tcl_AppendToObj(psObj, "matrix currentmatrix\n", -1);
+ Tcl_AppendPrintfToObj(psObj, "%.15g %.15g translate %.15g %.15g",
+ linePtr->coordPtr[0], Tk_CanvasPsY(canvas, linePtr->coordPtr[1]),
+ width/2.0, width/2.0);
+ Tcl_AppendToObj(psObj,
+ " scale 1 0 moveto 0 0 1 0 360 arc\nsetmatrix\n", -1);
+
+ Tcl_ResetResult(interp);
+ if (Tk_CanvasPsColor(interp, canvas, color) != TCL_OK) {
+ goto error;
+ }
+ Tcl_AppendObjToObj(psObj, Tcl_GetObjResult(interp));
+
+ if (stipple != None) {
+ Tcl_AppendToObj(psObj, "clip ", -1);
+ Tcl_ResetResult(interp);
+ if (Tk_CanvasPsStipple(interp, canvas, stipple) != TCL_OK) {
+ goto error;
+ }
+ Tcl_AppendObjToObj(psObj, Tcl_GetObjResult(interp));
+ } else {
+ Tcl_AppendToObj(psObj, "fill\n", -1);
+ }
+ goto done;
+ }
+
+ /*
+ * Generate a path for the line's center-line (do this differently for
+ * straight lines and smoothed lines).
+ */
+
+ Tcl_ResetResult(interp);
+ if ((!linePtr->smooth) || (linePtr->numPoints < 3)) {
+ Tk_CanvasPsPath(interp, canvas, linePtr->coordPtr, linePtr->numPoints);
+ } else if ((stipple == None) && linePtr->smooth->postscriptProc) {
+ linePtr->smooth->postscriptProc(interp, canvas, linePtr->coordPtr,
+ linePtr->numPoints, linePtr->splineSteps);
+ } else {
+ /*
+ * Special hack: Postscript printers don't appear to be able to turn a
+ * path drawn with "curveto"s into a clipping path without exceeding
+ * resource limits, so TkMakeBezierPostscript won't work for stippled
+ * curves. Instead, generate all of the intermediate points here and
+ * output them into the Postscript file with "lineto"s instead.
+ */
+
+ double staticPoints[2*MAX_STATIC_POINTS];
+ double *pointPtr;
+ int numPoints;
+
+ numPoints = linePtr->smooth->coordProc(canvas, NULL,
+ linePtr->numPoints, linePtr->splineSteps, NULL, NULL);
+ pointPtr = staticPoints;
+ if (numPoints > MAX_STATIC_POINTS) {
+ pointPtr = ckalloc(numPoints * 2 * sizeof(double));
+ }
+ numPoints = linePtr->smooth->coordProc(canvas, linePtr->coordPtr,
+ linePtr->numPoints, linePtr->splineSteps, NULL, pointPtr);
+ Tk_CanvasPsPath(interp, canvas, pointPtr, numPoints);
+ if (pointPtr != staticPoints) {
+ ckfree(pointPtr);
+ }
+ }
+ Tcl_AppendObjToObj(psObj, Tcl_GetObjResult(interp));
+
+ /*
+ * Set other line-drawing parameters and stroke out the line.
+ */
+
+ if (linePtr->capStyle == CapRound) {
+ style = 1;
+ } else if (linePtr->capStyle == CapProjecting) {
+ style = 2;
+ } else {
+ style = 0;
+ }
+ Tcl_AppendPrintfToObj(psObj, "%d setlinecap\n", style);
+ if (linePtr->joinStyle == JoinRound) {
+ style = 1;
+ } else if (linePtr->joinStyle == JoinBevel) {
+ style = 2;
+ } else {
+ style = 0;
+ }
+ Tcl_AppendPrintfToObj(psObj, "%d setlinejoin\n", style);
+
+ Tcl_ResetResult(interp);
+ if (Tk_CanvasPsOutline(canvas, itemPtr, &linePtr->outline) != TCL_OK) {
+ goto error;
+ }
+ Tcl_AppendObjToObj(psObj, Tcl_GetObjResult(interp));
+
+ /*
+ * Output polygons for the arrowheads, if there are any.
+ */
+
+ if (linePtr->firstArrowPtr != NULL) {
+ if (stipple != None) {
+ Tcl_AppendToObj(psObj, "grestore gsave\n", -1);
+ }
+ if (ArrowheadPostscript(interp, canvas, linePtr,
+ linePtr->firstArrowPtr, psObj) != TCL_OK) {
+ goto error;
+ }
+ }
+ if (linePtr->lastArrowPtr != NULL) {
+ if (stipple != None) {
+ Tcl_AppendToObj(psObj, "grestore gsave\n", -1);
+ }
+ if (ArrowheadPostscript(interp, canvas, linePtr,
+ linePtr->lastArrowPtr, psObj) != TCL_OK) {
+ goto error;
+ }
+ }
+
+ /*
+ * Plug the accumulated postscript back into the result.
+ */
+
+ done:
+ (void) Tcl_RestoreInterpState(interp, interpState);
+ Tcl_AppendObjToObj(Tcl_GetObjResult(interp), psObj);
+ Tcl_DecrRefCount(psObj);
+ return TCL_OK;
+
+ error:
+ Tcl_DiscardInterpState(interpState);
+ Tcl_DecrRefCount(psObj);
+ return TCL_ERROR;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * ArrowheadPostscript --
+ *
+ * This function is called to generate Postscript for an arrowhead for a
+ * line item.
+ *
+ * Results:
+ * The return value is a standard Tcl result. If an error occurs in
+ * generating Postscript then an error message is left in the interp's
+ * result, replacing whatever used to be there. If no error occurs, then
+ * Postscript for the arrowhead is appended to the given object.
+ *
+ * Side effects:
+ * None.
+ *
+ *--------------------------------------------------------------
+ */
+
+static int
+ArrowheadPostscript(
+ Tcl_Interp *interp, /* Leave error message here; non-error results
+ * will be discarded by caller. */
+ Tk_Canvas canvas, /* Information about overall canvas. */
+ LineItem *linePtr, /* Line item for which Postscript is being
+ * generated. */
+ double *arrowPtr, /* Pointer to first of five points describing
+ * arrowhead polygon. */
+ Tcl_Obj *psObj) /* Append postscript to this object. */
+{
+ Pixmap stipple;
+ Tk_State state = linePtr->header.state;
+
+ if (state == TK_STATE_NULL) {
+ state = Canvas(canvas)->canvas_state;
+ }
+
+ stipple = linePtr->outline.stipple;
+ if (Canvas(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;
+ }
+ }
+
+ Tcl_ResetResult(interp);
+ Tk_CanvasPsPath(interp, canvas, arrowPtr, PTS_IN_ARROW);
+ Tcl_AppendObjToObj(psObj, Tcl_GetObjResult(interp));
+
+ if (stipple != None) {
+ Tcl_AppendToObj(psObj, "clip ", -1);
+
+ Tcl_ResetResult(interp);
+ if (Tk_CanvasPsStipple(interp, canvas, stipple) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ Tcl_AppendObjToObj(psObj, Tcl_GetObjResult(interp));
+ } else {
+ Tcl_AppendToObj(psObj, "fill\n", -1);
+ }
+ return TCL_OK;
+}
+
+/*
+ * Local Variables:
+ * mode: c
+ * c-basic-offset: 4
+ * fill-column: 78
+ * End:
+ */
diff --git a/tk8.6/generic/tkCanvPoly.c b/tk8.6/generic/tkCanvPoly.c
new file mode 100644
index 0000000..b4ef098
--- /dev/null
+++ b/tk8.6/generic/tkCanvPoly.c
@@ -0,0 +1,1999 @@
+/*
+ * tkCanvPoly.c --
+ *
+ * This file implements polygon items for canvas widgets.
+ *
+ * Copyright (c) 1991-1994 The Regents of the University of California.
+ * Copyright (c) 1994-1997 Sun Microsystems, Inc.
+ * Copyright (c) 1998-2000 Ajuba Solutions.
+ *
+ * See the file "license.terms" for information on usage and redistribution of
+ * this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ */
+
+#include "tkInt.h"
+#include "tkCanvas.h"
+
+/*
+ * The structure below defines the record for each polygon item.
+ */
+
+typedef struct PolygonItem {
+ Tk_Item header; /* Generic stuff that's the same for all
+ * types. MUST BE FIRST IN STRUCTURE. */
+ Tk_Outline outline; /* Outline structure */
+ int numPoints; /* Number of points in polygon. Polygon is
+ * always closed. */
+ int pointsAllocated; /* Number of points for which space is
+ * allocated at *coordPtr. */
+ double *coordPtr; /* Pointer to malloc-ed array containing x-
+ * and y-coords of all points in polygon.
+ * X-coords are even-valued indices, y-coords
+ * are corresponding odd-valued indices. */
+ int joinStyle; /* Join style for outline */
+ Tk_TSOffset tsoffset;
+ XColor *fillColor; /* Foreground color for polygon. */
+ XColor *activeFillColor; /* Foreground color for polygon if state is
+ * active. */
+ XColor *disabledFillColor; /* Foreground color for polygon if state is
+ * disabled. */
+ Pixmap fillStipple; /* Stipple bitmap for filling polygon. */
+ Pixmap activeFillStipple; /* Stipple bitmap for filling polygon if state
+ * is active. */
+ Pixmap disabledFillStipple; /* Stipple bitmap for filling polygon if state
+ * is disabled. */
+ GC fillGC; /* Graphics context for filling polygon. */
+ const Tk_SmoothMethod *smooth; /* Non-zero means draw shape smoothed (i.e.
+ * with Bezier splines). */
+ int splineSteps; /* Number of steps in each spline segment. */
+ int autoClosed; /* Zero means the given polygon was closed,
+ one means that we auto closed it. */
+} PolygonItem;
+
+/*
+ * Information used for parsing configuration specs:
+ */
+
+static const Tk_CustomOption smoothOption = {
+ TkSmoothParseProc, TkSmoothPrintProc, NULL
+};
+static const Tk_CustomOption stateOption = {
+ TkStateParseProc, TkStatePrintProc, INT2PTR(2)
+};
+static const Tk_CustomOption tagsOption = {
+ Tk_CanvasTagsParseProc, Tk_CanvasTagsPrintProc, NULL
+};
+static const Tk_CustomOption dashOption = {
+ TkCanvasDashParseProc, TkCanvasDashPrintProc, NULL
+};
+static const Tk_CustomOption offsetOption = {
+ TkOffsetParseProc, TkOffsetPrintProc,
+ INT2PTR(TK_OFFSET_RELATIVE|TK_OFFSET_INDEX)
+};
+static const Tk_CustomOption pixelOption = {
+ TkPixelParseProc, TkPixelPrintProc, NULL
+};
+
+static const Tk_ConfigSpec configSpecs[] = {
+ {TK_CONFIG_CUSTOM, "-activedash", NULL, NULL,
+ NULL, Tk_Offset(PolygonItem, outline.activeDash),
+ TK_CONFIG_NULL_OK, &dashOption},
+ {TK_CONFIG_COLOR, "-activefill", NULL, NULL,
+ NULL, Tk_Offset(PolygonItem, activeFillColor), TK_CONFIG_NULL_OK, NULL},
+ {TK_CONFIG_COLOR, "-activeoutline", NULL, NULL,
+ NULL, Tk_Offset(PolygonItem, outline.activeColor), TK_CONFIG_NULL_OK, NULL},
+ {TK_CONFIG_BITMAP, "-activeoutlinestipple", NULL, NULL,
+ NULL, Tk_Offset(PolygonItem, outline.activeStipple),
+ TK_CONFIG_NULL_OK, NULL},
+ {TK_CONFIG_BITMAP, "-activestipple", NULL, NULL,
+ NULL, Tk_Offset(PolygonItem, activeFillStipple), TK_CONFIG_NULL_OK, NULL},
+ {TK_CONFIG_CUSTOM, "-activewidth", NULL, NULL,
+ "0.0", Tk_Offset(PolygonItem, outline.activeWidth),
+ TK_CONFIG_DONT_SET_DEFAULT, &pixelOption},
+ {TK_CONFIG_CUSTOM, "-dash", NULL, NULL,
+ NULL, Tk_Offset(PolygonItem, outline.dash),
+ TK_CONFIG_NULL_OK, &dashOption},
+ {TK_CONFIG_PIXELS, "-dashoffset", NULL, NULL,
+ "0", Tk_Offset(PolygonItem, outline.offset),
+ TK_CONFIG_DONT_SET_DEFAULT, NULL},
+ {TK_CONFIG_CUSTOM, "-disableddash", NULL, NULL,
+ NULL, Tk_Offset(PolygonItem, outline.disabledDash),
+ TK_CONFIG_NULL_OK, &dashOption},
+ {TK_CONFIG_COLOR, "-disabledfill", NULL, NULL,
+ NULL, Tk_Offset(PolygonItem, disabledFillColor), TK_CONFIG_NULL_OK, NULL},
+ {TK_CONFIG_COLOR, "-disabledoutline", NULL, NULL,
+ NULL, Tk_Offset(PolygonItem, outline.disabledColor),
+ TK_CONFIG_NULL_OK, NULL},
+ {TK_CONFIG_BITMAP, "-disabledoutlinestipple", NULL, NULL,
+ NULL, Tk_Offset(PolygonItem, outline.disabledStipple),
+ TK_CONFIG_NULL_OK, NULL},
+ {TK_CONFIG_BITMAP, "-disabledstipple", NULL, NULL,
+ NULL, Tk_Offset(PolygonItem, disabledFillStipple), TK_CONFIG_NULL_OK, NULL},
+ {TK_CONFIG_CUSTOM, "-disabledwidth", NULL, NULL,
+ "0.0", Tk_Offset(PolygonItem, outline.disabledWidth),
+ TK_CONFIG_DONT_SET_DEFAULT, &pixelOption},
+ {TK_CONFIG_COLOR, "-fill", NULL, NULL,
+ "black", Tk_Offset(PolygonItem, fillColor), TK_CONFIG_NULL_OK, NULL},
+ {TK_CONFIG_JOIN_STYLE, "-joinstyle", NULL, NULL,
+ "round", Tk_Offset(PolygonItem, joinStyle), TK_CONFIG_DONT_SET_DEFAULT, NULL},
+ {TK_CONFIG_CUSTOM, "-offset", NULL, NULL,
+ "0,0", Tk_Offset(PolygonItem, tsoffset),
+ TK_CONFIG_NULL_OK, &offsetOption},
+ {TK_CONFIG_COLOR, "-outline", NULL, NULL,
+ NULL, Tk_Offset(PolygonItem, outline.color), TK_CONFIG_NULL_OK, NULL},
+ {TK_CONFIG_CUSTOM, "-outlineoffset", NULL, NULL,
+ "0,0", Tk_Offset(PolygonItem, outline.tsoffset),
+ TK_CONFIG_NULL_OK, &offsetOption},
+ {TK_CONFIG_BITMAP, "-outlinestipple", NULL, NULL,
+ NULL, Tk_Offset(PolygonItem, outline.stipple), TK_CONFIG_NULL_OK, NULL},
+ {TK_CONFIG_CUSTOM, "-smooth", NULL, NULL,
+ "0", Tk_Offset(PolygonItem, smooth),
+ TK_CONFIG_DONT_SET_DEFAULT, &smoothOption},
+ {TK_CONFIG_INT, "-splinesteps", NULL, NULL,
+ "12", Tk_Offset(PolygonItem, splineSteps), TK_CONFIG_DONT_SET_DEFAULT, NULL},
+ {TK_CONFIG_CUSTOM, "-state", NULL, NULL,
+ NULL, Tk_Offset(Tk_Item, state), TK_CONFIG_NULL_OK, &stateOption},
+ {TK_CONFIG_BITMAP, "-stipple", NULL, NULL,
+ NULL, Tk_Offset(PolygonItem, fillStipple), TK_CONFIG_NULL_OK, NULL},
+ {TK_CONFIG_CUSTOM, "-tags", NULL, NULL,
+ NULL, 0, TK_CONFIG_NULL_OK, &tagsOption},
+ {TK_CONFIG_CUSTOM, "-width", NULL, NULL,
+ "1.0", Tk_Offset(PolygonItem, outline.width),
+ TK_CONFIG_DONT_SET_DEFAULT, &pixelOption},
+ {TK_CONFIG_END, NULL, NULL, NULL, NULL, 0, 0, NULL}
+};
+
+/*
+ * Prototypes for functions defined in this file:
+ */
+
+static void ComputePolygonBbox(Tk_Canvas canvas,
+ PolygonItem *polyPtr);
+static int ConfigurePolygon(Tcl_Interp *interp,
+ Tk_Canvas canvas, Tk_Item *itemPtr, int objc,
+ Tcl_Obj *const objv[], int flags);
+static int CreatePolygon(Tcl_Interp *interp,
+ Tk_Canvas canvas, struct Tk_Item *itemPtr,
+ int objc, Tcl_Obj *const objv[]);
+static void DeletePolygon(Tk_Canvas canvas,
+ Tk_Item *itemPtr, Display *display);
+static void DisplayPolygon(Tk_Canvas canvas,
+ Tk_Item *itemPtr, Display *display, Drawable dst,
+ int x, int y, int width, int height);
+static int GetPolygonIndex(Tcl_Interp *interp,
+ Tk_Canvas canvas, Tk_Item *itemPtr,
+ Tcl_Obj *obj, int *indexPtr);
+static int PolygonCoords(Tcl_Interp *interp,
+ Tk_Canvas canvas, Tk_Item *itemPtr,
+ int objc, Tcl_Obj *const objv[]);
+static void PolygonDeleteCoords(Tk_Canvas canvas,
+ Tk_Item *itemPtr, int first, int last);
+static void PolygonInsert(Tk_Canvas canvas,
+ Tk_Item *itemPtr, int beforeThis, Tcl_Obj *obj);
+static int PolygonToArea(Tk_Canvas canvas,
+ Tk_Item *itemPtr, double *rectPtr);
+static double PolygonToPoint(Tk_Canvas canvas,
+ Tk_Item *itemPtr, double *pointPtr);
+static int PolygonToPostscript(Tcl_Interp *interp,
+ Tk_Canvas canvas, Tk_Item *itemPtr, int prepass);
+static void ScalePolygon(Tk_Canvas canvas,
+ Tk_Item *itemPtr, double originX, double originY,
+ double scaleX, double scaleY);
+static void TranslatePolygon(Tk_Canvas canvas,
+ Tk_Item *itemPtr, double deltaX, double deltaY);
+
+/*
+ * The structures below defines the polygon item type by means of functions
+ * that can be invoked by generic item code.
+ */
+
+Tk_ItemType tkPolygonType = {
+ "polygon", /* name */
+ sizeof(PolygonItem), /* itemSize */
+ CreatePolygon, /* createProc */
+ configSpecs, /* configSpecs */
+ ConfigurePolygon, /* configureProc */
+ PolygonCoords, /* coordProc */
+ DeletePolygon, /* deleteProc */
+ DisplayPolygon, /* displayProc */
+ TK_CONFIG_OBJS | TK_MOVABLE_POINTS, /* flags */
+ PolygonToPoint, /* pointProc */
+ PolygonToArea, /* areaProc */
+ PolygonToPostscript, /* postscriptProc */
+ ScalePolygon, /* scaleProc */
+ TranslatePolygon, /* translateProc */
+ GetPolygonIndex, /* indexProc */
+ NULL, /* icursorProc */
+ NULL, /* selectionProc */
+ PolygonInsert, /* insertProc */
+ PolygonDeleteCoords, /* dTextProc */
+ NULL, /* nextPtr */
+ NULL, 0, NULL, NULL
+};
+
+/*
+ * The definition below determines how large are static arrays used to hold
+ * spline points (splines larger than this have to have their arrays
+ * malloc-ed).
+ */
+
+#define MAX_STATIC_POINTS 200
+
+/*
+ *--------------------------------------------------------------
+ *
+ * CreatePolygon --
+ *
+ * This function is invoked to create a new polygon item in a canvas.
+ *
+ * Results:
+ * A standard Tcl return value. If an error occurred in creating the
+ * item, then an error message is left in the interp's result; in this
+ * case itemPtr is left uninitialized, so it can be safely freed by the
+ * caller.
+ *
+ * Side effects:
+ * A new polygon item is created.
+ *
+ *--------------------------------------------------------------
+ */
+
+static int
+CreatePolygon(
+ Tcl_Interp *interp, /* Interpreter for error reporting. */
+ Tk_Canvas canvas, /* Canvas to hold new item. */
+ Tk_Item *itemPtr, /* Record to hold new item; header has been
+ * initialized by caller. */
+ int objc, /* Number of arguments in objv. */
+ Tcl_Obj *const objv[]) /* Arguments describing polygon. */
+{
+ PolygonItem *polyPtr = (PolygonItem *) itemPtr;
+ int i;
+
+ if (objc == 0) {
+ Tcl_Panic("canvas did not pass any coords");
+ }
+
+ /*
+ * Carry out initialization that is needed in order to clean up after
+ * errors during the the remainder of this function.
+ */
+
+ Tk_CreateOutline(&polyPtr->outline);
+ polyPtr->numPoints = 0;
+ polyPtr->pointsAllocated = 0;
+ polyPtr->coordPtr = NULL;
+ polyPtr->joinStyle = JoinRound;
+ polyPtr->tsoffset.flags = 0;
+ polyPtr->tsoffset.xoffset = 0;
+ polyPtr->tsoffset.yoffset = 0;
+ polyPtr->fillColor = NULL;
+ polyPtr->activeFillColor = NULL;
+ polyPtr->disabledFillColor = NULL;
+ polyPtr->fillStipple = None;
+ polyPtr->activeFillStipple = None;
+ polyPtr->disabledFillStipple = None;
+ polyPtr->fillGC = None;
+ polyPtr->smooth = NULL;
+ polyPtr->splineSteps = 12;
+ polyPtr->autoClosed = 0;
+
+ /*
+ * Count the number of points and then parse them into a point array.
+ * Leading arguments are assumed to be points if they start with a digit
+ * or a minus sign followed by a digit.
+ */
+
+ for (i = 0; i < objc; i++) {
+ const char *arg = Tcl_GetString(objv[i]);
+
+ if ((arg[0] == '-') && (arg[1] >= 'a') && (arg[1] <= 'z')) {
+ break;
+ }
+ }
+ if (i && PolygonCoords(interp, canvas, itemPtr, i, objv) != TCL_OK) {
+ goto error;
+ }
+
+ if (ConfigurePolygon(interp, canvas, itemPtr, objc-i, objv+i, 0)
+ == TCL_OK) {
+ return TCL_OK;
+ }
+
+ error:
+ DeletePolygon(canvas, itemPtr, Tk_Display(Tk_CanvasTkwin(canvas)));
+ return TCL_ERROR;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * PolygonCoords --
+ *
+ * This function is invoked to process the "coords" widget command on
+ * polygons. See the user documentation for details on what it does.
+ *
+ * Results:
+ * Returns TCL_OK or TCL_ERROR, and sets the interp's result.
+ *
+ * Side effects:
+ * The coordinates for the given item may be changed.
+ *
+ *--------------------------------------------------------------
+ */
+
+static int
+PolygonCoords(
+ Tcl_Interp *interp, /* Used for error reporting. */
+ Tk_Canvas canvas, /* Canvas containing item. */
+ Tk_Item *itemPtr, /* Item whose coordinates are to be read or
+ * modified. */
+ int objc, /* Number of coordinates supplied in objv. */
+ Tcl_Obj *const objv[]) /* Array of coordinates: x1, y1, x2, y2, ... */
+{
+ PolygonItem *polyPtr = (PolygonItem *) itemPtr;
+ int i, numPoints;
+
+ if (objc == 0) {
+ /*
+ * Print the coords used to create the polygon. If we auto closed the
+ * polygon then we don't report the last point.
+ */
+
+ Tcl_Obj *subobj, *obj = Tcl_NewObj();
+
+ for (i = 0; i < 2*(polyPtr->numPoints - polyPtr->autoClosed); i++) {
+ subobj = Tcl_NewDoubleObj(polyPtr->coordPtr[i]);
+ Tcl_ListObjAppendElement(interp, obj, subobj);
+ }
+ Tcl_SetObjResult(interp, obj);
+ return TCL_OK;
+ }
+ if (objc == 1) {
+ if (Tcl_ListObjGetElements(interp, objv[0], &objc,
+ (Tcl_Obj ***) &objv) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ }
+ if (objc & 1) {
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "wrong # coordinates: expected an even number, got %d",
+ objc));
+ Tcl_SetErrorCode(interp, "TK", "CANVAS", "COORDS", "POLYGON", NULL);
+ return TCL_ERROR;
+ }
+
+ numPoints = objc/2;
+ if (polyPtr->pointsAllocated <= numPoints) {
+ if (polyPtr->coordPtr != NULL) {
+ ckfree(polyPtr->coordPtr);
+ }
+
+ /*
+ * One extra point gets allocated here, because we always add
+ * another point to close the polygon.
+ */
+
+ polyPtr->coordPtr = ckalloc(sizeof(double) * (objc+2));
+ polyPtr->pointsAllocated = numPoints+1;
+ }
+ for (i = objc-1; i >= 0; i--) {
+ if (Tk_CanvasGetCoordFromObj(interp, canvas, objv[i],
+ &polyPtr->coordPtr[i]) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ }
+ polyPtr->numPoints = numPoints;
+ polyPtr->autoClosed = 0;
+
+ /*
+ * Close the polygon if it isn't already closed.
+ */
+
+ if (objc>2 && ((polyPtr->coordPtr[objc-2] != polyPtr->coordPtr[0])
+ || (polyPtr->coordPtr[objc-1] != polyPtr->coordPtr[1]))) {
+ polyPtr->autoClosed = 1;
+ polyPtr->numPoints++;
+ polyPtr->coordPtr[objc] = polyPtr->coordPtr[0];
+ polyPtr->coordPtr[objc+1] = polyPtr->coordPtr[1];
+ }
+
+ ComputePolygonBbox(canvas, polyPtr);
+ return TCL_OK;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * ConfigurePolygon --
+ *
+ * This function is invoked to configure various aspects of a polygon
+ * item such as its background color.
+ *
+ * Results:
+ * A standard Tcl result code. If an error occurs, then an error message
+ * is left in the interp's result.
+ *
+ * Side effects:
+ * Configuration information, such as colors and stipple patterns, may be
+ * set for itemPtr.
+ *
+ *--------------------------------------------------------------
+ */
+
+static int
+ConfigurePolygon(
+ Tcl_Interp *interp, /* Interpreter for error reporting. */
+ Tk_Canvas canvas, /* Canvas containing itemPtr. */
+ Tk_Item *itemPtr, /* Polygon item to reconfigure. */
+ int objc, /* Number of elements in objv. */
+ Tcl_Obj *const objv[], /* Arguments describing things to configure. */
+ int flags) /* Flags to pass to Tk_ConfigureWidget. */
+{
+ PolygonItem *polyPtr = (PolygonItem *) itemPtr;
+ XGCValues gcValues;
+ GC newGC;
+ unsigned long mask;
+ Tk_Window tkwin;
+ XColor *color;
+ Pixmap stipple;
+ Tk_State state;
+
+ tkwin = Tk_CanvasTkwin(canvas);
+ if (TCL_OK != Tk_ConfigureWidget(interp, tkwin, configSpecs, objc,
+ (const char **) objv, (char *) polyPtr, flags|TK_CONFIG_OBJS)) {
+ return TCL_ERROR;
+ }
+
+ /*
+ * A few of the options require additional processing, such as graphics
+ * contexts.
+ */
+
+ state = itemPtr->state;
+
+ if (polyPtr->outline.activeWidth > polyPtr->outline.width ||
+ polyPtr->outline.activeDash.number != 0 ||
+ polyPtr->outline.activeColor != NULL ||
+ polyPtr->outline.activeStipple != None ||
+ polyPtr->activeFillColor != NULL ||
+ polyPtr->activeFillStipple != None) {
+ itemPtr->redraw_flags |= TK_ITEM_STATE_DEPENDANT;
+ } else {
+ itemPtr->redraw_flags &= ~TK_ITEM_STATE_DEPENDANT;
+ }
+
+ if (state == TK_STATE_NULL) {
+ state = Canvas(canvas)->canvas_state;
+ }
+ if (state == TK_STATE_HIDDEN) {
+ ComputePolygonBbox(canvas, polyPtr);
+ return TCL_OK;
+ }
+
+ mask = Tk_ConfigOutlineGC(&gcValues, canvas, itemPtr, &polyPtr->outline);
+ if (mask) {
+ gcValues.cap_style = CapRound;
+ gcValues.join_style = polyPtr->joinStyle;
+ mask |= GCCapStyle|GCJoinStyle;
+ newGC = Tk_GetGC(tkwin, mask, &gcValues);
+ } else {
+ newGC = None;
+ }
+ if (polyPtr->outline.gc != None) {
+ Tk_FreeGC(Tk_Display(tkwin), polyPtr->outline.gc);
+ }
+ polyPtr->outline.gc = newGC;
+
+ color = polyPtr->fillColor;
+ stipple = polyPtr->fillStipple;
+ if (Canvas(canvas)->currentItemPtr == itemPtr) {
+ if (polyPtr->activeFillColor != NULL) {
+ color = polyPtr->activeFillColor;
+ }
+ if (polyPtr->activeFillStipple != None) {
+ stipple = polyPtr->activeFillStipple;
+ }
+ } else if (state == TK_STATE_DISABLED) {
+ if (polyPtr->disabledFillColor != NULL) {
+ color = polyPtr->disabledFillColor;
+ }
+ if (polyPtr->disabledFillStipple != None) {
+ stipple = polyPtr->disabledFillStipple;
+ }
+ }
+
+ if (color == NULL) {
+ newGC = None;
+ } else {
+ gcValues.foreground = color->pixel;
+ mask = GCForeground;
+ if (stipple != None) {
+ gcValues.stipple = stipple;
+ gcValues.fill_style = FillStippled;
+ mask |= GCStipple|GCFillStyle;
+ }
+#ifdef MAC_OSX_TK
+ /*
+ * Mac OS X CG drawing needs access to the outline linewidth
+ * even for fills (as linewidth controls antialiasing).
+ */
+ gcValues.line_width = polyPtr->outline.gc != None ?
+ polyPtr->outline.gc->line_width : 0;
+ mask |= GCLineWidth;
+#endif
+ newGC = Tk_GetGC(tkwin, mask, &gcValues);
+ }
+ if (polyPtr->fillGC != None) {
+ Tk_FreeGC(Tk_Display(tkwin), polyPtr->fillGC);
+ }
+ polyPtr->fillGC = newGC;
+
+ /*
+ * Keep spline parameters within reasonable limits.
+ */
+
+ if (polyPtr->splineSteps < 1) {
+ polyPtr->splineSteps = 1;
+ } else if (polyPtr->splineSteps > 100) {
+ polyPtr->splineSteps = 100;
+ }
+
+ ComputePolygonBbox(canvas, polyPtr);
+ return TCL_OK;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * DeletePolygon --
+ *
+ * This function is called to clean up the data structure associated with
+ * a polygon item.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Resources associated with itemPtr are released.
+ *
+ *--------------------------------------------------------------
+ */
+
+static void
+DeletePolygon(
+ Tk_Canvas canvas, /* Info about overall canvas widget. */
+ Tk_Item *itemPtr, /* Item that is being deleted. */
+ Display *display) /* Display containing window for canvas. */
+{
+ PolygonItem *polyPtr = (PolygonItem *) itemPtr;
+
+ Tk_DeleteOutline(display, &polyPtr->outline);
+ if (polyPtr->coordPtr != NULL) {
+ ckfree(polyPtr->coordPtr);
+ }
+ if (polyPtr->fillColor != NULL) {
+ Tk_FreeColor(polyPtr->fillColor);
+ }
+ if (polyPtr->activeFillColor != NULL) {
+ Tk_FreeColor(polyPtr->activeFillColor);
+ }
+ if (polyPtr->disabledFillColor != NULL) {
+ Tk_FreeColor(polyPtr->disabledFillColor);
+ }
+ if (polyPtr->fillStipple != None) {
+ Tk_FreeBitmap(display, polyPtr->fillStipple);
+ }
+ if (polyPtr->activeFillStipple != None) {
+ Tk_FreeBitmap(display, polyPtr->activeFillStipple);
+ }
+ if (polyPtr->disabledFillStipple != None) {
+ Tk_FreeBitmap(display, polyPtr->disabledFillStipple);
+ }
+ if (polyPtr->fillGC != None) {
+ Tk_FreeGC(display, polyPtr->fillGC);
+ }
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * ComputePolygonBbox --
+ *
+ * This function is invoked to compute the bounding box of all the pixels
+ * that may be drawn as part of a polygon.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The fields x1, y1, x2, and y2 are updated in the header for itemPtr.
+ *
+ *--------------------------------------------------------------
+ */
+
+static void
+ComputePolygonBbox(
+ Tk_Canvas canvas, /* Canvas that contains item. */
+ PolygonItem *polyPtr) /* Item whose bbox is to be recomputed. */
+{
+ double *coordPtr;
+ int i;
+ double width;
+ Tk_State state = polyPtr->header.state;
+ Tk_TSOffset *tsoffset;
+
+ if (state == TK_STATE_NULL) {
+ state = Canvas(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 (Canvas(canvas)->currentItemPtr == (Tk_Item *) polyPtr) {
+ if (polyPtr->outline.activeWidth > width) {
+ width = polyPtr->outline.activeWidth;
+ }
+ } else if (state == TK_STATE_DISABLED) {
+ if (polyPtr->outline.disabledWidth > 0.0) {
+ width = polyPtr->outline.disabledWidth;
+ }
+ }
+
+ coordPtr = polyPtr->coordPtr;
+ polyPtr->header.x1 = polyPtr->header.x2 = (int) *coordPtr;
+ polyPtr->header.y1 = polyPtr->header.y2 = (int) coordPtr[1];
+
+ /*
+ * Compute the bounding box of all the points in the polygon, then expand
+ * in all directions by the outline's width to take care of butting or
+ * rounded corners and projecting or rounded caps. This expansion is an
+ * overestimate (worst-case is square root of two over two) but it's
+ * simple. Don't do anything special for curves. This causes an additional
+ * overestimate in the bounding box, but is faster.
+ */
+
+ for (i = 1, coordPtr = polyPtr->coordPtr+2; i < polyPtr->numPoints-1;
+ i++, coordPtr += 2) {
+ TkIncludePoint((Tk_Item *) polyPtr, coordPtr);
+ }
+
+ tsoffset = &polyPtr->tsoffset;
+ if (tsoffset->flags & TK_OFFSET_INDEX) {
+ int index = tsoffset->flags & ~TK_OFFSET_INDEX;
+
+ if (tsoffset->flags == INT_MAX) {
+ index = (polyPtr->numPoints - polyPtr->autoClosed) * 2;
+ if (index < 0) {
+ index = 0;
+ }
+ }
+ index %= (polyPtr->numPoints - polyPtr->autoClosed) * 2;
+ if (index < 0) {
+ index += (polyPtr->numPoints - polyPtr->autoClosed) * 2;
+ }
+ tsoffset->xoffset = (int) (polyPtr->coordPtr[index] + 0.5);
+ tsoffset->yoffset = (int) (polyPtr->coordPtr[index+1] + 0.5);
+ } else {
+ if (tsoffset->flags & TK_OFFSET_LEFT) {
+ tsoffset->xoffset = polyPtr->header.x1;
+ } else if (tsoffset->flags & TK_OFFSET_CENTER) {
+ tsoffset->xoffset = (polyPtr->header.x1 + polyPtr->header.x2)/2;
+ } else if (tsoffset->flags & TK_OFFSET_RIGHT) {
+ tsoffset->xoffset = polyPtr->header.x2;
+ }
+ if (tsoffset->flags & TK_OFFSET_TOP) {
+ tsoffset->yoffset = polyPtr->header.y1;
+ } else if (tsoffset->flags & TK_OFFSET_MIDDLE) {
+ tsoffset->yoffset = (polyPtr->header.y1 + polyPtr->header.y2)/2;
+ } else if (tsoffset->flags & TK_OFFSET_BOTTOM) {
+ tsoffset->yoffset = polyPtr->header.y2;
+ }
+ }
+
+ if (polyPtr->outline.gc != None) {
+ tsoffset = &polyPtr->outline.tsoffset;
+ if (tsoffset) {
+ if (tsoffset->flags & TK_OFFSET_INDEX) {
+ int index = tsoffset->flags & ~TK_OFFSET_INDEX;
+
+ if (tsoffset->flags == INT_MAX) {
+ index = (polyPtr->numPoints - 1) * 2;
+ }
+ index %= (polyPtr->numPoints - 1) * 2;
+ if (index < 0) {
+ index += (polyPtr->numPoints - 1) * 2;
+ }
+ tsoffset->xoffset = (int) (polyPtr->coordPtr[index] + 0.5);
+ tsoffset->yoffset = (int) (polyPtr->coordPtr[index+1] + 0.5);
+ } else {
+ if (tsoffset->flags & TK_OFFSET_LEFT) {
+ tsoffset->xoffset = polyPtr->header.x1;
+ } else if (tsoffset->flags & TK_OFFSET_CENTER) {
+ tsoffset->xoffset =
+ (polyPtr->header.x1 + polyPtr->header.x2) / 2;
+ } else if (tsoffset->flags & TK_OFFSET_RIGHT) {
+ tsoffset->xoffset = polyPtr->header.x2;
+ }
+ if (tsoffset->flags & TK_OFFSET_TOP) {
+ tsoffset->yoffset = polyPtr->header.y1;
+ } else if (tsoffset->flags & TK_OFFSET_MIDDLE) {
+ tsoffset->yoffset =
+ (polyPtr->header.y1 + polyPtr->header.y2) / 2;
+ } else if (tsoffset->flags & TK_OFFSET_BOTTOM) {
+ tsoffset->yoffset = polyPtr->header.y2;
+ }
+ }
+ }
+
+ i = (int) ((width+1.5) / 2.0);
+ polyPtr->header.x1 -= i;
+ polyPtr->header.x2 += i;
+ polyPtr->header.y1 -= i;
+ polyPtr->header.y2 += i;
+
+ /*
+ * For mitered lines, make a second pass through all the points.
+ * Compute the locations of the two miter vertex points and add those
+ * into the bounding box.
+ */
+
+ if (polyPtr->joinStyle == JoinMiter) {
+ double miter[4];
+ int j;
+
+ coordPtr = polyPtr->coordPtr;
+ if (polyPtr->numPoints > 3) {
+ if (TkGetMiterPoints(coordPtr+2*(polyPtr->numPoints-2),
+ coordPtr, coordPtr+2, width, miter, miter+2)) {
+ for (j = 0; j < 4; j += 2) {
+ TkIncludePoint((Tk_Item *) polyPtr, miter+j);
+ }
+ }
+ }
+ for (i = polyPtr->numPoints ; i >= 3; i--, coordPtr += 2) {
+ if (TkGetMiterPoints(coordPtr, coordPtr+2, coordPtr+4, width,
+ miter, miter+2)) {
+ for (j = 0; j < 4; j += 2) {
+ TkIncludePoint((Tk_Item *) polyPtr, miter+j);
+ }
+ }
+ }
+ }
+ }
+
+ /*
+ * Add one more pixel of fudge factor just to be safe (e.g. X may round
+ * differently than we do).
+ */
+
+ polyPtr->header.x1 -= 1;
+ polyPtr->header.x2 += 1;
+ polyPtr->header.y1 -= 1;
+ polyPtr->header.y2 += 1;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * TkFillPolygon --
+ *
+ * This function is invoked to convert a polygon to screen coordinates
+ * and display it using a particular GC.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * ItemPtr is drawn in drawable using the transformation information in
+ * canvas.
+ *
+ *--------------------------------------------------------------
+ */
+
+void
+TkFillPolygon(
+ Tk_Canvas canvas, /* Canvas whose coordinate system is to be
+ * used for drawing. */
+ double *coordPtr, /* Array of coordinates for polygon: x1, y1,
+ * x2, y2, .... */
+ int numPoints, /* Twice this many coordinates are present at
+ * *coordPtr. */
+ Display *display, /* Display on which to draw polygon. */
+ Drawable drawable, /* Pixmap or window in which to draw
+ * polygon. */
+ GC gc, /* Graphics context for drawing. */
+ GC outlineGC) /* If not None, use this to draw an outline
+ * around the polygon after filling it. */
+{
+ XPoint staticPoints[MAX_STATIC_POINTS];
+ XPoint *pointPtr;
+ XPoint *pPtr;
+ int i;
+
+ /*
+ * Build up an array of points in screen coordinates. Use a static array
+ * unless the polygon has an enormous number of points; in this case,
+ * dynamically allocate an array.
+ */
+
+ if (numPoints <= MAX_STATIC_POINTS) {
+ pointPtr = staticPoints;
+ } else {
+ pointPtr = ckalloc(numPoints * sizeof(XPoint));
+ }
+
+ for (i=0, pPtr=pointPtr ; i<numPoints; i+=1, coordPtr+=2, pPtr++) {
+ Tk_CanvasDrawableCoords(canvas, coordPtr[0], coordPtr[1], &pPtr->x,
+ &pPtr->y);
+ }
+
+ /*
+ * Display polygon, then free up polygon storage if it was dynamically
+ * allocated.
+ */
+
+ if (gc != None && numPoints > 3) {
+ XFillPolygon(display, drawable, gc, pointPtr, numPoints, Complex,
+ CoordModeOrigin);
+ }
+ if (outlineGC != None) {
+ XDrawLines(display, drawable, outlineGC, pointPtr, numPoints,
+ CoordModeOrigin);
+ }
+ if (pointPtr != staticPoints) {
+ ckfree(pointPtr);
+ }
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * DisplayPolygon --
+ *
+ * This function is invoked to draw a polygon item in a given drawable.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * ItemPtr is drawn in drawable using the transformation information in
+ * canvas.
+ *
+ *--------------------------------------------------------------
+ */
+
+static void
+DisplayPolygon(
+ 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, int y, int width, int height)
+ /* Describes region of canvas that must be
+ * redisplayed (not used). */
+{
+ PolygonItem *polyPtr = (PolygonItem *) itemPtr;
+ Tk_State state = itemPtr->state;
+ Pixmap stipple = polyPtr->fillStipple;
+ double linewidth = polyPtr->outline.width;
+
+ if (((polyPtr->fillGC == None) && (polyPtr->outline.gc == None)) ||
+ (polyPtr->numPoints < 1) ||
+ (polyPtr->numPoints < 3 && polyPtr->outline.gc == None)) {
+ return;
+ }
+
+ if (state == TK_STATE_NULL) {
+ state = Canvas(canvas)->canvas_state;
+ }
+ if (Canvas(canvas)->currentItemPtr == itemPtr) {
+ if (polyPtr->outline.activeWidth > linewidth) {
+ linewidth = polyPtr->outline.activeWidth;
+ }
+ if (polyPtr->activeFillStipple != None) {
+ stipple = polyPtr->activeFillStipple;
+ }
+ } else if (state == TK_STATE_DISABLED) {
+ if (polyPtr->outline.disabledWidth > 0.0) {
+ linewidth = polyPtr->outline.disabledWidth;
+ }
+ if (polyPtr->disabledFillStipple != None) {
+ stipple = polyPtr->disabledFillStipple;
+ }
+ }
+
+ /*
+ * If we're stippling then modify the stipple offset in the GC. Be sure to
+ * reset the offset when done, since the GC is supposed to be read-only.
+ */
+
+ if ((stipple != None) && (polyPtr->fillGC != None)) {
+ Tk_TSOffset *tsoffset = &polyPtr->tsoffset;
+ int w = 0, h = 0;
+ int flags = tsoffset->flags;
+
+ if (!(flags & TK_OFFSET_INDEX)
+ && (flags & (TK_OFFSET_CENTER|TK_OFFSET_MIDDLE))) {
+ Tk_SizeOfBitmap(display, stipple, &w, &h);
+ if (flags & TK_OFFSET_CENTER) {
+ w /= 2;
+ } else {
+ w = 0;
+ }
+ if (flags & TK_OFFSET_MIDDLE) {
+ h /= 2;
+ } else {
+ h = 0;
+ }
+ }
+ tsoffset->xoffset -= w;
+ tsoffset->yoffset -= h;
+ Tk_CanvasSetOffset(canvas, polyPtr->fillGC, tsoffset);
+ tsoffset->xoffset += w;
+ tsoffset->yoffset += h;
+ }
+ Tk_ChangeOutlineGC(canvas, itemPtr, &polyPtr->outline);
+
+ if (polyPtr->numPoints < 3) {
+ short x, y;
+ int intLineWidth = (int) (linewidth + 0.5);
+
+ if (intLineWidth < 1) {
+ intLineWidth = 1;
+ }
+ Tk_CanvasDrawableCoords(canvas, polyPtr->coordPtr[0],
+ polyPtr->coordPtr[1], &x, &y);
+ XFillArc(display, drawable, polyPtr->outline.gc,
+ x - intLineWidth/2, y - intLineWidth/2,
+ (unsigned) intLineWidth+1, (unsigned) intLineWidth+1,
+ 0, 64*360);
+ } else if (!polyPtr->smooth || polyPtr->numPoints < 4) {
+ TkFillPolygon(canvas, polyPtr->coordPtr, polyPtr->numPoints,
+ display, drawable, polyPtr->fillGC, polyPtr->outline.gc);
+ } else {
+ int numPoints;
+ XPoint staticPoints[MAX_STATIC_POINTS];
+ XPoint *pointPtr;
+
+ /*
+ * This is a smoothed polygon. Display using a set of generated spline
+ * points rather than the original points.
+ */
+
+ numPoints = polyPtr->smooth->coordProc(canvas, NULL,
+ polyPtr->numPoints, polyPtr->splineSteps, NULL, NULL);
+ if (numPoints <= MAX_STATIC_POINTS) {
+ pointPtr = staticPoints;
+ } else {
+ pointPtr = ckalloc(numPoints * sizeof(XPoint));
+ }
+ numPoints = polyPtr->smooth->coordProc(canvas, polyPtr->coordPtr,
+ polyPtr->numPoints, polyPtr->splineSteps, pointPtr, NULL);
+ if (polyPtr->fillGC != None) {
+ XFillPolygon(display, drawable, polyPtr->fillGC, pointPtr,
+ numPoints, Complex, CoordModeOrigin);
+ }
+ if (polyPtr->outline.gc != None) {
+ XDrawLines(display, drawable, polyPtr->outline.gc, pointPtr,
+ numPoints, CoordModeOrigin);
+ }
+ if (pointPtr != staticPoints) {
+ ckfree(pointPtr);
+ }
+ }
+ Tk_ResetOutlineGC(canvas, itemPtr, &polyPtr->outline);
+ if ((stipple != None) && (polyPtr->fillGC != None)) {
+ XSetTSOrigin(display, polyPtr->fillGC, 0, 0);
+ }
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * PolygonInsert --
+ *
+ * Insert coords into a polugon item at a given index.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The coords in the given item is modified.
+ *
+ *--------------------------------------------------------------
+ */
+
+static void
+PolygonInsert(
+ Tk_Canvas canvas, /* Canvas containing text item. */
+ Tk_Item *itemPtr, /* Line item to be modified. */
+ int beforeThis, /* Index before which new coordinates are to
+ * be inserted. */
+ Tcl_Obj *obj) /* New coordinates to be inserted. */
+{
+ PolygonItem *polyPtr = (PolygonItem *) itemPtr;
+ int length, objc, i;
+ Tcl_Obj **objv;
+ double *newCoordPtr;
+ Tk_State state = itemPtr->state;
+
+ if (state == TK_STATE_NULL) {
+ state = Canvas(canvas)->canvas_state;
+ }
+
+ if (!obj || (Tcl_ListObjGetElements(NULL, obj, &objc, &objv) != TCL_OK)
+ || !objc || objc&1) {
+ return;
+ }
+ length = 2*(polyPtr->numPoints - polyPtr->autoClosed);
+ while (beforeThis > length) {
+ beforeThis -= length;
+ }
+ while (beforeThis < 0) {
+ beforeThis += length;
+ }
+ newCoordPtr = ckalloc(sizeof(double) * (length + 2 + objc));
+ for (i=0; i<beforeThis; i++) {
+ newCoordPtr[i] = polyPtr->coordPtr[i];
+ }
+ for (i=0; i<objc; i++) {
+ if (Tcl_GetDoubleFromObj(NULL, objv[i],
+ &newCoordPtr[i+beforeThis]) != TCL_OK){
+ ckfree(newCoordPtr);
+ return;
+ }
+ }
+
+ for (i=beforeThis; i<length; i++) {
+ newCoordPtr[i+objc] = polyPtr->coordPtr[i];
+ }
+ if (polyPtr->coordPtr) {
+ ckfree(polyPtr->coordPtr);
+ }
+ length += objc;
+ polyPtr->coordPtr = newCoordPtr;
+ 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 ((newCoordPtr[length-2] == newCoordPtr[0])
+ && (newCoordPtr[length-1] == newCoordPtr[1])) {
+ polyPtr->autoClosed = 0;
+ polyPtr->numPoints--;
+ }
+ } else {
+ if ((newCoordPtr[length-2] != newCoordPtr[0])
+ || (newCoordPtr[length-1] != newCoordPtr[1])) {
+ polyPtr->autoClosed = 1;
+ polyPtr->numPoints++;
+ }
+ }
+
+ newCoordPtr[length] = newCoordPtr[0];
+ newCoordPtr[length+1] = newCoordPtr[1];
+ if ((length-objc > 3) && (state != TK_STATE_HIDDEN)) {
+ /*
+ * This is some optimizing code that will result that only the part of
+ * the polygon that changed (and the objects that are overlapping with
+ * that part) need to be redrawn. A special flag is set that instructs
+ * the general canvas code not to redraw the whole object. If this
+ * flag is not set, the canvas will do the redrawing, otherwise I have
+ * to do it here.
+ */
+
+ double width;
+ int j;
+
+ itemPtr->redraw_flags |= TK_ITEM_DONT_REDRAW;
+
+ /*
+ * The header elements that normally are used for the bounding box,
+ * are now used to calculate the bounding box for only the part that
+ * has to be redrawn. That doesn't matter, because afterwards the
+ * bounding box has to be re-calculated anyway.
+ */
+
+ itemPtr->x1 = itemPtr->x2 = (int) polyPtr->coordPtr[beforeThis];
+ itemPtr->y1 = itemPtr->y2 = (int) polyPtr->coordPtr[beforeThis+1];
+ beforeThis -= 2;
+ objc += 4;
+ if (polyPtr->smooth) {
+ beforeThis -= 2;
+ objc += 4;
+ }
+
+ /*
+ * Be careful; beforeThis could now be negative
+ */
+
+ for (i=beforeThis; i<beforeThis+objc; i+=2) {
+ j = i;
+ if (j < 0) {
+ j += length;
+ } else if (j >= length) {
+ j -= length;
+ }
+ TkIncludePoint(itemPtr, polyPtr->coordPtr+j);
+ }
+ width = polyPtr->outline.width;
+ if (Canvas(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(
+ 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(polyPtr->coordPtr);
+ polyPtr->coordPtr = NULL;
+ }
+ ComputePolygonBbox(canvas, polyPtr);
+ return;
+ }
+
+ if (last >= first) {
+ for (i=last+2; i<length; i++) {
+ polyPtr->coordPtr[i-count] = polyPtr->coordPtr[i];
+ }
+ } else {
+ for (i=last; i<=first; i++) {
+ polyPtr->coordPtr[i-last] = polyPtr->coordPtr[i];
+ }
+ }
+ polyPtr->coordPtr[length-count] = polyPtr->coordPtr[0];
+ polyPtr->coordPtr[length-count+1] = polyPtr->coordPtr[1];
+ polyPtr->numPoints -= count/2;
+ ComputePolygonBbox(canvas, polyPtr);
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * PolygonToPoint --
+ *
+ * Computes the distance from a given point to a given polygon, in canvas
+ * units.
+ *
+ * Results:
+ * The return value is 0 if the point whose x and y coordinates are
+ * pointPtr[0] and pointPtr[1] is inside the polygon. If the point isn't
+ * inside the polygon then the return value is the distance from the
+ * point to the polygon.
+ *
+ * Side effects:
+ * None.
+ *
+ *--------------------------------------------------------------
+ */
+
+ /* ARGSUSED */
+static double
+PolygonToPoint(
+ Tk_Canvas canvas, /* Canvas containing item. */
+ Tk_Item *itemPtr, /* Item to check against point. */
+ double *pointPtr) /* Pointer to x and y coordinates. */
+{
+ PolygonItem *polyPtr = (PolygonItem *) itemPtr;
+ double *coordPtr, *polyPoints;
+ double staticSpace[2*MAX_STATIC_POINTS];
+ double poly[10];
+ double radius;
+ double bestDist, dist;
+ int numPoints, count;
+ int changedMiterToBevel; /* Non-zero means that a mitered corner had to
+ * be treated as beveled after all because the
+ * angle was < 11 degrees. */
+ double width;
+ Tk_State state = itemPtr->state;
+
+ bestDist = 1.0e36;
+
+ if (state == TK_STATE_NULL) {
+ state = Canvas(canvas)->canvas_state;
+ }
+ width = polyPtr->outline.width;
+ if (Canvas(canvas)->currentItemPtr == itemPtr) {
+ if (polyPtr->outline.activeWidth > width) {
+ width = polyPtr->outline.activeWidth;
+ }
+ } else if (state == TK_STATE_DISABLED) {
+ if (polyPtr->outline.disabledWidth > 0.0) {
+ width = polyPtr->outline.disabledWidth;
+ }
+ }
+ radius = width/2.0;
+
+ /*
+ * Handle smoothed polygons by generating an expanded set of points
+ * against which to do the check.
+ */
+
+ if ((polyPtr->smooth) && (polyPtr->numPoints > 2)) {
+ numPoints = polyPtr->smooth->coordProc(canvas, NULL,
+ polyPtr->numPoints, polyPtr->splineSteps, NULL, NULL);
+ if (numPoints <= MAX_STATIC_POINTS) {
+ polyPoints = staticSpace;
+ } else {
+ polyPoints = ckalloc(2 * numPoints * sizeof(double));
+ }
+ numPoints = polyPtr->smooth->coordProc(canvas, polyPtr->coordPtr,
+ polyPtr->numPoints, polyPtr->splineSteps, NULL, polyPoints);
+ } else {
+ numPoints = polyPtr->numPoints;
+ polyPoints = polyPtr->coordPtr;
+ }
+
+ bestDist = TkPolygonToPoint(polyPoints, numPoints, pointPtr);
+ if (bestDist <= 0.0) {
+ goto donepoint;
+ }
+ if ((polyPtr->outline.gc != None) && (polyPtr->joinStyle == JoinRound)) {
+ dist = bestDist - radius;
+ if (dist <= 0.0) {
+ bestDist = 0.0;
+ goto donepoint;
+ } else {
+ bestDist = dist;
+ }
+ }
+
+ if ((polyPtr->outline.gc == None) || (width <= 1)) {
+ goto donepoint;
+ }
+
+ /*
+ * The overall idea is to iterate through all of the edges of the line,
+ * computing a polygon for each edge and testing the point against that
+ * polygon. In addition, there are additional tests to deal with rounded
+ * joints and caps.
+ */
+
+ changedMiterToBevel = 0;
+ for (count = numPoints, coordPtr = polyPoints; count >= 2;
+ count--, coordPtr += 2) {
+ /*
+ * If rounding is done around the first point then compute the
+ * distance between the point and the point.
+ */
+
+ if (polyPtr->joinStyle == JoinRound) {
+ dist = hypot(coordPtr[0] - pointPtr[0], coordPtr[1] - pointPtr[1])
+ - radius;
+ if (dist <= 0.0) {
+ bestDist = 0.0;
+ goto donepoint;
+ } else if (dist < bestDist) {
+ bestDist = dist;
+ }
+ }
+
+ /*
+ * Compute the polygonal shape corresponding to this edge, consisting
+ * of two points for the first point of the edge and two points for
+ * the last point of the edge.
+ */
+
+ if (count == numPoints) {
+ TkGetButtPoints(coordPtr+2, coordPtr, (double) width, 0, poly,
+ poly+2);
+ } else if ((polyPtr->joinStyle == JoinMiter) && !changedMiterToBevel) {
+ poly[0] = poly[6];
+ poly[1] = poly[7];
+ poly[2] = poly[4];
+ poly[3] = poly[5];
+ } else {
+ TkGetButtPoints(coordPtr+2, coordPtr, (double) width, 0, poly,
+ poly+2);
+
+ /*
+ * If this line uses beveled joints, then check the distance to a
+ * polygon comprising the last two points of the previous polygon
+ * and the first two from this polygon; this checks the wedges
+ * that fill the mitered joint.
+ */
+
+ if ((polyPtr->joinStyle == JoinBevel) || changedMiterToBevel) {
+ poly[8] = poly[0];
+ poly[9] = poly[1];
+ dist = TkPolygonToPoint(poly, 5, pointPtr);
+ if (dist <= 0.0) {
+ bestDist = 0.0;
+ goto donepoint;
+ } else if (dist < bestDist) {
+ bestDist = dist;
+ }
+ changedMiterToBevel = 0;
+ }
+ }
+ if (count == 2) {
+ TkGetButtPoints(coordPtr, coordPtr+2, (double) width, 0, poly+4,
+ poly+6);
+ } else if (polyPtr->joinStyle == JoinMiter) {
+ if (TkGetMiterPoints(coordPtr, coordPtr+2, coordPtr+4,
+ (double) width, poly+4, poly+6) == 0) {
+ changedMiterToBevel = 1;
+ TkGetButtPoints(coordPtr, coordPtr+2, (double) width, 0,
+ poly+4, poly+6);
+ }
+ } else {
+ TkGetButtPoints(coordPtr, coordPtr+2, (double) width, 0, poly+4,
+ poly+6);
+ }
+ poly[8] = poly[0];
+ poly[9] = poly[1];
+ dist = TkPolygonToPoint(poly, 5, pointPtr);
+ if (dist <= 0.0) {
+ bestDist = 0.0;
+ goto donepoint;
+ } else if (dist < bestDist) {
+ bestDist = dist;
+ }
+ }
+
+ donepoint:
+ if (polyPoints != staticSpace && polyPoints != polyPtr->coordPtr) {
+ ckfree(polyPoints);
+ }
+ return bestDist;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * PolygonToArea --
+ *
+ * This function is called to determine whether an item lies entirely
+ * inside, entirely outside, or overlapping a given rectangular area.
+ *
+ * Results:
+ * -1 is returned if the item is entirely outside the area given by
+ * rectPtr, 0 if it overlaps, and 1 if it is entirely inside the given
+ * area.
+ *
+ * Side effects:
+ * None.
+ *
+ *--------------------------------------------------------------
+ */
+
+ /* ARGSUSED */
+static int
+PolygonToArea(
+ Tk_Canvas canvas, /* Canvas containing item. */
+ Tk_Item *itemPtr, /* Item to check against polygon. */
+ double *rectPtr) /* Pointer to array of four coordinates
+ * (x1,y1,x2,y2) describing rectangular
+ * area. */
+{
+ PolygonItem *polyPtr = (PolygonItem *) itemPtr;
+ double *coordPtr;
+ double staticSpace[2*MAX_STATIC_POINTS];
+ double *polyPoints, poly[10];
+ double radius;
+ int numPoints, count;
+ int changedMiterToBevel; /* Non-zero means that a mitered corner had to
+ * be treated as beveled after all because the
+ * angle was < 11 degrees. */
+ int inside; /* Tentative guess about what to return, based
+ * on all points seen so far: one means
+ * everything seen so far was inside the area;
+ * -1 means everything was outside the area. 0
+ * means overlap has been found. */
+ double width;
+ Tk_State state = itemPtr->state;
+
+ if (state == TK_STATE_NULL) {
+ state = Canvas(canvas)->canvas_state;
+ }
+
+ width = polyPtr->outline.width;
+ if (Canvas(canvas)->currentItemPtr == itemPtr) {
+ if (polyPtr->outline.activeWidth > width) {
+ width = polyPtr->outline.activeWidth;
+ }
+ } else if (state == TK_STATE_DISABLED) {
+ if (polyPtr->outline.disabledWidth > 0.0) {
+ width = polyPtr->outline.disabledWidth;
+ }
+ }
+
+ radius = width/2.0;
+ inside = -1;
+
+ if ((state == TK_STATE_HIDDEN) || polyPtr->numPoints < 2) {
+ return -1;
+ } else if (polyPtr->numPoints < 3) {
+ double oval[4];
+
+ oval[0] = polyPtr->coordPtr[0]-radius;
+ oval[1] = polyPtr->coordPtr[1]-radius;
+ oval[2] = polyPtr->coordPtr[0]+radius;
+ oval[3] = polyPtr->coordPtr[1]+radius;
+ return TkOvalToArea(oval, rectPtr);
+ }
+
+ /*
+ * Handle smoothed polygons by generating an expanded set of points
+ * against which to do the check.
+ */
+
+ if (polyPtr->smooth) {
+ numPoints = polyPtr->smooth->coordProc(canvas, NULL,
+ polyPtr->numPoints, polyPtr->splineSteps, NULL, NULL);
+ if (numPoints <= MAX_STATIC_POINTS) {
+ polyPoints = staticSpace;
+ } else {
+ polyPoints = ckalloc(2 * numPoints * sizeof(double));
+ }
+ numPoints = polyPtr->smooth->coordProc(canvas, polyPtr->coordPtr,
+ polyPtr->numPoints, polyPtr->splineSteps, NULL, polyPoints);
+ } else {
+ numPoints = polyPtr->numPoints;
+ polyPoints = polyPtr->coordPtr;
+ }
+
+ /*
+ * Simple test to see if we are in the polygon. Polygons are different
+ * from othe canvas items in that they register points being inside even
+ * if it isn't filled.
+ */
+
+ inside = TkPolygonToArea(polyPoints, numPoints, rectPtr);
+ if (inside == 0) {
+ goto donearea;
+ }
+
+ if (polyPtr->outline.gc == None) {
+ goto donearea;
+ }
+
+ /*
+ * Iterate through all of the edges of the line, computing a polygon for
+ * each edge and testing the area against that polygon. In addition, there
+ * are additional tests to deal with rounded joints and caps.
+ */
+
+ changedMiterToBevel = 0;
+ for (count = numPoints, coordPtr = polyPoints; count >= 2;
+ count--, coordPtr += 2) {
+ /*
+ * If rounding is done around the first point of the edge then test a
+ * circular region around the point with the area.
+ */
+
+ if (polyPtr->joinStyle == JoinRound) {
+ poly[0] = coordPtr[0] - radius;
+ poly[1] = coordPtr[1] - radius;
+ poly[2] = coordPtr[0] + radius;
+ poly[3] = coordPtr[1] + radius;
+ if (TkOvalToArea(poly, rectPtr) != inside) {
+ inside = 0;
+ goto donearea;
+ }
+ }
+
+ /*
+ * Compute the polygonal shape corresponding to this edge, consisting
+ * of two points for the first point of the edge and two points for
+ * the last point of the edge.
+ */
+
+ if (count == numPoints) {
+ TkGetButtPoints(coordPtr+2, coordPtr, width, 0, poly, poly+2);
+ } else if ((polyPtr->joinStyle == JoinMiter) && !changedMiterToBevel) {
+ poly[0] = poly[6];
+ poly[1] = poly[7];
+ poly[2] = poly[4];
+ poly[3] = poly[5];
+ } else {
+ TkGetButtPoints(coordPtr+2, coordPtr, width, 0, poly, poly+2);
+
+ /*
+ * If the last joint was beveled, then also check a polygon
+ * comprising the last two points of the previous polygon and the
+ * first two from this polygon; this checks the wedges that fill
+ * the beveled joint.
+ */
+
+ if ((polyPtr->joinStyle == JoinBevel) || changedMiterToBevel) {
+ poly[8] = poly[0];
+ poly[9] = poly[1];
+ if (TkPolygonToArea(poly, 5, rectPtr) != inside) {
+ inside = 0;
+ goto donearea;
+ }
+ changedMiterToBevel = 0;
+ }
+ }
+ if (count == 2) {
+ TkGetButtPoints(coordPtr, coordPtr+2, width, 0, poly+4, poly+6);
+ } else if (polyPtr->joinStyle == JoinMiter) {
+ if (TkGetMiterPoints(coordPtr, coordPtr+2, coordPtr+4, width,
+ poly+4, poly+6) == 0) {
+ changedMiterToBevel = 1;
+ TkGetButtPoints(coordPtr, coordPtr+2, width,0, poly+4, poly+6);
+ }
+ } else {
+ TkGetButtPoints(coordPtr, coordPtr+2, width, 0, poly+4, poly+6);
+ }
+ poly[8] = poly[0];
+ poly[9] = poly[1];
+ if (TkPolygonToArea(poly, 5, rectPtr) != inside) {
+ inside = 0;
+ goto donearea;
+ }
+ }
+
+ donearea:
+ if ((polyPoints != staticSpace) && (polyPoints != polyPtr->coordPtr)) {
+ ckfree(polyPoints);
+ }
+ return inside;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * ScalePolygon --
+ *
+ * This function is invoked to rescale a polygon item.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The polygon referred to by itemPtr is rescaled so that the following
+ * transformation is applied to all point coordinates:
+ * x' = originX + scaleX*(x-originX)
+ * y' = originY + scaleY*(y-originY)
+ *
+ *--------------------------------------------------------------
+ */
+
+static void
+ScalePolygon(
+ Tk_Canvas canvas, /* Canvas containing polygon. */
+ Tk_Item *itemPtr, /* Polygon to be scaled. */
+ double originX, double originY,
+ /* Origin about which to scale rect. */
+ double scaleX, /* Amount to scale in X direction. */
+ double scaleY) /* Amount to scale in Y direction. */
+{
+ PolygonItem *polyPtr = (PolygonItem *) itemPtr;
+ double *coordPtr;
+ int i;
+
+ for (i = 0, coordPtr = polyPtr->coordPtr; i < polyPtr->numPoints;
+ i++, coordPtr += 2) {
+ *coordPtr = originX + scaleX*(*coordPtr - originX);
+ coordPtr[1] = originY + scaleY*(coordPtr[1] - originY);
+ }
+ ComputePolygonBbox(canvas, polyPtr);
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * GetPolygonIndex --
+ *
+ * Parse an index into a polygon item and return either its value or an
+ * error.
+ *
+ * Results:
+ * A standard Tcl result. If all went well, then *indexPtr is filled in
+ * with the index (into itemPtr) corresponding to string. Otherwise an
+ * error message is left in interp->result.
+ *
+ * Side effects:
+ * None.
+ *
+ *--------------------------------------------------------------
+ */
+
+static int
+GetPolygonIndex(
+ 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;
+ const char *string = Tcl_GetString(obj);
+
+ if (string[0] == 'e') {
+ if (strncmp(string, "end", obj->length) != 0) {
+ goto badIndex;
+ }
+ *indexPtr = 2*(polyPtr->numPoints - polyPtr->autoClosed);
+ } else if (string[0] == '@') {
+ int i;
+ double x, y, bestDist, dist, *coordPtr;
+ char *end;
+ const char *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) {
+ *indexPtr = 0;
+ } else if (*indexPtr > 0) {
+ *indexPtr = ((*indexPtr - 2) % count) + 2;
+ } else {
+ *indexPtr = -((-(*indexPtr)) % count);
+ }
+ }
+ return TCL_OK;
+
+ /*
+ * Some of the paths here leave messages in interp->result, so we have to
+ * clear it out before storing our own message.
+ */
+
+ badIndex:
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf("bad index \"%s\"", string));
+ Tcl_SetErrorCode(interp, "TK", "CANVAS", "ITEM_INDEX", "POLY", NULL);
+ return TCL_ERROR;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * TranslatePolygon --
+ *
+ * This function is called to move a polygon by a given amount.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The position of the polygon is offset by (xDelta, yDelta), and the
+ * bounding box is updated in the generic part of the item structure.
+ *
+ *--------------------------------------------------------------
+ */
+
+static void
+TranslatePolygon(
+ Tk_Canvas canvas, /* Canvas containing item. */
+ Tk_Item *itemPtr, /* Item that is being moved. */
+ double deltaX, double deltaY)
+ /* Amount by which item is to be moved. */
+{
+ PolygonItem *polyPtr = (PolygonItem *) itemPtr;
+ double *coordPtr;
+ int i;
+
+ for (i = 0, coordPtr = polyPtr->coordPtr; i < polyPtr->numPoints;
+ i++, coordPtr += 2) {
+ *coordPtr += deltaX;
+ coordPtr[1] += deltaY;
+ }
+ ComputePolygonBbox(canvas, polyPtr);
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * PolygonToPostscript --
+ *
+ * This function is called to generate Postscript for polygon items.
+ *
+ * Results:
+ * The return value is a standard Tcl result. If an error occurs in
+ * generating Postscript then an error message is left in the interp's
+ * result, replacing whatever used to be there. If no error occurs, then
+ * Postscript for the item is appended to the result.
+ *
+ * Side effects:
+ * None.
+ *
+ *--------------------------------------------------------------
+ */
+
+static int
+PolygonToPostscript(
+ Tcl_Interp *interp, /* Leave Postscript or error message here. */
+ Tk_Canvas canvas, /* Information about overall canvas. */
+ Tk_Item *itemPtr, /* Item for which Postscript is wanted. */
+ int prepass) /* 1 means this is a prepass to collect font
+ * information; 0 means final Postscript is
+ * being created. */
+{
+ PolygonItem *polyPtr = (PolygonItem *) itemPtr;
+ int style;
+ XColor *color;
+ XColor *fillColor;
+ Pixmap stipple;
+ Pixmap fillStipple;
+ Tk_State state = itemPtr->state;
+ double width;
+ Tcl_Obj *psObj;
+ Tcl_InterpState interpState;
+
+ if (polyPtr->numPoints < 2 || polyPtr->coordPtr == NULL) {
+ return TCL_OK;
+ }
+
+ if (state == TK_STATE_NULL) {
+ state = Canvas(canvas)->canvas_state;
+ }
+ width = polyPtr->outline.width;
+ color = polyPtr->outline.color;
+ stipple = polyPtr->fillStipple;
+ fillColor = polyPtr->fillColor;
+ fillStipple = polyPtr->fillStipple;
+ if (Canvas(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;
+ }
+ }
+
+ /*
+ * Make our working space.
+ */
+
+ psObj = Tcl_NewObj();
+ interpState = Tcl_SaveInterpState(interp, TCL_OK);
+
+ if (polyPtr->numPoints == 2) {
+ if (color == NULL) {
+ goto done;
+ }
+
+ /*
+ * Create a point by using a small circle. (Printer pixels are too
+ * tiny to be used directly...)
+ */
+
+ Tcl_AppendPrintfToObj(psObj,
+ "matrix currentmatrix\n" /* save state */
+ "%.15g %.15g translate " /* go to drawing location */
+ "%.15g %.15g scale " /* scale the drawing */
+ "1 0 moveto " /* correct for origin */
+ "0 0 1 0 360 arc\n" /* make the circle */
+ "setmatrix\n", /* restore state */
+ polyPtr->coordPtr[0],
+ Tk_CanvasPsY(canvas, polyPtr->coordPtr[1]),
+ width/2.0, width/2.0);
+
+ /*
+ * Color it in.
+ */
+
+ Tcl_ResetResult(interp);
+ if (Tk_CanvasPsColor(interp, canvas, color) != TCL_OK) {
+ goto error;
+ }
+ Tcl_AppendObjToObj(psObj, Tcl_GetObjResult(interp));
+
+ if (stipple != None) {
+ Tcl_AppendToObj(psObj, "clip ", -1);
+
+ Tcl_ResetResult(interp);
+ if (Tk_CanvasPsStipple(interp, canvas, stipple) != TCL_OK) {
+ goto error;
+ }
+ Tcl_AppendObjToObj(psObj, Tcl_GetObjResult(interp));
+ } else {
+ Tcl_AppendToObj(psObj, "fill\n", -1);
+ }
+ goto done;
+ }
+
+ /*
+ * Fill the area of the polygon.
+ */
+
+ if (fillColor != NULL && polyPtr->numPoints > 3) {
+ Tcl_ResetResult(interp);
+ if (!polyPtr->smooth || !polyPtr->smooth->postscriptProc) {
+ Tk_CanvasPsPath(interp, canvas, polyPtr->coordPtr,
+ polyPtr->numPoints);
+ } else {
+ polyPtr->smooth->postscriptProc(interp, canvas, polyPtr->coordPtr,
+ polyPtr->numPoints, polyPtr->splineSteps);
+ }
+ if (Tk_CanvasPsColor(interp, canvas, fillColor) != TCL_OK) {
+ goto error;
+ }
+ Tcl_AppendObjToObj(psObj, Tcl_GetObjResult(interp));
+
+ if (fillStipple != None) {
+ Tcl_AppendToObj(psObj, "eoclip ", -1);
+
+ Tcl_ResetResult(interp);
+ if (Tk_CanvasPsStipple(interp, canvas, fillStipple) != TCL_OK) {
+ goto error;
+ }
+ Tcl_AppendObjToObj(psObj, Tcl_GetObjResult(interp));
+
+ if (color != NULL) {
+ Tcl_AppendToObj(psObj, "grestore gsave\n", -1);
+ }
+ } else {
+ Tcl_AppendToObj(psObj, "eofill\n", -1);
+ }
+ }
+
+ /*
+ * Now draw the outline, if there is one.
+ */
+
+ if (color != NULL) {
+ Tcl_ResetResult(interp);
+ if (!polyPtr->smooth || !polyPtr->smooth->postscriptProc) {
+ Tk_CanvasPsPath(interp, canvas, polyPtr->coordPtr,
+ polyPtr->numPoints);
+ } else {
+ polyPtr->smooth->postscriptProc(interp, canvas, polyPtr->coordPtr,
+ polyPtr->numPoints, polyPtr->splineSteps);
+ }
+ Tcl_AppendObjToObj(psObj, Tcl_GetObjResult(interp));
+
+ if (polyPtr->joinStyle == JoinRound) {
+ style = 1;
+ } else if (polyPtr->joinStyle == JoinBevel) {
+ style = 2;
+ } else {
+ style = 0;
+ }
+ Tcl_AppendPrintfToObj(psObj, "%d setlinejoin 1 setlinecap\n", style);
+
+ Tcl_ResetResult(interp);
+ if (Tk_CanvasPsOutline(canvas, itemPtr, &polyPtr->outline) != TCL_OK){
+ goto error;
+ }
+ Tcl_AppendObjToObj(psObj, Tcl_GetObjResult(interp));
+ }
+
+ /*
+ * Plug the accumulated postscript back into the result.
+ */
+
+ done:
+ (void) Tcl_RestoreInterpState(interp, interpState);
+ Tcl_AppendObjToObj(Tcl_GetObjResult(interp), psObj);
+ Tcl_DecrRefCount(psObj);
+ return TCL_OK;
+
+ error:
+ Tcl_DiscardInterpState(interpState);
+ Tcl_DecrRefCount(psObj);
+ return TCL_ERROR;
+}
+
+/*
+ * Local Variables:
+ * mode: c
+ * c-basic-offset: 4
+ * fill-column: 78
+ * End:
+ */
diff --git a/tk8.6/generic/tkCanvPs.c b/tk8.6/generic/tkCanvPs.c
new file mode 100644
index 0000000..c6470dd
--- /dev/null
+++ b/tk8.6/generic/tkCanvPs.c
@@ -0,0 +1,1782 @@
+/*
+ * tkCanvPs.c --
+ *
+ * This module provides Postscript output support for canvases, including
+ * the "postscript" widget command plus a few utility functions used for
+ * generating Postscript.
+ *
+ * Copyright (c) 1991-1994 The Regents of the University of California.
+ * Copyright (c) 1994-1997 Sun Microsystems, Inc.
+ *
+ * See the file "license.terms" for information on usage and redistribution of
+ * this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ */
+
+#include "tkInt.h"
+#include "tkCanvas.h"
+#include "tkFont.h"
+
+/*
+ * See tkCanvas.h for key data structures used to implement canvases.
+ */
+
+/*
+ * The following definition 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;
+
+/*
+ * One of the following structures is created to keep track of Postscript
+ * output being generated. It consists mostly of information provided on the
+ * widget command line.
+ */
+
+typedef struct TkPostscriptInfo {
+ int x, y, width, height; /* Area to print, in canvas pixel
+ * coordinates. */
+ int x2, y2; /* x+width and y+height. */
+ char *pageXString; /* String value of "-pagex" option or NULL. */
+ char *pageYString; /* String value of "-pagey" option or NULL. */
+ double pageX, pageY; /* Postscript coordinates (in points)
+ * corresponding to pageXString and
+ * pageYString. Don't forget that y-values
+ * grow upwards for Postscript! */
+ char *pageWidthString; /* Printed width of output. */
+ char *pageHeightString; /* Printed height of output. */
+ double scale; /* Scale factor for conversion: each pixel
+ * maps into this many points. */
+ Tk_Anchor pageAnchor; /* How to anchor bbox on Postscript page. */
+ int rotate; /* Non-zero means output should be rotated on
+ * page (landscape mode). */
+ char *fontVar; /* If non-NULL, gives name of global variable
+ * containing font mapping information.
+ * Malloc'ed. */
+ char *colorVar; /* If non-NULL, give name of global variable
+ * containing color mapping information.
+ * Malloc'ed. */
+ char *colorMode; /* Mode for handling colors: "monochrome",
+ * "gray", or "color". Malloc'ed. */
+ int colorLevel; /* Numeric value corresponding to colorMode: 0
+ * for mono, 1 for gray, 2 for color. */
+ char *fileName; /* Name of file in which to write Postscript;
+ * NULL means return Postscript info as
+ * result. Malloc'ed. */
+ char *channelName; /* If -channel is specified, the name of the
+ * channel to use. */
+ Tcl_Channel chan; /* Open channel corresponding to fileName. */
+ Tcl_HashTable fontTable; /* Hash table containing names of all font
+ * families used in output. The hash table
+ * values are not used. */
+ int prepass; /* Non-zero means that we're currently in the
+ * pre-pass that collects font information, so
+ * the Postscript generated isn't relevant. */
+ int prolog; /* Non-zero means output should contain the
+ * standard prolog in the header. Generated in
+ * library/mkpsenc.tcl, stored in the variable
+ * ::tk::ps_preamable [sic]. */
+ Tk_Window tkwin; /* Window to get font pixel/point transform
+ * from. */
+} TkPostscriptInfo;
+
+/*
+ * The table below provides a template that's used to process arguments to the
+ * canvas "postscript" command and fill in TkPostscriptInfo structures.
+ */
+
+static const Tk_ConfigSpec configSpecs[] = {
+ {TK_CONFIG_STRING, "-colormap", NULL, NULL,
+ "", Tk_Offset(TkPostscriptInfo, colorVar), 0, NULL},
+ {TK_CONFIG_STRING, "-colormode", NULL, NULL,
+ "", Tk_Offset(TkPostscriptInfo, colorMode), 0, NULL},
+ {TK_CONFIG_STRING, "-file", NULL, NULL,
+ "", Tk_Offset(TkPostscriptInfo, fileName), 0, NULL},
+ {TK_CONFIG_STRING, "-channel", NULL, NULL,
+ "", Tk_Offset(TkPostscriptInfo, channelName), 0, NULL},
+ {TK_CONFIG_STRING, "-fontmap", NULL, NULL,
+ "", Tk_Offset(TkPostscriptInfo, fontVar), 0, NULL},
+ {TK_CONFIG_PIXELS, "-height", NULL, NULL,
+ "", Tk_Offset(TkPostscriptInfo, height), 0, NULL},
+ {TK_CONFIG_ANCHOR, "-pageanchor", NULL, NULL,
+ "", Tk_Offset(TkPostscriptInfo, pageAnchor), 0, NULL},
+ {TK_CONFIG_STRING, "-pageheight", NULL, NULL,
+ "", Tk_Offset(TkPostscriptInfo, pageHeightString), 0, NULL},
+ {TK_CONFIG_STRING, "-pagewidth", NULL, NULL,
+ "", Tk_Offset(TkPostscriptInfo, pageWidthString), 0, NULL},
+ {TK_CONFIG_STRING, "-pagex", NULL, NULL,
+ "", Tk_Offset(TkPostscriptInfo, pageXString), 0, NULL},
+ {TK_CONFIG_STRING, "-pagey", NULL, NULL,
+ "", Tk_Offset(TkPostscriptInfo, pageYString), 0, NULL},
+ {TK_CONFIG_BOOLEAN, "-prolog", NULL, NULL,
+ "", Tk_Offset(TkPostscriptInfo, prolog), 0, NULL},
+ {TK_CONFIG_BOOLEAN, "-rotate", NULL, NULL,
+ "", Tk_Offset(TkPostscriptInfo, rotate), 0, NULL},
+ {TK_CONFIG_PIXELS, "-width", NULL, NULL,
+ "", Tk_Offset(TkPostscriptInfo, width), 0, NULL},
+ {TK_CONFIG_PIXELS, "-x", NULL, NULL,
+ "", Tk_Offset(TkPostscriptInfo, x), 0, NULL},
+ {TK_CONFIG_PIXELS, "-y", NULL, NULL,
+ "", Tk_Offset(TkPostscriptInfo, y), 0, NULL},
+ {TK_CONFIG_END, NULL, NULL, NULL, NULL, 0, 0, NULL}
+};
+
+/*
+ * Forward declarations for functions defined later in this file:
+ */
+
+static int GetPostscriptPoints(Tcl_Interp *interp,
+ char *string, double *doublePtr);
+static void PostscriptBitmap(Tk_Window tkwin, Pixmap bitmap,
+ int startX, int startY, int width, int height,
+ Tcl_Obj *psObj);
+static inline Tcl_Obj * GetPostscriptBuffer(Tcl_Interp *interp);
+
+/*
+ *--------------------------------------------------------------
+ *
+ * TkCanvPostscriptCmd --
+ *
+ * This function is invoked to process the "postscript" options of the
+ * widget command for canvas widgets. See the user documentation for
+ * details on what it does.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * See the user documentation.
+ *
+ *--------------------------------------------------------------
+ */
+
+ /* ARGSUSED */
+int
+TkCanvPostscriptCmd(
+ TkCanvas *canvasPtr, /* Information about canvas widget. */
+ Tcl_Interp *interp, /* Current interpreter. */
+ int argc, /* Number of arguments. */
+ const char **argv) /* Argument strings. Caller has already parsed
+ * this command enough to know that argv[1] is
+ * "postscript". */
+{
+ TkPostscriptInfo psInfo, *psInfoPtr = &psInfo;
+ Tk_PostscriptInfo oldInfoPtr;
+ int result;
+ Tk_Item *itemPtr;
+#define STRING_LENGTH 400
+ const char *p;
+ time_t now;
+ size_t length;
+ Tk_Window tkwin = canvasPtr->tkwin;
+ Tcl_HashSearch search;
+ Tcl_HashEntry *hPtr;
+ Tcl_DString buffer;
+ Tcl_Obj *preambleObj;
+ Tcl_Obj *psObj;
+ int deltaX = 0, deltaY = 0; /* Offset of lower-left corner of area to be
+ * marked up, measured in canvas units from
+ * the positioning point on the page (reflects
+ * anchor position). Initial values needed
+ * only to stop compiler warnings. */
+
+ /*
+ * Get the generic preamble. We only ever bother with the ASCII encoding;
+ * the others just make life too complicated and never actually worked as
+ * such.
+ */
+
+ result = Tcl_EvalEx(interp, "::tk::ensure_psenc_is_loaded", -1, 0);
+ if (result != TCL_OK) {
+ return result;
+ }
+ preambleObj = Tcl_GetVar2Ex(interp, "::tk::ps_preamble", NULL,
+ TCL_LEAVE_ERR_MSG);
+ if (preambleObj == NULL) {
+ return TCL_ERROR;
+ }
+ Tcl_IncrRefCount(preambleObj);
+ Tcl_ResetResult(interp);
+ psObj = Tcl_NewObj();
+
+ /*
+ * Initialize the data structure describing Postscript generation, then
+ * process all the arguments to fill the data structure in.
+ */
+
+ oldInfoPtr = canvasPtr->psInfo;
+ canvasPtr->psInfo = (Tk_PostscriptInfo) psInfoPtr;
+ psInfo.x = canvasPtr->xOrigin;
+ psInfo.y = canvasPtr->yOrigin;
+ psInfo.width = -1;
+ psInfo.height = -1;
+ psInfo.pageXString = NULL;
+ psInfo.pageYString = NULL;
+ psInfo.pageX = 72*4.25;
+ psInfo.pageY = 72*5.5;
+ psInfo.pageWidthString = NULL;
+ psInfo.pageHeightString = NULL;
+ psInfo.scale = 1.0;
+ psInfo.pageAnchor = TK_ANCHOR_CENTER;
+ psInfo.rotate = 0;
+ psInfo.fontVar = NULL;
+ psInfo.colorVar = NULL;
+ psInfo.colorMode = NULL;
+ psInfo.colorLevel = 0;
+ psInfo.fileName = NULL;
+ psInfo.channelName = NULL;
+ psInfo.chan = NULL;
+ psInfo.prepass = 0;
+ psInfo.prolog = 1;
+ psInfo.tkwin = tkwin;
+ Tcl_InitHashTable(&psInfo.fontTable, TCL_STRING_KEYS);
+ result = Tk_ConfigureWidget(interp, tkwin, configSpecs, argc-2, argv+2,
+ (char *) &psInfo, TK_CONFIG_ARGV_ONLY);
+ if (result != TCL_OK) {
+ goto cleanup;
+ }
+
+ if (psInfo.width == -1) {
+ psInfo.width = Tk_Width(tkwin);
+ }
+ if (psInfo.height == -1) {
+ psInfo.height = Tk_Height(tkwin);
+ }
+ psInfo.x2 = psInfo.x + psInfo.width;
+ psInfo.y2 = psInfo.y + psInfo.height;
+
+ if (psInfo.pageXString != NULL) {
+ if (GetPostscriptPoints(interp, psInfo.pageXString,
+ &psInfo.pageX) != TCL_OK) {
+ goto cleanup;
+ }
+ }
+ if (psInfo.pageYString != NULL) {
+ if (GetPostscriptPoints(interp, psInfo.pageYString,
+ &psInfo.pageY) != TCL_OK) {
+ goto cleanup;
+ }
+ }
+ if (psInfo.pageWidthString != NULL) {
+ if (GetPostscriptPoints(interp, psInfo.pageWidthString,
+ &psInfo.scale) != TCL_OK) {
+ goto cleanup;
+ }
+ psInfo.scale /= psInfo.width;
+ } else if (psInfo.pageHeightString != NULL) {
+ if (GetPostscriptPoints(interp, psInfo.pageHeightString,
+ &psInfo.scale) != TCL_OK) {
+ goto cleanup;
+ }
+ psInfo.scale /= psInfo.height;
+ } else {
+ psInfo.scale = (72.0/25.4)*WidthMMOfScreen(Tk_Screen(tkwin));
+ psInfo.scale /= WidthOfScreen(Tk_Screen(tkwin));
+ }
+ switch (psInfo.pageAnchor) {
+ case TK_ANCHOR_NW:
+ case TK_ANCHOR_W:
+ case TK_ANCHOR_SW:
+ deltaX = 0;
+ break;
+ case TK_ANCHOR_N:
+ case TK_ANCHOR_CENTER:
+ case TK_ANCHOR_S:
+ deltaX = -psInfo.width/2;
+ break;
+ case TK_ANCHOR_NE:
+ case TK_ANCHOR_E:
+ case TK_ANCHOR_SE:
+ deltaX = -psInfo.width;
+ break;
+ }
+ switch (psInfo.pageAnchor) {
+ case TK_ANCHOR_NW:
+ case TK_ANCHOR_N:
+ case TK_ANCHOR_NE:
+ deltaY = - psInfo.height;
+ break;
+ case TK_ANCHOR_W:
+ case TK_ANCHOR_CENTER:
+ case TK_ANCHOR_E:
+ deltaY = -psInfo.height/2;
+ break;
+ case TK_ANCHOR_SW:
+ case TK_ANCHOR_S:
+ case TK_ANCHOR_SE:
+ deltaY = 0;
+ break;
+ }
+
+ if (psInfo.colorMode == NULL) {
+ psInfo.colorLevel = 2;
+ } else {
+ length = strlen(psInfo.colorMode);
+ if (strncmp(psInfo.colorMode, "monochrome", length) == 0) {
+ psInfo.colorLevel = 0;
+ } else if (strncmp(psInfo.colorMode, "gray", length) == 0) {
+ psInfo.colorLevel = 1;
+ } else if (strncmp(psInfo.colorMode, "color", length) == 0) {
+ psInfo.colorLevel = 2;
+ } else {
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "bad color mode \"%s\": must be monochrome, gray, or color",
+ psInfo.colorMode));
+ Tcl_SetErrorCode(interp, "TK", "CANVAS", "PS", "COLORMODE", NULL);
+ result = TCL_ERROR;
+ goto cleanup;
+ }
+ }
+
+ if (psInfo.fileName != NULL) {
+ /*
+ * Check that -file and -channel are not both specified.
+ */
+
+ if (psInfo.channelName != NULL) {
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "can't specify both -file and -channel", -1));
+ Tcl_SetErrorCode(interp, "TK", "CANVAS", "PS", "USAGE", NULL);
+ result = TCL_ERROR;
+ goto cleanup;
+ }
+
+ /*
+ * Check that we are not in a safe interpreter. If we are, disallow
+ * the -file specification.
+ */
+
+ if (Tcl_IsSafe(interp)) {
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "can't specify -file in a safe interpreter", -1));
+ Tcl_SetErrorCode(interp, "TK", "SAFE", "PS_FILE", NULL);
+ result = TCL_ERROR;
+ goto cleanup;
+ }
+
+ p = Tcl_TranslateFileName(interp, psInfo.fileName, &buffer);
+ if (p == NULL) {
+ goto cleanup;
+ }
+ psInfo.chan = Tcl_OpenFileChannel(interp, p, "w", 0666);
+ Tcl_DStringFree(&buffer);
+ if (psInfo.chan == NULL) {
+ goto cleanup;
+ }
+ }
+
+ if (psInfo.channelName != NULL) {
+ int mode;
+
+ /*
+ * Check that the channel is found in this interpreter and that it is
+ * open for writing.
+ */
+
+ psInfo.chan = Tcl_GetChannel(interp, psInfo.channelName, &mode);
+ if (psInfo.chan == (Tcl_Channel) NULL) {
+ result = TCL_ERROR;
+ goto cleanup;
+ }
+ if (!(mode & TCL_WRITABLE)) {
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "channel \"%s\" wasn't opened for writing",
+ psInfo.channelName));
+ Tcl_SetErrorCode(interp, "TK", "CANVAS", "PS", "UNWRITABLE",NULL);
+ result = TCL_ERROR;
+ goto cleanup;
+ }
+ }
+
+ /*
+ * Make a pre-pass over all of the items, generating Postscript and then
+ * throwing it away. The purpose of this pass is just to collect
+ * information about all the fonts in use, so that we can output font
+ * information in the proper form required by the Document Structuring
+ * Conventions.
+ */
+
+ psInfo.prepass = 1;
+ for (itemPtr = canvasPtr->firstItemPtr; itemPtr != NULL;
+ itemPtr = itemPtr->nextPtr) {
+ if ((itemPtr->x1 >= psInfo.x2) || (itemPtr->x2 < psInfo.x)
+ || (itemPtr->y1 >= psInfo.y2) || (itemPtr->y2 < psInfo.y)) {
+ continue;
+ }
+ if (itemPtr->typePtr->postscriptProc == NULL) {
+ continue;
+ }
+ result = itemPtr->typePtr->postscriptProc(interp,
+ (Tk_Canvas) canvasPtr, itemPtr, 1);
+ Tcl_ResetResult(interp);
+ if (result != TCL_OK) {
+ /*
+ * An error just occurred. Just skip out of this loop. There's no
+ * need to report the error now; it can be reported later (errors
+ * can happen later that don't happen now, so we still have to
+ * check for errors later anyway).
+ */
+
+ break;
+ }
+ }
+ psInfo.prepass = 0;
+
+ /*
+ * Generate the header and prolog for the Postscript.
+ */
+
+ if (psInfo.prolog) {
+ Tcl_AppendToObj(psObj,
+ "%!PS-Adobe-3.0 EPSF-3.0\n"
+ "%%Creator: Tk Canvas Widget\n", -1);
+
+#ifdef HAVE_PW_GECOS
+ if (!Tcl_IsSafe(interp)) {
+ struct passwd *pwPtr = getpwuid(getuid()); /* INTL: Native. */
+
+ Tcl_AppendPrintfToObj(psObj,
+ "%%%%For: %s\n", (pwPtr ? pwPtr->pw_gecos : "Unknown"));
+ endpwent();
+ }
+#endif /* HAVE_PW_GECOS */
+ Tcl_AppendPrintfToObj(psObj,
+ "%%%%Title: Window %s\n", Tk_PathName(tkwin));
+ time(&now);
+ Tcl_AppendPrintfToObj(psObj,
+ "%%%%CreationDate: %s", ctime(&now)); /* INTL: Native. */
+ if (!psInfo.rotate) {
+ Tcl_AppendPrintfToObj(psObj,
+ "%%%%BoundingBox: %d %d %d %d\n",
+ (int) (psInfo.pageX + psInfo.scale*deltaX),
+ (int) (psInfo.pageY + psInfo.scale*deltaY),
+ (int) (psInfo.pageX + psInfo.scale*(deltaX + psInfo.width)
+ + 1.0),
+ (int) (psInfo.pageY + psInfo.scale*(deltaY + psInfo.height)
+ + 1.0));
+ } else {
+ Tcl_AppendPrintfToObj(psObj,
+ "%%%%BoundingBox: %d %d %d %d\n",
+ (int) (psInfo.pageX - psInfo.scale*(deltaY+psInfo.height)),
+ (int) (psInfo.pageY + psInfo.scale*deltaX),
+ (int) (psInfo.pageX - psInfo.scale*deltaY + 1.0),
+ (int) (psInfo.pageY + psInfo.scale*(deltaX + psInfo.width)
+ + 1.0));
+ }
+ Tcl_AppendPrintfToObj(psObj,
+ "%%%%Pages: 1\n"
+ "%%%%DocumentData: Clean7Bit\n"
+ "%%%%Orientation: %s\n",
+ psInfo.rotate ? "Landscape" : "Portrait");
+ p = "%%%%DocumentNeededResources: font %s\n";
+ for (hPtr = Tcl_FirstHashEntry(&psInfo.fontTable, &search);
+ hPtr != NULL; hPtr = Tcl_NextHashEntry(&search)) {
+ Tcl_AppendPrintfToObj(psObj, p,
+ Tcl_GetHashKey(&psInfo.fontTable, hPtr));
+ p = "%%%%+ font %s\n";
+ }
+ Tcl_AppendToObj(psObj, "%%EndComments\n\n", -1);
+
+ /*
+ * Insert the prolog
+ */
+
+ Tcl_AppendObjToObj(psObj, preambleObj);
+
+ if (psInfo.chan != NULL) {
+ if (Tcl_WriteObj(psInfo.chan, psObj) == -1) {
+ channelWriteFailed:
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "problem writing postscript data to channel: %s",
+ Tcl_PosixError(interp)));
+ result = TCL_ERROR;
+ goto cleanup;
+ }
+ Tcl_DecrRefCount(psObj);
+ psObj = Tcl_NewObj();
+ }
+
+ /*
+ * Document setup: set the color level and include fonts.
+ */
+
+ Tcl_AppendPrintfToObj(psObj,
+ "%%%%BeginSetup\n/CL %d def\n", psInfo.colorLevel);
+ for (hPtr = Tcl_FirstHashEntry(&psInfo.fontTable, &search);
+ hPtr != NULL; hPtr = Tcl_NextHashEntry(&search)) {
+ Tcl_AppendPrintfToObj(psObj,
+ "%%%%IncludeResource: font %s\n",
+ (char *) Tcl_GetHashKey(&psInfo.fontTable, hPtr));
+ }
+ Tcl_AppendToObj(psObj, "%%EndSetup\n\n", -1);
+
+ /*
+ * Page setup: move to page positioning point, rotate if needed, set
+ * scale factor, offset for proper anchor position, and set clip
+ * region.
+ */
+
+ Tcl_AppendToObj(psObj, "%%Page: 1 1\nsave\n", -1);
+ Tcl_AppendPrintfToObj(psObj,
+ "%.1f %.1f translate\n", psInfo.pageX, psInfo.pageY);
+ if (psInfo.rotate) {
+ Tcl_AppendToObj(psObj, "90 rotate\n", -1);
+ }
+ Tcl_AppendPrintfToObj(psObj,
+ "%.4g %.4g scale\n", psInfo.scale, psInfo.scale);
+ Tcl_AppendPrintfToObj(psObj,
+ "%d %d translate\n", deltaX - psInfo.x, deltaY);
+ Tcl_AppendPrintfToObj(psObj,
+ "%d %.15g moveto %d %.15g lineto %d %.15g lineto %d %.15g "
+ "lineto closepath clip newpath\n",
+ psInfo.x, Tk_PostscriptY((double)psInfo.y,
+ (Tk_PostscriptInfo)psInfoPtr),
+ psInfo.x2, Tk_PostscriptY((double)psInfo.y,
+ (Tk_PostscriptInfo)psInfoPtr),
+ psInfo.x2, Tk_PostscriptY((double)psInfo.y2,
+ (Tk_PostscriptInfo)psInfoPtr),
+ psInfo.x, Tk_PostscriptY((double)psInfo.y2,
+ (Tk_PostscriptInfo)psInfoPtr));
+ if (psInfo.chan != NULL) {
+ if (Tcl_WriteObj(psInfo.chan, psObj) == -1) {
+ goto channelWriteFailed;
+ }
+ Tcl_DecrRefCount(psObj);
+ psObj = Tcl_NewObj();
+ }
+ }
+
+ /*
+ * Iterate through all the items, having each relevant one draw itself.
+ * Quit if any of the items returns an error.
+ */
+
+ result = TCL_OK;
+ for (itemPtr = canvasPtr->firstItemPtr; itemPtr != NULL;
+ itemPtr = itemPtr->nextPtr) {
+ if ((itemPtr->x1 >= psInfo.x2) || (itemPtr->x2 < psInfo.x)
+ || (itemPtr->y1 >= psInfo.y2) || (itemPtr->y2 < psInfo.y)) {
+ continue;
+ }
+ if (itemPtr->typePtr->postscriptProc == NULL) {
+ continue;
+ }
+ if (itemPtr->state == TK_STATE_HIDDEN) {
+ continue;
+ }
+
+ Tcl_ResetResult(interp);
+ result = itemPtr->typePtr->postscriptProc(interp,
+ (Tk_Canvas) canvasPtr, itemPtr, 0);
+ if (result != TCL_OK) {
+ Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf(
+ "\n (generating Postscript for item %d)",
+ itemPtr->id));
+ goto cleanup;
+ }
+
+ Tcl_AppendToObj(psObj, "gsave\n", -1);
+ Tcl_AppendObjToObj(psObj, Tcl_GetObjResult(interp));
+ Tcl_AppendToObj(psObj, "grestore\n", -1);
+
+ if (psInfo.chan != NULL) {
+ if (Tcl_WriteObj(psInfo.chan, psObj) == -1) {
+ goto channelWriteFailed;
+ }
+ Tcl_DecrRefCount(psObj);
+ psObj = Tcl_NewObj();
+ }
+ }
+
+ /*
+ * Output page-end information, such as commands to print the page and
+ * document trailer stuff.
+ */
+
+ if (psInfo.prolog) {
+ Tcl_AppendToObj(psObj,
+ "restore showpage\n\n"
+ "%%Trailer\n"
+ "end\n"
+ "%%EOF\n", -1);
+
+ if (psInfo.chan != NULL) {
+ if (Tcl_WriteObj(psInfo.chan, psObj) == -1) {
+ goto channelWriteFailed;
+ }
+ }
+ }
+
+ if (psInfo.chan == NULL) {
+ Tcl_SetObjResult(interp, psObj);
+ psObj = Tcl_NewObj();
+ }
+
+ /*
+ * Clean up psInfo to release malloc'ed stuff.
+ */
+
+ cleanup:
+ if (psInfo.pageXString != NULL) {
+ ckfree(psInfo.pageXString);
+ }
+ if (psInfo.pageYString != NULL) {
+ ckfree(psInfo.pageYString);
+ }
+ if (psInfo.pageWidthString != NULL) {
+ ckfree(psInfo.pageWidthString);
+ }
+ if (psInfo.pageHeightString != NULL) {
+ ckfree(psInfo.pageHeightString);
+ }
+ if (psInfo.fontVar != NULL) {
+ ckfree(psInfo.fontVar);
+ }
+ if (psInfo.colorVar != NULL) {
+ ckfree(psInfo.colorVar);
+ }
+ if (psInfo.colorMode != NULL) {
+ ckfree(psInfo.colorMode);
+ }
+ if (psInfo.fileName != NULL) {
+ ckfree(psInfo.fileName);
+ }
+ if ((psInfo.chan != NULL) && (psInfo.channelName == NULL)) {
+ Tcl_Close(interp, psInfo.chan);
+ }
+ if (psInfo.channelName != NULL) {
+ ckfree(psInfo.channelName);
+ }
+ Tcl_DeleteHashTable(&psInfo.fontTable);
+ canvasPtr->psInfo = (Tk_PostscriptInfo) oldInfoPtr;
+ Tcl_DecrRefCount(preambleObj);
+ Tcl_DecrRefCount(psObj);
+ return result;
+}
+
+static inline Tcl_Obj *
+GetPostscriptBuffer(
+ Tcl_Interp *interp)
+{
+ Tcl_Obj *psObj = Tcl_GetObjResult(interp);
+
+ if (Tcl_IsShared(psObj)) {
+ psObj = Tcl_DuplicateObj(psObj);
+ Tcl_SetObjResult(interp, psObj);
+ }
+ return psObj;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * Tk_PostscriptColor --
+ *
+ * This function is called by individual canvas items when they want to
+ * set a color value for output. Given information about an X color, this
+ * function will generate Postscript commands to set up an appropriate
+ * color in Postscript.
+ *
+ * Results:
+ * Returns a standard Tcl return value. If an error occurs then an error
+ * message will be left in the interp's result. If no error occurs, then
+ * additional Postscript will be appended to the interp's result.
+ *
+ * Side effects:
+ * None.
+ *
+ *--------------------------------------------------------------
+ */
+
+int
+Tk_PostscriptColor(
+ Tcl_Interp *interp,
+ Tk_PostscriptInfo psInfo, /* Postscript info. */
+ XColor *colorPtr) /* Information about color. */
+{
+ TkPostscriptInfo *psInfoPtr = (TkPostscriptInfo *) psInfo;
+ double red, green, blue;
+
+ if (psInfoPtr->prepass) {
+ return TCL_OK;
+ }
+
+ /*
+ * If there is a color map defined, then look up the color's name in the
+ * map and use the Postscript commands found there, if there are any.
+ */
+
+ if (psInfoPtr->colorVar != NULL) {
+ const char *cmdString = Tcl_GetVar2(interp, psInfoPtr->colorVar,
+ Tk_NameOfColor(colorPtr), 0);
+
+ if (cmdString != NULL) {
+ Tcl_AppendPrintfToObj(GetPostscriptBuffer(interp),
+ "%s\n", cmdString);
+ return TCL_OK;
+ }
+ }
+
+ /*
+ * No color map entry for this color. Grab the color's intensities and
+ * output Postscript commands for them. Special note: X uses a range of
+ * 0-65535 for intensities, but most displays only use a range of 0-255,
+ * which maps to (0, 256, 512, ... 65280) in the X scale. This means that
+ * there's no way to get perfect white, since the highest intensity is
+ * only 65280 out of 65535. To work around this problem, rescale the X
+ * intensity to a 0-255 scale and use that as the basis for the Postscript
+ * colors. This scheme still won't work if the display only uses 4 bits
+ * per color, but most diplays use at least 8 bits.
+ */
+
+ red = ((double) (((int) colorPtr->red) >> 8))/255.0;
+ green = ((double) (((int) colorPtr->green) >> 8))/255.0;
+ blue = ((double) (((int) colorPtr->blue) >> 8))/255.0;
+ Tcl_AppendPrintfToObj(GetPostscriptBuffer(interp),
+ "%.3f %.3f %.3f setrgbcolor AdjustColor\n",
+ red, green, blue);
+ return TCL_OK;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * Tk_PostscriptFont --
+ *
+ * This function is called by individual canvas items when they want to
+ * output text. Given information about an X font, this function will
+ * generate Postscript commands to set up an appropriate font in
+ * Postscript.
+ *
+ * Results:
+ * Returns a standard Tcl return value. If an error occurs then an error
+ * message will be left in the interp's result. If no error occurs, then
+ * additional Postscript will be appended to the interp's result.
+ *
+ * Side effects:
+ * The Postscript font name is entered into psInfoPtr->fontTable if it
+ * wasn't already there.
+ *
+ *--------------------------------------------------------------
+ */
+
+int
+Tk_PostscriptFont(
+ Tcl_Interp *interp,
+ Tk_PostscriptInfo psInfo, /* Postscript Info. */
+ Tk_Font tkfont) /* Information about font in which text is to
+ * be printed. */
+{
+ TkPostscriptInfo *psInfoPtr = (TkPostscriptInfo *) psInfo;
+ Tcl_DString ds;
+ int i, points;
+ const char *fontname;
+
+ /*
+ * First, look up the font's name in the font map, if there is one. If
+ * there is an entry for this font, it consists of a list containing font
+ * name and size. Use this information.
+ */
+
+ if (psInfoPtr->fontVar != NULL) {
+ const char *name = Tk_NameOfFont(tkfont);
+ Tcl_Obj **objv;
+ int objc;
+ double size;
+ Tcl_Obj *list = Tcl_GetVar2Ex(interp, psInfoPtr->fontVar, name, 0);
+
+ if (list != NULL) {
+ if (Tcl_ListObjGetElements(interp, list, &objc, &objv) != TCL_OK
+ || objc != 2
+ || (fontname = Tcl_GetString(objv[0]))[0] == '\0'
+ || strchr(fontname, ' ') != NULL
+ || Tcl_GetDoubleFromObj(interp, objv[1], &size) != TCL_OK
+ || size <= 0) {
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "bad font map entry for \"%s\": \"%s\"",
+ name, Tcl_GetString(list)));
+ Tcl_SetErrorCode(interp, "TK", "CANVAS", "PS", "FONTMAP",
+ NULL);
+ return TCL_ERROR;
+ }
+
+ Tcl_AppendPrintfToObj(GetPostscriptBuffer(interp),
+ "/%s findfont %d scalefont%s setfont\n",
+ fontname, (int) size,
+ strncasecmp(fontname, "Symbol", 7) ? " ISOEncode" : "");
+ Tcl_CreateHashEntry(&psInfoPtr->fontTable, fontname, &i);
+ return TCL_OK;
+ }
+ }
+
+ /*
+ * Nothing in the font map, so fall back to the old guessing technique.
+ */
+
+ Tcl_DStringInit(&ds);
+ points = Tk_PostscriptFontName(tkfont, &ds);
+ fontname = Tcl_DStringValue(&ds);
+ Tcl_AppendPrintfToObj(GetPostscriptBuffer(interp),
+ "/%s findfont %d scalefont%s setfont\n",
+ fontname, TkFontGetPoints(psInfoPtr->tkwin, points),
+ strncasecmp(fontname, "Symbol", 7) ? " ISOEncode" : "");
+ Tcl_CreateHashEntry(&psInfoPtr->fontTable, Tcl_DStringValue(&ds), &i);
+ Tcl_DStringFree(&ds);
+
+ return TCL_OK;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * Tk_PostscriptBitmap --
+ *
+ * This function is called to output the contents of a sub-region of a
+ * bitmap in proper image data format for Postscript (i.e. data between
+ * angle brackets, one bit per pixel).
+ *
+ * Results:
+ * Returns a standard Tcl return value. If an error occurs then an error
+ * message will be left in the interp's result. If no error occurs, then
+ * additional Postscript will be appended to the interp's result.
+ *
+ * Side effects:
+ * None.
+ *
+ *--------------------------------------------------------------
+ */
+
+int
+Tk_PostscriptBitmap(
+ Tcl_Interp *interp,
+ Tk_Window tkwin,
+ Tk_PostscriptInfo psInfo, /* Postscript info. */
+ Pixmap bitmap, /* Bitmap for which to generate Postscript. */
+ int startX, int startY, /* Coordinates of upper-left corner of
+ * rectangular region to output. */
+ int width, int height) /* Height of rectangular region. */
+{
+ TkPostscriptInfo *psInfoPtr = (TkPostscriptInfo *) psInfo;
+
+ if (psInfoPtr->prepass) {
+ return TCL_OK;
+ }
+
+ PostscriptBitmap(tkwin, bitmap, startX, startY, width, height,
+ GetPostscriptBuffer(interp));
+ return TCL_OK;
+}
+
+static void
+PostscriptBitmap(
+ Tk_Window tkwin,
+ Pixmap bitmap, /* Bitmap for which to generate Postscript. */
+ int startX, int startY, /* Coordinates of upper-left corner of
+ * rectangular region to output. */
+ int width, int height, /* Height of rectangular region. */
+ Tcl_Obj *psObj) /* Where to append the postscript. */
+{
+ XImage *imagePtr;
+ int charsInLine, x, y, lastX, lastY, value, mask;
+ unsigned int totalWidth, totalHeight;
+ Window dummyRoot;
+ int dummyX, dummyY;
+ unsigned dummyBorderwidth, dummyDepth;
+
+ /*
+ * The following call should probably be a call to Tk_SizeOfBitmap
+ * instead, but it seems that we are occasionally invoked by custom item
+ * types that create their own bitmaps without registering them with Tk.
+ * XGetGeometry is a bit slower than Tk_SizeOfBitmap, but it shouldn't
+ * matter here.
+ */
+
+ XGetGeometry(Tk_Display(tkwin), bitmap, &dummyRoot,
+ (int *) &dummyX, (int *) &dummyY, (unsigned int *) &totalWidth,
+ (unsigned int *) &totalHeight, &dummyBorderwidth, &dummyDepth);
+ imagePtr = XGetImage(Tk_Display(tkwin), bitmap, 0, 0,
+ totalWidth, totalHeight, 1, XYPixmap);
+
+ Tcl_AppendToObj(psObj, "<", -1);
+ mask = 0x80;
+ value = 0;
+ charsInLine = 0;
+ lastX = startX + width - 1;
+ lastY = startY + height - 1;
+ for (y = lastY; y >= startY; y--) {
+ for (x = startX; x <= lastX; x++) {
+ if (XGetPixel(imagePtr, x, y)) {
+ value |= mask;
+ }
+ mask >>= 1;
+ if (mask == 0) {
+ Tcl_AppendPrintfToObj(psObj, "%02x", value);
+ mask = 0x80;
+ value = 0;
+ charsInLine += 2;
+ if (charsInLine >= 60) {
+ Tcl_AppendToObj(psObj, "\n", -1);
+ charsInLine = 0;
+ }
+ }
+ }
+ if (mask != 0x80) {
+ Tcl_AppendPrintfToObj(psObj, "%02x", value);
+ mask = 0x80;
+ value = 0;
+ charsInLine += 2;
+ }
+ }
+ Tcl_AppendToObj(psObj, ">", -1);
+
+ XDestroyImage(imagePtr);
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * Tk_PostscriptStipple --
+ *
+ * This function 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 function will generate
+ * Postscript commands to fill the current clip region using a stipple
+ * pattern defined by the bitmap.
+ *
+ * Results:
+ * Returns a standard Tcl return value. If an error occurs then an error
+ * message will be left in the interp's result. If no error occurs, then
+ * additional Postscript will be appended to the interp's result.
+ *
+ * Side effects:
+ * None.
+ *
+ *--------------------------------------------------------------
+ */
+
+int
+Tk_PostscriptStipple(
+ Tcl_Interp *interp,
+ Tk_Window tkwin,
+ Tk_PostscriptInfo psInfo, /* Interpreter for returning Postscript or
+ * error message. */
+ Pixmap bitmap) /* Bitmap to use for stippling. */
+{
+ TkPostscriptInfo *psInfoPtr = (TkPostscriptInfo *) psInfo;
+ int width, height;
+ Window dummyRoot;
+ int dummyX, dummyY;
+ unsigned dummyBorderwidth, dummyDepth;
+ Tcl_Obj *psObj;
+
+ if (psInfoPtr->prepass) {
+ return TCL_OK;
+ }
+
+ /*
+ * The following call should probably be a call to Tk_SizeOfBitmap
+ * instead, but it seems that we are occasionally invoked by custom item
+ * types that create their own bitmaps without registering them with Tk.
+ * XGetGeometry is a bit slower than Tk_SizeOfBitmap, but it shouldn't
+ * matter here.
+ */
+
+ XGetGeometry(Tk_Display(tkwin), bitmap, &dummyRoot,
+ (int *) &dummyX, (int *) &dummyY, (unsigned *) &width,
+ (unsigned *) &height, &dummyBorderwidth, &dummyDepth);
+
+ psObj = GetPostscriptBuffer(interp);
+ Tcl_AppendPrintfToObj(psObj, "%d %d ", width, height);
+ PostscriptBitmap(tkwin, bitmap, 0, 0, width, height, psObj);
+ Tcl_AppendToObj(psObj, " StippleFill\n", -1);
+ return TCL_OK;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * Tk_PostscriptY --
+ *
+ * Given a y-coordinate in local coordinates, this function returns a
+ * y-coordinate to use for Postscript output. Required because canvases
+ * have their origin in the top-left, but postscript pages have their
+ * origin in the bottom left.
+ *
+ * Results:
+ * Returns the Postscript coordinate that corresponds to "y".
+ *
+ * Side effects:
+ * None.
+ *
+ *--------------------------------------------------------------
+ */
+
+double
+Tk_PostscriptY(
+ double y, /* Y-coordinate in canvas coords. */
+ Tk_PostscriptInfo psInfo) /* Postscript info */
+{
+ TkPostscriptInfo *psInfoPtr = (TkPostscriptInfo *) psInfo;
+
+ return psInfoPtr->y2 - y;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * Tk_PostscriptPath --
+ *
+ * Given an array of points for a path, generate Postscript commands to
+ * create the path.
+ *
+ * Results:
+ * Postscript commands get appended to what's in the interp's result.
+ *
+ * Side effects:
+ * None.
+ *
+ *--------------------------------------------------------------
+ */
+
+void
+Tk_PostscriptPath(
+ Tcl_Interp *interp,
+ Tk_PostscriptInfo psInfo, /* Canvas on whose behalf Postscript is being
+ * generated. */
+ double *coordPtr, /* Pointer to first in array of 2*numPoints
+ * coordinates giving points for path. */
+ int numPoints) /* Number of points at *coordPtr. */
+{
+ TkPostscriptInfo *psInfoPtr = (TkPostscriptInfo *) psInfo;
+ Tcl_Obj *psObj;
+
+ if (psInfoPtr->prepass) {
+ return;
+ }
+
+ psObj = GetPostscriptBuffer(interp);
+ Tcl_AppendPrintfToObj(psObj, "%.15g %.15g moveto\n",
+ coordPtr[0], Tk_PostscriptY(coordPtr[1], psInfo));
+ for (numPoints--, coordPtr += 2; numPoints > 0;
+ numPoints--, coordPtr += 2) {
+ Tcl_AppendPrintfToObj(psObj, "%.15g %.15g lineto\n",
+ coordPtr[0], Tk_PostscriptY(coordPtr[1], psInfo));
+ }
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * GetPostscriptPoints --
+ *
+ * Given a string, returns the number of Postscript points corresponding
+ * to that string.
+ *
+ * Results:
+ * The return value is a standard Tcl return result. If TCL_OK is
+ * returned, then everything went well and the screen distance is stored
+ * at *doublePtr; otherwise TCL_ERROR is returned and an error message is
+ * left in the interp's result.
+ *
+ * Side effects:
+ * None.
+ *
+ *--------------------------------------------------------------
+ */
+
+static int
+GetPostscriptPoints(
+ Tcl_Interp *interp, /* Use this for error reporting. */
+ char *string, /* String describing a screen distance. */
+ double *doublePtr) /* Place to store converted result. */
+{
+ char *end;
+ double d;
+
+ d = strtod(string, &end);
+ if (end == string) {
+ goto error;
+ }
+ while ((*end != '\0') && isspace(UCHAR(*end))) {
+ end++;
+ }
+ switch (*end) {
+ case 'c':
+ d *= 72.0/2.54;
+ end++;
+ break;
+ case 'i':
+ d *= 72.0;
+ end++;
+ break;
+ case 'm':
+ d *= 72.0/25.4;
+ end++;
+ break;
+ case 0:
+ break;
+ case 'p':
+ end++;
+ break;
+ default:
+ goto error;
+ }
+ while ((*end != '\0') && isspace(UCHAR(*end))) {
+ end++;
+ }
+ if (*end != 0) {
+ goto error;
+ }
+ *doublePtr = d;
+ return TCL_OK;
+
+ error:
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf("bad distance \"%s\"", string));
+ Tcl_SetErrorCode(interp, "TK", "CANVAS", "PS", "POINTS", NULL);
+ return TCL_ERROR;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * TkImageGetColor --
+ *
+ * This function 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.
+ *
+ * This implementation is bogus on Windows because the colormap data is
+ * never filled in. Instead all postscript generated data coming through
+ * here is expected to be RGB color data. To handle lower bit-depth
+ * images properly, XQueryColors must be implemented for Windows.
+ *
+ * Results:
+ * Returns red, green, and blue color values in the range 0 to 1. There
+ * are no error returns.
+ *
+ * Side effects:
+ * None.
+ *
+ *--------------------------------------------------------------
+ */
+
+#ifdef _WIN32
+#include <windows.h>
+
+/*
+ * We could just define these instead of pulling in windows.h.
+ #define GetRValue(rgb) ((BYTE)(rgb))
+ #define GetGValue(rgb) ((BYTE)(((WORD)(rgb)) >> 8))
+ #define GetBValue(rgb) ((BYTE)((rgb)>>16))
+ */
+
+#else /* !_WIN32 */
+
+#define GetRValue(rgb) ((rgb & cdata->red_mask) >> cdata->red_shift)
+#define GetGValue(rgb) ((rgb & cdata->green_mask) >> cdata->green_shift)
+#define GetBValue(rgb) ((rgb & cdata->blue_mask) >> cdata->blue_shift)
+
+#endif /* _WIN32 */
+
+#if defined(_WIN32) || defined(MAC_OSX_TK)
+static void
+TkImageGetColor(
+ TkColormapData *cdata, /* Colormap data */
+ unsigned long pixel, /* Pixel value to look up */
+ double *red, double *green, double *blue)
+ /* Color data to return */
+{
+ *red = (double) GetRValue(pixel) / 255.0;
+ *green = (double) GetGValue(pixel) / 255.0;
+ *blue = (double) GetBValue(pixel) / 255.0;
+}
+#else /* ! (_WIN32 || MAC_OSX_TK) */
+static void
+TkImageGetColor(
+ TkColormapData *cdata, /* Colormap data */
+ unsigned long pixel, /* Pixel value to look up */
+ double *red, double *green, double *blue)
+ /* Color data to return */
+{
+ if (cdata->separated) {
+ int r = GetRValue(pixel);
+ int g = GetGValue(pixel);
+ int b = GetBValue(pixel);
+
+ *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;
+ }
+}
+#endif /* _WIN32 || MAC_OSX_TK */
+
+/*
+ *--------------------------------------------------------------
+ *
+ * TkPostscriptImage --
+ *
+ * This function 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(
+ Tcl_Interp *interp,
+ Tk_Window tkwin,
+ Tk_PostscriptInfo psInfo, /* postscript info */
+ XImage *ximage, /* Image to draw */
+ int x, int y, /* First pixel to output */
+ int width, int height) /* Width and height of area */
+{
+ TkPostscriptInfo *psInfoPtr = (TkPostscriptInfo *) psInfo;
+ int xx, yy, band, maxRows;
+ double red, green, blue;
+ int bytesPerLine = 0, maxWidth = 0;
+ int level = psInfoPtr->colorLevel;
+ Colormap cmap;
+ int i, ncolors;
+ Visual *visual;
+ TkColormapData cdata;
+ Tcl_Obj *psObj;
+
+ if (psInfoPtr->prepass) {
+ return TCL_OK;
+ }
+
+ cmap = Tk_Colormap(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 = 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;
+ default: bytesPerLine = 3 * width; maxWidth = 20000; break;
+ }
+
+ if (bytesPerLine > 60000) {
+ Tcl_ResetResult(interp);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "can't generate Postscript for images more than %d pixels wide",
+ maxWidth));
+ Tcl_SetErrorCode(interp, "TK", "CANVAS", "PS", "MEMLIMIT", NULL);
+ ckfree(cdata.colors);
+ return TCL_ERROR;
+ }
+
+ maxRows = 60000 / bytesPerLine;
+ psObj = GetPostscriptBuffer(interp);
+
+ for (band = height-1; band >= 0; band -= maxRows) {
+ int rows = (band >= maxRows) ? maxRows : band + 1;
+ int lineLen = 0;
+
+ switch (level) {
+ case 0:
+ Tcl_AppendPrintfToObj(psObj, "%d %d 1 matrix {\n<", width, rows);
+ break;
+ case 1:
+ Tcl_AppendPrintfToObj(psObj, "%d %d 8 matrix {\n<", width, rows);
+ break;
+ default:
+ Tcl_AppendPrintfToObj(psObj, "%d %d 8 matrix {\n<", width, rows);
+ 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) {
+ Tcl_AppendPrintfToObj(psObj, "%02X", data);
+ lineLen += 2;
+ if (lineLen > 60) {
+ lineLen = 0;
+ Tcl_AppendToObj(psObj, "\n", -1);
+ }
+ mask = 0x80;
+ data = 0x00;
+ }
+ }
+ if ((width % 8) != 0) {
+ Tcl_AppendPrintfToObj(psObj, "%02X", data);
+ 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);
+ Tcl_AppendPrintfToObj(psObj, "%02X",
+ (int) floor(0.5 + 255.0 *
+ (0.30 * red + 0.59 * green + 0.11 * blue)));
+ lineLen += 2;
+ if (lineLen > 60) {
+ lineLen = 0;
+ Tcl_AppendToObj(psObj, "\n", -1);
+ }
+ }
+ break;
+ default:
+ /*
+ * 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);
+ Tcl_AppendPrintfToObj(psObj, "%02X%02X%02X",
+ (int) floor(0.5 + 255.0 * red),
+ (int) floor(0.5 + 255.0 * green),
+ (int) floor(0.5 + 255.0 * blue));
+ lineLen += 6;
+ if (lineLen > 60) {
+ lineLen = 0;
+ Tcl_AppendToObj(psObj, "\n", -1);
+ }
+ }
+ break;
+ }
+ }
+ switch (level) {
+ case 0: case 1:
+ Tcl_AppendToObj(psObj, ">\n} image\n", -1); break;
+ default:
+ Tcl_AppendToObj(psObj, ">\n} false 3 colorimage\n", -1); break;
+ }
+ Tcl_AppendPrintfToObj(psObj, "0 %d translate\n", rows);
+ }
+ ckfree(cdata.colors);
+ return TCL_OK;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * Tk_PostscriptPhoto --
+ *
+ * This function 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(
+ Tcl_Interp *interp,
+ Tk_PhotoImageBlock *blockPtr,
+ Tk_PostscriptInfo psInfo,
+ int width, int height)
+{
+ TkPostscriptInfo *psInfoPtr = (TkPostscriptInfo *) psInfo;
+ int colorLevel = psInfoPtr->colorLevel;
+ const char *displayOperation, *decode;
+ unsigned char *pixelPtr;
+ int bpc, xx, yy, lineLen, alpha;
+ float red, green, blue;
+ int bytesPerLine = 0, maxWidth = 0;
+ unsigned char opaque = 255;
+ unsigned char *alphaPtr;
+ int alphaOffset, alphaPitch, alphaIncr;
+ Tcl_Obj *psObj;
+
+ if (psInfoPtr->prepass) {
+ return TCL_OK;
+ }
+
+ if (colorLevel != 0) {
+ /*
+ * Color and gray-scale code.
+ */
+
+ displayOperation = "TkPhotoColor";
+ } else {
+ /*
+ * Monochrome-only code
+ */
+
+ displayOperation = "TkPhotoMono";
+ }
+
+ /*
+ * 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;
+ default: bytesPerLine = 3 * width; maxWidth = 20000; break;
+ }
+ if (bytesPerLine > 60000) {
+ Tcl_ResetResult(interp);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "can't generate Postscript for images more than %d pixels wide",
+ maxWidth));
+ Tcl_SetErrorCode(interp, "TK", "CANVAS", "PS", "MEMLIMIT", NULL);
+ return TCL_ERROR;
+ }
+
+ /*
+ * Set up the postscript code except for the image-data stream.
+ */
+
+ psObj = GetPostscriptBuffer(interp);
+ switch (colorLevel) {
+ case 0:
+ Tcl_AppendToObj(psObj, "/DeviceGray setcolorspace\n\n", -1);
+ decode = "1 0";
+ bpc = 1;
+ break;
+ case 1:
+ Tcl_AppendToObj(psObj, "/DeviceGray setcolorspace\n\n", -1);
+ decode = "0 1";
+ bpc = 8;
+ break;
+ default:
+ Tcl_AppendToObj(psObj, "/DeviceRGB setcolorspace\n\n", -1);
+ decode = "0 1 0 1 0 1";
+ bpc = 8;
+ break;
+ }
+
+ Tcl_AppendPrintfToObj(psObj,
+ "<<\n /ImageType 1\n"
+ " /Width %d\n /Height %d\n /BitsPerComponent %d\n"
+ " /DataSource currentfile\n /ASCIIHexDecode filter\n"
+ " /ImageMatrix [1 0 0 -1 0 %d]\n /Decode [%s]\n>>\n"
+ "1 %s\n",
+ width, height, bpc, height, decode, displayOperation);
+
+ /*
+ * 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) {
+ Tcl_AppendPrintfToObj(psObj, "%02X", data);
+ lineLen += 2;
+ if (lineLen >= 60) {
+ lineLen = 0;
+ Tcl_AppendToObj(psObj, "\n", -1);
+ }
+ mask = 0x80;
+ data = 0x00;
+ }
+ }
+ if ((width % 8) != 0) {
+ Tcl_AppendPrintfToObj(psObj, "%02X", data);
+ 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) {
+ Tcl_AppendPrintfToObj(psObj, "%02X", data);
+ lineLen += 2;
+ if (lineLen >= 60) {
+ lineLen = 0;
+ Tcl_AppendToObj(psObj, "\n", -1);
+ }
+ mask = 0x80;
+ data = 0x00;
+ }
+ }
+ if ((width % 8) != 0) {
+ Tcl_AppendPrintfToObj(psObj, "%02X", data);
+ 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);
+ Tcl_AppendPrintfToObj(psObj, "%02X", alpha | 0x01);
+ lineLen += 2;
+ if (lineLen >= 60) {
+ lineLen = 0;
+ Tcl_AppendToObj(psObj, "\n", -1);
+ }
+ }
+
+ /*
+ * 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]];
+
+ Tcl_AppendPrintfToObj(psObj, "%02X", (int) floor(0.5 +
+ ( 0.3086 * red + 0.6094 * green + 0.0820 * blue)));
+ lineLen += 2;
+ if (lineLen >= 60) {
+ lineLen = 0;
+ Tcl_AppendToObj(psObj, "\n", -1);
+ }
+ }
+ 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);
+ Tcl_AppendPrintfToObj(psObj, "%02X", alpha | 0x01);
+ lineLen += 2;
+ if (lineLen >= 60) {
+ lineLen = 0;
+ Tcl_AppendToObj(psObj, "\n", -1);
+ }
+ }
+
+ /*
+ * 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);
+
+ Tcl_AppendPrintfToObj(psObj, "%02X%02X%02X",
+ pixelPtr[blockPtr->offset[0]],
+ pixelPtr[blockPtr->offset[1]],
+ pixelPtr[blockPtr->offset[2]]);
+ lineLen += 6;
+ if (lineLen >= 60) {
+ lineLen = 0;
+ Tcl_AppendToObj(psObj, "\n", -1);
+ }
+ }
+ break;
+ }
+ }
+
+ /*
+ * The end-of-data marker.
+ */
+
+ Tcl_AppendToObj(psObj, ">\n", -1);
+ return TCL_OK;
+}
+
+/*
+ * Local Variables:
+ * mode: c
+ * c-basic-offset: 4
+ * fill-column: 78
+ * End:
+ */
diff --git a/tk8.6/generic/tkCanvText.c b/tk8.6/generic/tkCanvText.c
new file mode 100644
index 0000000..eb8dfe3
--- /dev/null
+++ b/tk8.6/generic/tkCanvText.c
@@ -0,0 +1,1660 @@
+/*
+ * tkCanvText.c --
+ *
+ * This file implements text items for canvas widgets.
+ *
+ * Copyright (c) 1991-1994 The Regents of the University of California.
+ * Copyright (c) 1994-1997 Sun Microsystems, Inc.
+ *
+ * See the file "license.terms" for information on usage and redistribution of
+ * this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ */
+
+#include "tkInt.h"
+#include "tkCanvas.h"
+#include "default.h"
+
+/*
+ * The structure below defines the record for each text item.
+ */
+
+typedef struct TextItem {
+ Tk_Item header; /* Generic stuff that's the same for all
+ * types. MUST BE FIRST IN STRUCTURE. */
+ Tk_CanvasTextInfo *textInfoPtr;
+ /* Pointer to a structure containing
+ * information about the selection and
+ * insertion cursor. The structure is owned by
+ * (and shared with) the generic canvas
+ * code. */
+ /*
+ * Fields that are set by widget commands other than "configure".
+ */
+
+ double x, y; /* Positioning point for text. */
+ int insertPos; /* Character index of character just before
+ * which the insertion cursor is displayed. */
+
+ /*
+ * Configuration settings that are updated by Tk_ConfigureWidget.
+ */
+
+ Tk_Anchor anchor; /* Where to anchor text relative to (x,y). */
+ Tk_TSOffset tsoffset;
+ XColor *color; /* Color for text. */
+ XColor *activeColor; /* Color for text. */
+ XColor *disabledColor; /* Color for text. */
+ Tk_Font tkfont; /* Font for drawing text. */
+ Tk_Justify justify; /* Justification mode for text. */
+ Pixmap stipple; /* Stipple bitmap for text, or None. */
+ Pixmap activeStipple; /* Stipple bitmap for text, or None. */
+ Pixmap disabledStipple; /* Stipple bitmap for text, or None. */
+ char *text; /* Text for item (malloc-ed). */
+ int width; /* Width of lines for word-wrap, pixels. Zero
+ * means no word-wrap. */
+ int underline; /* Index of character to put underline beneath
+ * or -1 for no underlining. */
+ double angle; /* What angle, in degrees, to draw the text
+ * at. */
+
+ /*
+ * Fields whose values are derived from the current values of the
+ * configuration settings above.
+ */
+
+ int numChars; /* Length of text in characters. */
+ int numBytes; /* Length of text in bytes. */
+ Tk_TextLayout textLayout; /* Cached text layout information. */
+ int actualWidth; /* Width of text as computed. Used to make
+ * selections of wrapped text display
+ * right. */
+ double drawOrigin[2]; /* Where we start drawing from. */
+ GC gc; /* Graphics context for drawing text. */
+ GC selTextGC; /* Graphics context for selected text. */
+ GC cursorOffGC; /* If not None, this gives a graphics context
+ * to use to draw the insertion cursor when
+ * it's off. Used if the selection and
+ * insertion cursor colors are the same. */
+ double sine; /* Sine of angle field. */
+ double cosine; /* Cosine of angle field. */
+} TextItem;
+
+/*
+ * Information used for parsing configuration specs:
+ */
+
+static const Tk_CustomOption stateOption = {
+ TkStateParseProc, TkStatePrintProc, INT2PTR(2)
+};
+static const Tk_CustomOption tagsOption = {
+ Tk_CanvasTagsParseProc, Tk_CanvasTagsPrintProc, NULL
+};
+static const Tk_CustomOption offsetOption = {
+ TkOffsetParseProc, TkOffsetPrintProc, INT2PTR(TK_OFFSET_RELATIVE)
+};
+
+static const Tk_ConfigSpec configSpecs[] = {
+ {TK_CONFIG_COLOR, "-activefill", NULL, NULL,
+ NULL, Tk_Offset(TextItem, activeColor), TK_CONFIG_NULL_OK, NULL},
+ {TK_CONFIG_BITMAP, "-activestipple", NULL, NULL,
+ NULL, Tk_Offset(TextItem, activeStipple), TK_CONFIG_NULL_OK, NULL},
+ {TK_CONFIG_ANCHOR, "-anchor", NULL, NULL,
+ "center", Tk_Offset(TextItem, anchor), TK_CONFIG_DONT_SET_DEFAULT, NULL},
+ {TK_CONFIG_DOUBLE, "-angle", NULL, NULL,
+ "0.0", Tk_Offset(TextItem, angle), TK_CONFIG_DONT_SET_DEFAULT, NULL},
+ {TK_CONFIG_COLOR, "-disabledfill", NULL, NULL,
+ NULL, Tk_Offset(TextItem, disabledColor), TK_CONFIG_NULL_OK, NULL},
+ {TK_CONFIG_BITMAP, "-disabledstipple", NULL, NULL,
+ NULL, Tk_Offset(TextItem, disabledStipple), TK_CONFIG_NULL_OK, NULL},
+ {TK_CONFIG_COLOR, "-fill", NULL, NULL,
+ "black", Tk_Offset(TextItem, color), TK_CONFIG_NULL_OK, NULL},
+ {TK_CONFIG_FONT, "-font", NULL, NULL,
+ DEF_CANVTEXT_FONT, Tk_Offset(TextItem, tkfont), 0, NULL},
+ {TK_CONFIG_JUSTIFY, "-justify", NULL, NULL,
+ "left", Tk_Offset(TextItem, justify), TK_CONFIG_DONT_SET_DEFAULT, NULL},
+ {TK_CONFIG_CUSTOM, "-offset", NULL, NULL,
+ "0,0", Tk_Offset(TextItem, tsoffset),
+ TK_CONFIG_DONT_SET_DEFAULT, &offsetOption},
+ {TK_CONFIG_CUSTOM, "-state", NULL, NULL,
+ NULL, Tk_Offset(Tk_Item, state), TK_CONFIG_NULL_OK, &stateOption},
+ {TK_CONFIG_BITMAP, "-stipple", NULL, NULL,
+ NULL, Tk_Offset(TextItem, stipple), TK_CONFIG_NULL_OK, NULL},
+ {TK_CONFIG_CUSTOM, "-tags", NULL, NULL,
+ NULL, 0, TK_CONFIG_NULL_OK, &tagsOption},
+ {TK_CONFIG_STRING, "-text", NULL, NULL,
+ "", Tk_Offset(TextItem, text), 0, NULL},
+ {TK_CONFIG_INT, "-underline", NULL, NULL,
+ "-1", Tk_Offset(TextItem, underline), 0, NULL},
+ {TK_CONFIG_PIXELS, "-width", NULL, NULL,
+ "0", Tk_Offset(TextItem, width), TK_CONFIG_DONT_SET_DEFAULT, NULL},
+ {TK_CONFIG_END, NULL, NULL, NULL, NULL, 0, 0, NULL}
+};
+
+/*
+ * Prototypes for functions defined in this file:
+ */
+
+static void ComputeTextBbox(Tk_Canvas canvas, TextItem *textPtr);
+static int ConfigureText(Tcl_Interp *interp,
+ Tk_Canvas canvas, Tk_Item *itemPtr, int argc,
+ Tcl_Obj *const objv[], int flags);
+static int CreateText(Tcl_Interp *interp,
+ Tk_Canvas canvas, struct Tk_Item *itemPtr,
+ int argc, Tcl_Obj *const objv[]);
+static void DeleteText(Tk_Canvas canvas,
+ Tk_Item *itemPtr, Display *display);
+static void DisplayCanvText(Tk_Canvas canvas,
+ Tk_Item *itemPtr, Display *display, Drawable dst,
+ int x, int y, int width, int height);
+static int GetSelText(Tk_Canvas canvas,
+ Tk_Item *itemPtr, int offset, char *buffer,
+ int maxBytes);
+static int GetTextIndex(Tcl_Interp *interp,
+ Tk_Canvas canvas, Tk_Item *itemPtr,
+ Tcl_Obj *obj, int *indexPtr);
+static void ScaleText(Tk_Canvas canvas,
+ Tk_Item *itemPtr, double originX, double originY,
+ double scaleX, double scaleY);
+static void SetTextCursor(Tk_Canvas canvas,
+ Tk_Item *itemPtr, int index);
+static int TextCoords(Tcl_Interp *interp,
+ Tk_Canvas canvas, Tk_Item *itemPtr,
+ int argc, Tcl_Obj *const objv[]);
+static void TextDeleteChars(Tk_Canvas canvas,
+ Tk_Item *itemPtr, int first, int last);
+static void TextInsert(Tk_Canvas canvas,
+ Tk_Item *itemPtr, int beforeThis, Tcl_Obj *obj);
+static int TextToArea(Tk_Canvas canvas,
+ Tk_Item *itemPtr, double *rectPtr);
+static double TextToPoint(Tk_Canvas canvas,
+ Tk_Item *itemPtr, double *pointPtr);
+static int TextToPostscript(Tcl_Interp *interp,
+ Tk_Canvas canvas, Tk_Item *itemPtr, int prepass);
+static void TranslateText(Tk_Canvas canvas,
+ Tk_Item *itemPtr, double deltaX, double deltaY);
+
+/*
+ * The structures below defines the rectangle and oval item types by means of
+ * functions that can be invoked by generic item code.
+ */
+
+Tk_ItemType tkTextType = {
+ "text", /* name */
+ sizeof(TextItem), /* itemSize */
+ CreateText, /* createProc */
+ configSpecs, /* configSpecs */
+ ConfigureText, /* configureProc */
+ TextCoords, /* coordProc */
+ DeleteText, /* deleteProc */
+ DisplayCanvText, /* displayProc */
+ TK_CONFIG_OBJS, /* flags */
+ TextToPoint, /* pointProc */
+ TextToArea, /* areaProc */
+ TextToPostscript, /* postscriptProc */
+ ScaleText, /* scaleProc */
+ TranslateText, /* translateProc */
+ GetTextIndex, /* indexProc */
+ SetTextCursor, /* icursorProc */
+ GetSelText, /* selectionProc */
+ TextInsert, /* insertProc */
+ TextDeleteChars, /* dTextProc */
+ NULL, /* nextPtr */
+ NULL, 0, NULL, NULL
+};
+
+#define ROUND(d) ((int) floor((d) + 0.5))
+
+/*
+ *--------------------------------------------------------------
+ *
+ * CreateText --
+ *
+ * This function is invoked to create a new text item in a canvas.
+ *
+ * Results:
+ * A standard Tcl return value. If an error occurred in creating the item
+ * then an error message is left in the interp's result; in this case
+ * itemPtr is left uninitialized so it can be safely freed by the caller.
+ *
+ * Side effects:
+ * A new text item is created.
+ *
+ *--------------------------------------------------------------
+ */
+
+static int
+CreateText(
+ Tcl_Interp *interp, /* Interpreter for error reporting. */
+ Tk_Canvas canvas, /* Canvas to hold new item. */
+ Tk_Item *itemPtr, /* Record to hold new item; header has been
+ * initialized by caller. */
+ int objc, /* Number of arguments in objv. */
+ Tcl_Obj *const objv[]) /* Arguments describing rectangle. */
+{
+ TextItem *textPtr = (TextItem *) itemPtr;
+ int i;
+
+ if (objc == 0) {
+ Tcl_Panic("canvas did not pass any coords");
+ }
+
+ /*
+ * Carry out initialization that is needed in order to clean up after
+ * errors during the the remainder of this function.
+ */
+
+ textPtr->textInfoPtr = Tk_CanvasGetTextInfo(canvas);
+
+ textPtr->insertPos = 0;
+
+ textPtr->anchor = TK_ANCHOR_CENTER;
+ textPtr->tsoffset.flags = 0;
+ textPtr->tsoffset.xoffset = 0;
+ textPtr->tsoffset.yoffset = 0;
+ textPtr->color = NULL;
+ textPtr->activeColor = NULL;
+ textPtr->disabledColor = NULL;
+ textPtr->tkfont = NULL;
+ textPtr->justify = TK_JUSTIFY_LEFT;
+ textPtr->stipple = None;
+ textPtr->activeStipple = None;
+ textPtr->disabledStipple = None;
+ textPtr->text = NULL;
+ textPtr->width = 0;
+ textPtr->underline = -1;
+ textPtr->angle = 0.0;
+
+ textPtr->numChars = 0;
+ textPtr->numBytes = 0;
+ textPtr->textLayout = NULL;
+ textPtr->actualWidth = 0;
+ textPtr->drawOrigin[0] = textPtr->drawOrigin[1] = 0.0;
+ textPtr->gc = None;
+ textPtr->selTextGC = None;
+ textPtr->cursorOffGC = None;
+ textPtr->sine = 0.0;
+ textPtr->cosine = 1.0;
+
+ /*
+ * Process the arguments to fill in the item record. Only 1 (list) or 2 (x
+ * y) coords are allowed.
+ */
+
+ if (objc == 1) {
+ i = 1;
+ } else {
+ const char *arg = Tcl_GetString(objv[1]);
+
+ i = 2;
+ if ((arg[0] == '-') && (arg[1] >= 'a') && (arg[1] <= 'z')) {
+ i = 1;
+ }
+ }
+ if ((TextCoords(interp, canvas, itemPtr, i, objv) != TCL_OK)) {
+ goto error;
+ }
+ if (ConfigureText(interp, canvas, itemPtr, objc-i, objv+i, 0) == TCL_OK) {
+ return TCL_OK;
+ }
+
+ error:
+ DeleteText(canvas, itemPtr, Tk_Display(Tk_CanvasTkwin(canvas)));
+ return TCL_ERROR;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * TextCoords --
+ *
+ * This function is invoked to process the "coords" widget command on
+ * text items. See the user documentation for details on what it does.
+ *
+ * Results:
+ * Returns TCL_OK or TCL_ERROR, and sets the interp's result.
+ *
+ * Side effects:
+ * The coordinates for the given item may be changed.
+ *
+ *--------------------------------------------------------------
+ */
+
+static int
+TextCoords(
+ Tcl_Interp *interp, /* Used for error reporting. */
+ Tk_Canvas canvas, /* Canvas containing item. */
+ Tk_Item *itemPtr, /* Item whose coordinates are to be read or
+ * modified. */
+ int objc, /* Number of coordinates supplied in objv. */
+ Tcl_Obj *const objv[]) /* Array of coordinates: x1, y1, x2, y2, ... */
+{
+ TextItem *textPtr = (TextItem *) itemPtr;
+
+ if (objc == 0) {
+ Tcl_Obj *obj = Tcl_NewObj();
+ Tcl_Obj *subobj = Tcl_NewDoubleObj(textPtr->x);
+
+ Tcl_ListObjAppendElement(interp, obj, subobj);
+ subobj = Tcl_NewDoubleObj(textPtr->y);
+ Tcl_ListObjAppendElement(interp, obj, subobj);
+ Tcl_SetObjResult(interp, obj);
+ return TCL_OK;
+ } else if (objc > 2) {
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "wrong # coordinates: expected 0 or 2, got %d", objc));
+ Tcl_SetErrorCode(interp, "TK", "CANVAS", "COORDS", "TEXT", NULL);
+ return TCL_ERROR;
+ }
+
+ if (objc == 1) {
+ if (Tcl_ListObjGetElements(interp, objv[0], &objc,
+ (Tcl_Obj ***) &objv) != TCL_OK) {
+ return TCL_ERROR;
+ } else if (objc != 2) {
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "wrong # coordinates: expected 2, got %d", objc));
+ Tcl_SetErrorCode(interp, "TK", "CANVAS", "COORDS", "TEXT", NULL);
+ return TCL_ERROR;
+ }
+ }
+ if ((Tk_CanvasGetCoordFromObj(interp, canvas, objv[0],
+ &textPtr->x) != TCL_OK)
+ || (Tk_CanvasGetCoordFromObj(interp, canvas, objv[1],
+ &textPtr->y) != TCL_OK)) {
+ return TCL_ERROR;
+ }
+ ComputeTextBbox(canvas, textPtr);
+ return TCL_OK;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * ConfigureText --
+ *
+ * This function is invoked to configure various aspects of a text item,
+ * such as its border and background colors.
+ *
+ * Results:
+ * A standard Tcl result code. If an error occurs, then an error message
+ * is left in the interp's result.
+ *
+ * Side effects:
+ * Configuration information, such as colors and stipple patterns, may be
+ * set for itemPtr.
+ *
+ *--------------------------------------------------------------
+ */
+
+static int
+ConfigureText(
+ Tcl_Interp *interp, /* Interpreter for error reporting. */
+ Tk_Canvas canvas, /* Canvas containing itemPtr. */
+ Tk_Item *itemPtr, /* Rectangle item to reconfigure. */
+ int objc, /* Number of elements in objv. */
+ Tcl_Obj *const objv[], /* Arguments describing things to configure. */
+ int flags) /* Flags to pass to Tk_ConfigureWidget. */
+{
+ TextItem *textPtr = (TextItem *) itemPtr;
+ XGCValues gcValues;
+ GC newGC, newSelGC;
+ unsigned long mask;
+ Tk_Window tkwin;
+ Tk_CanvasTextInfo *textInfoPtr = textPtr->textInfoPtr;
+ XColor *selBgColorPtr;
+ XColor *color;
+ Pixmap stipple;
+ Tk_State state;
+
+ tkwin = Tk_CanvasTkwin(canvas);
+ if (TCL_OK != Tk_ConfigureWidget(interp, tkwin, configSpecs, objc,
+ (const char **) objv, (char *) textPtr, flags|TK_CONFIG_OBJS)) {
+ return TCL_ERROR;
+ }
+
+ /*
+ * A few of the options require additional processing, such as graphics
+ * contexts.
+ */
+
+ state = itemPtr->state;
+
+ if (textPtr->activeColor != NULL || textPtr->activeStipple != None) {
+ itemPtr->redraw_flags |= TK_ITEM_STATE_DEPENDANT;
+ } else {
+ itemPtr->redraw_flags &= ~TK_ITEM_STATE_DEPENDANT;
+ }
+
+ if (state == TK_STATE_NULL) {
+ state = Canvas(canvas)->canvas_state;
+ }
+
+ color = textPtr->color;
+ stipple = textPtr->stipple;
+ if (Canvas(canvas)->currentItemPtr == itemPtr) {
+ if (textPtr->activeColor != NULL) {
+ color = textPtr->activeColor;
+ }
+ if (textPtr->activeStipple != None) {
+ stipple = textPtr->activeStipple;
+ }
+ } else if (state == TK_STATE_DISABLED) {
+ if (textPtr->disabledColor != NULL) {
+ color = textPtr->disabledColor;
+ }
+ if (textPtr->disabledStipple != None) {
+ stipple = textPtr->disabledStipple;
+ }
+ }
+
+ newGC = newSelGC = None;
+ if (textPtr->tkfont != NULL) {
+ gcValues.font = Tk_FontId(textPtr->tkfont);
+ mask = GCFont;
+ if (color != NULL) {
+ gcValues.foreground = color->pixel;
+ mask |= GCForeground;
+ if (stipple != None) {
+ gcValues.stipple = stipple;
+ gcValues.fill_style = FillStippled;
+ mask |= GCStipple|GCFillStyle;
+ }
+ newGC = Tk_GetGC(tkwin, mask, &gcValues);
+ }
+ mask &= ~(GCTile|GCFillStyle|GCStipple);
+ if (stipple != None) {
+ gcValues.stipple = stipple;
+ gcValues.fill_style = FillStippled;
+ mask |= GCStipple|GCFillStyle;
+ }
+ if (textInfoPtr->selFgColorPtr != NULL) {
+ gcValues.foreground = textInfoPtr->selFgColorPtr->pixel;
+ }
+ newSelGC = Tk_GetGC(tkwin, mask|GCForeground, &gcValues);
+ }
+ if (textPtr->gc != None) {
+ Tk_FreeGC(Tk_Display(tkwin), textPtr->gc);
+ }
+ textPtr->gc = newGC;
+ if (textPtr->selTextGC != None) {
+ Tk_FreeGC(Tk_Display(tkwin), textPtr->selTextGC);
+ }
+ textPtr->selTextGC = newSelGC;
+
+ selBgColorPtr = Tk_3DBorderColor(textInfoPtr->selBorder);
+ if (Tk_3DBorderColor(textInfoPtr->insertBorder)->pixel
+ == selBgColorPtr->pixel) {
+ if (selBgColorPtr->pixel == BlackPixelOfScreen(Tk_Screen(tkwin))) {
+ gcValues.foreground = WhitePixelOfScreen(Tk_Screen(tkwin));
+ } else {
+ gcValues.foreground = BlackPixelOfScreen(Tk_Screen(tkwin));
+ }
+ newGC = Tk_GetGC(tkwin, GCForeground, &gcValues);
+ } else {
+ newGC = None;
+ }
+ if (textPtr->cursorOffGC != None) {
+ Tk_FreeGC(Tk_Display(tkwin), textPtr->cursorOffGC);
+ }
+ textPtr->cursorOffGC = newGC;
+
+ /*
+ * If the text was changed, move the selection and insertion indices to
+ * keep them inside the item.
+ */
+
+ textPtr->numBytes = strlen(textPtr->text);
+ textPtr->numChars = Tcl_NumUtfChars(textPtr->text, textPtr->numBytes);
+ if (textInfoPtr->selItemPtr == itemPtr) {
+
+ if (textInfoPtr->selectFirst >= textPtr->numChars) {
+ textInfoPtr->selItemPtr = NULL;
+ } else {
+ if (textInfoPtr->selectLast >= textPtr->numChars) {
+ textInfoPtr->selectLast = textPtr->numChars - 1;
+ }
+ if ((textInfoPtr->anchorItemPtr == itemPtr)
+ && (textInfoPtr->selectAnchor >= textPtr->numChars)) {
+ textInfoPtr->selectAnchor = textPtr->numChars - 1;
+ }
+ }
+ }
+ if (textPtr->insertPos >= textPtr->numChars) {
+ textPtr->insertPos = textPtr->numChars;
+ }
+
+ /*
+ * Restrict so that 0.0 <= angle < 360.0, and then recompute the cached
+ * sine and cosine of the angle. Note that fmod() can produce negative
+ * results, and we try to avoid negative zero as well.
+ */
+
+ textPtr->angle = fmod(textPtr->angle, 360.0);
+ if (textPtr->angle < 0.0) {
+ textPtr->angle += 360.0;
+ }
+ if (textPtr->angle == 0.0) {
+ textPtr->angle = 0.0;
+ }
+ textPtr->sine = sin(textPtr->angle * PI/180.0);
+ textPtr->cosine = cos(textPtr->angle * PI/180.0);
+
+ ComputeTextBbox(canvas, textPtr);
+ return TCL_OK;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * DeleteText --
+ *
+ * This function is called to clean up the data structure associated with
+ * a text item.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Resources associated with itemPtr are released.
+ *
+ *--------------------------------------------------------------
+ */
+
+static void
+DeleteText(
+ Tk_Canvas canvas, /* Info about overall canvas widget. */
+ Tk_Item *itemPtr, /* Item that is being deleted. */
+ Display *display) /* Display containing window for canvas. */
+{
+ TextItem *textPtr = (TextItem *) itemPtr;
+
+ if (textPtr->color != NULL) {
+ Tk_FreeColor(textPtr->color);
+ }
+ if (textPtr->activeColor != NULL) {
+ Tk_FreeColor(textPtr->activeColor);
+ }
+ if (textPtr->disabledColor != NULL) {
+ Tk_FreeColor(textPtr->disabledColor);
+ }
+ Tk_FreeFont(textPtr->tkfont);
+ if (textPtr->stipple != None) {
+ Tk_FreeBitmap(display, textPtr->stipple);
+ }
+ if (textPtr->activeStipple != None) {
+ Tk_FreeBitmap(display, textPtr->activeStipple);
+ }
+ if (textPtr->disabledStipple != None) {
+ Tk_FreeBitmap(display, textPtr->disabledStipple);
+ }
+ if (textPtr->text != NULL) {
+ ckfree(textPtr->text);
+ }
+
+ Tk_FreeTextLayout(textPtr->textLayout);
+ if (textPtr->gc != None) {
+ Tk_FreeGC(display, textPtr->gc);
+ }
+ if (textPtr->selTextGC != None) {
+ Tk_FreeGC(display, textPtr->selTextGC);
+ }
+ if (textPtr->cursorOffGC != None) {
+ Tk_FreeGC(display, textPtr->cursorOffGC);
+ }
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * ComputeTextBbox --
+ *
+ * This function is invoked to compute the bounding box of all the pixels
+ * that may be drawn as part of a text item. In addition, it recomputes
+ * all of the geometry information used to display a text item or check
+ * for mouse hits.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The fields x1, y1, x2, and y2 are updated in the header for itemPtr,
+ * and the linePtr structure is regenerated for itemPtr.
+ *
+ *--------------------------------------------------------------
+ */
+
+static void
+ComputeTextBbox(
+ 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, i;
+ Tk_State state = textPtr->header.state;
+ double x[4], y[4], dx[4], dy[4], sinA, cosA, tmp;
+
+ if (state == TK_STATE_NULL) {
+ state = Canvas(canvas)->canvas_state;
+ }
+
+ Tk_FreeTextLayout(textPtr->textLayout);
+ textPtr->textLayout = Tk_ComputeTextLayout(textPtr->tkfont,
+ textPtr->text, textPtr->numChars, textPtr->width,
+ textPtr->justify, 0, &width, &height);
+
+ if (state == TK_STATE_HIDDEN || textPtr->color == NULL) {
+ width = height = 0;
+ }
+
+ /*
+ * Use overall geometry information to compute the top-left corner of the
+ * bounding box for the text item.
+ */
+
+ leftX = ROUND(textPtr->x);
+ topY = ROUND(textPtr->y);
+ for (i=0 ; i<4 ; i++) {
+ dx[i] = dy[i] = 0.0;
+ }
+ switch (textPtr->anchor) {
+ case TK_ANCHOR_NW:
+ case TK_ANCHOR_N:
+ case TK_ANCHOR_NE:
+ break;
+
+ case TK_ANCHOR_W:
+ case TK_ANCHOR_CENTER:
+ case TK_ANCHOR_E:
+ topY -= height / 2;
+ for (i=0 ; i<4 ; i++) {
+ dy[i] = -height / 2;
+ }
+ break;
+
+ case TK_ANCHOR_SW:
+ case TK_ANCHOR_S:
+ case TK_ANCHOR_SE:
+ topY -= height;
+ for (i=0 ; i<4 ; i++) {
+ dy[i] = -height;
+ }
+ break;
+ }
+ switch (textPtr->anchor) {
+ case TK_ANCHOR_NW:
+ case TK_ANCHOR_W:
+ case TK_ANCHOR_SW:
+ break;
+
+ case TK_ANCHOR_N:
+ case TK_ANCHOR_CENTER:
+ case TK_ANCHOR_S:
+ leftX -= width / 2;
+ for (i=0 ; i<4 ; i++) {
+ dx[i] = -width / 2;
+ }
+ break;
+
+ case TK_ANCHOR_NE:
+ case TK_ANCHOR_E:
+ case TK_ANCHOR_SE:
+ leftX -= width;
+ for (i=0 ; i<4 ; i++) {
+ dx[i] = -width;
+ }
+ break;
+ }
+
+ textPtr->actualWidth = width;
+
+ sinA = textPtr->sine;
+ cosA = textPtr->cosine;
+ textPtr->drawOrigin[0] = textPtr->x + dx[0]*cosA + dy[0]*sinA;
+ textPtr->drawOrigin[1] = textPtr->y + dy[0]*cosA - dx[0]*sinA;
+
+ /*
+ * Last of all, update the bounding box for the item. The item's bounding
+ * box includes the bounding box of all its lines, plus an extra fudge
+ * factor for the cursor border (which could potentially be quite large).
+ */
+
+ textInfoPtr = textPtr->textInfoPtr;
+ fudge = (textInfoPtr->insertWidth + 1) / 2;
+ if (textInfoPtr->selBorderWidth > fudge) {
+ fudge = textInfoPtr->selBorderWidth;
+ }
+
+ /*
+ * Apply the rotation before computing the bounding box.
+ */
+
+ dx[0] -= fudge;
+ dx[1] += width + fudge;
+ dx[2] += width + fudge;
+ dy[2] += height;
+ dx[3] -= fudge;
+ dy[3] += height;
+ for (i=0 ; i<4 ; i++) {
+ x[i] = textPtr->x + dx[i] * cosA + dy[i] * sinA;
+ y[i] = textPtr->y + dy[i] * cosA - dx[i] * sinA;
+ }
+
+ /*
+ * Convert to a rectilinear bounding box.
+ */
+
+ for (i=1,tmp=x[0] ; i<4 ; i++) {
+ if (x[i] < tmp) {
+ tmp = x[i];
+ }
+ }
+ textPtr->header.x1 = ROUND(tmp);
+ for (i=1,tmp=y[0] ; i<4 ; i++) {
+ if (y[i] < tmp) {
+ tmp = y[i];
+ }
+ }
+ textPtr->header.y1 = ROUND(tmp);
+ for (i=1,tmp=x[0] ; i<4 ; i++) {
+ if (x[i] > tmp) {
+ tmp = x[i];
+ }
+ }
+ textPtr->header.x2 = ROUND(tmp);
+ for (i=1,tmp=y[0] ; i<4 ; i++) {
+ if (y[i] > tmp) {
+ tmp = y[i];
+ }
+ }
+ textPtr->header.y2 = ROUND(tmp);
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * DisplayCanvText --
+ *
+ * This function is invoked to draw a text item in a given drawable.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * ItemPtr is drawn in drawable using the transformation information in
+ * canvas.
+ *
+ *--------------------------------------------------------------
+ */
+
+static void
+DisplayCanvText(
+ 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, int y, int width, int height)
+ /* Describes region of canvas that must be
+ * redisplayed (not used). */
+{
+ TextItem *textPtr;
+ Tk_CanvasTextInfo *textInfoPtr;
+ int selFirstChar, selLastChar;
+ short drawableX, drawableY;
+ Pixmap stipple;
+ Tk_State state = itemPtr->state;
+
+ textPtr = (TextItem *) itemPtr;
+ textInfoPtr = textPtr->textInfoPtr;
+
+ if (state == TK_STATE_NULL) {
+ state = Canvas(canvas)->canvas_state;
+ }
+ stipple = textPtr->stipple;
+ if (Canvas(canvas)->currentItemPtr == itemPtr) {
+ if (textPtr->activeStipple != None) {
+ stipple = textPtr->activeStipple;
+ }
+ } else if (state == TK_STATE_DISABLED) {
+ if (textPtr->disabledStipple != None) {
+ stipple = textPtr->disabledStipple;
+ }
+ }
+
+ if (textPtr->gc == None) {
+ return;
+ }
+
+ /*
+ * If we're stippling, then modify the stipple offset in the GC. Be sure
+ * to reset the offset when done, since the GC is supposed to be
+ * read-only.
+ */
+
+ if (stipple != None) {
+ Tk_CanvasSetOffset(canvas, textPtr->gc, &textPtr->tsoffset);
+ }
+
+ selFirstChar = -1;
+ selLastChar = 0; /* lint. */
+ Tk_CanvasDrawableCoords(canvas, textPtr->drawOrigin[0],
+ textPtr->drawOrigin[1], &drawableX, &drawableY);
+
+ if (textInfoPtr->selItemPtr == itemPtr) {
+ selFirstChar = textInfoPtr->selectFirst;
+ selLastChar = textInfoPtr->selectLast;
+ if (selLastChar > textPtr->numChars) {
+ selLastChar = textPtr->numChars - 1;
+ }
+ if ((selFirstChar >= 0) && (selFirstChar <= selLastChar)) {
+ int xFirst, yFirst, hFirst;
+ int xLast, yLast, wLast;
+
+ /*
+ * Draw a special background under the selection.
+ */
+
+ Tk_CharBbox(textPtr->textLayout, selFirstChar, &xFirst, &yFirst,
+ NULL, &hFirst);
+ Tk_CharBbox(textPtr->textLayout, selLastChar, &xLast, &yLast,
+ &wLast, NULL);
+
+ /*
+ * If the selection spans the end of this line, then display
+ * selection background all the way to the end of the line.
+ * However, for the last line we only want to display up to the
+ * last character, not the end of the line.
+ */
+
+ x = xFirst;
+ height = hFirst;
+ for (y = yFirst ; y <= yLast; y += height) {
+ int dx1, dy1, dx2, dy2;
+ double s = textPtr->sine, c = textPtr->cosine;
+ XPoint points[4];
+
+ if (y == yLast) {
+ width = xLast + wLast - x;
+ } else {
+ width = textPtr->actualWidth - x;
+ }
+ dx1 = x - textInfoPtr->selBorderWidth;
+ dy1 = y;
+ dx2 = width + 2 * textInfoPtr->selBorderWidth;
+ dy2 = height;
+ points[0].x = (short)(drawableX + dx1*c + dy1*s);
+ points[0].y = (short)(drawableY + dy1*c - dx1*s);
+ points[1].x = (short)(drawableX + (dx1+dx2)*c + dy1*s);
+ points[1].y = (short)(drawableY + dy1*c - (dx1+dx2)*s);
+ points[2].x = (short)(drawableX + (dx1+dx2)*c + (dy1+dy2)*s);
+ points[2].y = (short)(drawableY + (dy1+dy2)*c - (dx1+dx2)*s);
+ points[3].x = (short)(drawableX + dx1*c + (dy1+dy2)*s);
+ points[3].y = (short)(drawableY + (dy1+dy2)*c - dx1*s);
+ Tk_Fill3DPolygon(Tk_CanvasTkwin(canvas), drawable,
+ textInfoPtr->selBorder, points, 4,
+ textInfoPtr->selBorderWidth, TK_RELIEF_RAISED);
+ x = 0;
+ }
+ }
+ }
+
+ /*
+ * If the insertion point should be displayed, then draw a special
+ * background for the cursor before drawing the text. Note: if we're the
+ * cursor item but the cursor is turned off, then redraw background over
+ * the area of the cursor. This guarantees that the selection won't make
+ * the cursor invisible on mono displays, where both are drawn in the same
+ * color.
+ */
+
+ if ((textInfoPtr->focusItemPtr == itemPtr) && (textInfoPtr->gotFocus)) {
+ if (Tk_CharBbox(textPtr->textLayout, textPtr->insertPos,
+ &x, &y, NULL, &height)) {
+ int dx1, dy1, dx2, dy2;
+ double s = textPtr->sine, c = textPtr->cosine;
+ XPoint points[4];
+
+ dx1 = x - (textInfoPtr->insertWidth / 2);
+ dy1 = y;
+ dx2 = textInfoPtr->insertWidth;
+ dy2 = height;
+ points[0].x = (short)(drawableX + dx1*c + dy1*s);
+ points[0].y = (short)(drawableY + dy1*c - dx1*s);
+ points[1].x = (short)(drawableX + (dx1+dx2)*c + dy1*s);
+ points[1].y = (short)(drawableY + dy1*c - (dx1+dx2)*s);
+ points[2].x = (short)(drawableX + (dx1+dx2)*c + (dy1+dy2)*s);
+ points[2].y = (short)(drawableY + (dy1+dy2)*c - (dx1+dx2)*s);
+ points[3].x = (short)(drawableX + dx1*c + (dy1+dy2)*s);
+ points[3].y = (short)(drawableY + (dy1+dy2)*c - dx1*s);
+
+ Tk_SetCaretPos(Tk_CanvasTkwin(canvas), points[0].x, points[0].y,
+ height);
+ if (textInfoPtr->cursorOn) {
+ Tk_Fill3DPolygon(Tk_CanvasTkwin(canvas), drawable,
+ textInfoPtr->insertBorder, points, 4,
+ textInfoPtr->insertBorderWidth, TK_RELIEF_RAISED);
+ } else if (textPtr->cursorOffGC != None) {
+ /*
+ * Redraw the background over the area of the cursor, even
+ * though the cursor is turned off. This guarantees that the
+ * selection won't make the cursor invisible on mono displays,
+ * where both may be drawn in the same color.
+ */
+
+ XFillPolygon(display, drawable, textPtr->cursorOffGC,
+ points, 4, Convex, CoordModeOrigin);
+ }
+ }
+ }
+
+ /*
+ * If there is no selected text or the selected text foreground is the
+ * same as the regular text foreground, then draw one text string. If
+ * there is selected text and the foregrounds differ, draw the regular
+ * text up to the selection, draw the selection, then draw the rest of the
+ * regular text. Drawing the regular text and then the selected text over
+ * it would causes problems with anti-aliased text because the two
+ * anti-aliasing colors would blend together.
+ */
+
+ if ((selFirstChar >= 0) && (textPtr->selTextGC != textPtr->gc)) {
+ TkDrawAngledTextLayout(display, drawable, textPtr->gc,
+ textPtr->textLayout, drawableX, drawableY, textPtr->angle,
+ 0, selFirstChar);
+ TkDrawAngledTextLayout(display, drawable, textPtr->selTextGC,
+ textPtr->textLayout, drawableX, drawableY, textPtr->angle,
+ selFirstChar, selLastChar + 1);
+ TkDrawAngledTextLayout(display, drawable, textPtr->gc,
+ textPtr->textLayout, drawableX, drawableY, textPtr->angle,
+ selLastChar + 1, -1);
+ } else {
+ TkDrawAngledTextLayout(display, drawable, textPtr->gc,
+ textPtr->textLayout, drawableX, drawableY, textPtr->angle,
+ 0, -1);
+ }
+ TkUnderlineAngledTextLayout(display, drawable, textPtr->gc,
+ textPtr->textLayout, drawableX, drawableY, textPtr->angle,
+ textPtr->underline);
+
+ if (stipple != None) {
+ XSetTSOrigin(display, textPtr->gc, 0, 0);
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TextInsert --
+ *
+ * Insert characters into a text item at a given position.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The text in the given item is modified. The cursor and selection
+ * positions are also modified to reflect the insertion.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+TextInsert(
+ Tk_Canvas canvas, /* Canvas containing text item. */
+ Tk_Item *itemPtr, /* Text item to be modified. */
+ int index, /* Character index before which string is to
+ * be inserted. */
+ Tcl_Obj *obj) /* New characters to be inserted. */
+{
+ TextItem *textPtr = (TextItem *) itemPtr;
+ int byteIndex, byteCount, charsAdded;
+ char *newStr, *text;
+ const char *string;
+ Tk_CanvasTextInfo *textInfoPtr = textPtr->textInfoPtr;
+
+ string = Tcl_GetStringFromObj(obj, &byteCount);
+
+ text = textPtr->text;
+
+ if (index < 0) {
+ index = 0;
+ }
+ if (index > textPtr->numChars) {
+ index = textPtr->numChars;
+ }
+ byteIndex = Tcl_UtfAtIndex(text, index) - text;
+ byteCount = strlen(string);
+ if (byteCount == 0) {
+ return;
+ }
+
+ newStr = ckalloc(textPtr->numBytes + byteCount + 1);
+ memcpy(newStr, text, (size_t) byteIndex);
+ strcpy(newStr + byteIndex, string);
+ strcpy(newStr + byteIndex + byteCount, text + byteIndex);
+
+ ckfree(text);
+ textPtr->text = newStr;
+ charsAdded = Tcl_NumUtfChars(string, byteCount);
+ textPtr->numChars += charsAdded;
+ textPtr->numBytes += byteCount;
+
+ /*
+ * Inserting characters invalidates indices such as those for the
+ * selection and cursor. Update the indices appropriately.
+ */
+
+ if (textInfoPtr->selItemPtr == itemPtr) {
+ if (textInfoPtr->selectFirst >= index) {
+ textInfoPtr->selectFirst += charsAdded;
+ }
+ if (textInfoPtr->selectLast >= index) {
+ textInfoPtr->selectLast += charsAdded;
+ }
+ if ((textInfoPtr->anchorItemPtr == itemPtr)
+ && (textInfoPtr->selectAnchor >= index)) {
+ textInfoPtr->selectAnchor += charsAdded;
+ }
+ }
+ if (textPtr->insertPos >= index) {
+ textPtr->insertPos += charsAdded;
+ }
+ ComputeTextBbox(canvas, textPtr);
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * TextDeleteChars --
+ *
+ * Delete one or more characters from a text item.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Characters between "first" and "last", inclusive, get deleted from
+ * itemPtr, and things like the selection position get updated.
+ *
+ *--------------------------------------------------------------
+ */
+
+static void
+TextDeleteChars(
+ Tk_Canvas canvas, /* Canvas containing itemPtr. */
+ Tk_Item *itemPtr, /* Item in which to delete characters. */
+ int first, /* Character index of first character to
+ * delete. */
+ int last) /* Character index of last character to delete
+ * (inclusive). */
+{
+ TextItem *textPtr = (TextItem *) itemPtr;
+ int byteIndex, byteCount, charsRemoved;
+ char *newStr, *text;
+ Tk_CanvasTextInfo *textInfoPtr = textPtr->textInfoPtr;
+
+ text = textPtr->text;
+ if (first < 0) {
+ first = 0;
+ }
+ if (last >= textPtr->numChars) {
+ last = textPtr->numChars - 1;
+ }
+ if (first > last) {
+ return;
+ }
+ charsRemoved = last + 1 - first;
+
+ byteIndex = Tcl_UtfAtIndex(text, first) - text;
+ byteCount = Tcl_UtfAtIndex(text + byteIndex, charsRemoved)
+ - (text + byteIndex);
+
+ newStr = ckalloc(textPtr->numBytes + 1 - byteCount);
+ memcpy(newStr, text, (size_t) byteIndex);
+ strcpy(newStr + byteIndex, text + byteIndex + byteCount);
+
+ ckfree(text);
+ textPtr->text = newStr;
+ textPtr->numChars -= charsRemoved;
+ textPtr->numBytes -= byteCount;
+
+ /*
+ * Update indexes for the selection and cursor to reflect the renumbering
+ * of the remaining characters.
+ */
+
+ if (textInfoPtr->selItemPtr == itemPtr) {
+ if (textInfoPtr->selectFirst > first) {
+ textInfoPtr->selectFirst -= charsRemoved;
+ if (textInfoPtr->selectFirst < first) {
+ textInfoPtr->selectFirst = first;
+ }
+ }
+ if (textInfoPtr->selectLast >= first) {
+ textInfoPtr->selectLast -= charsRemoved;
+ if (textInfoPtr->selectLast < first - 1) {
+ textInfoPtr->selectLast = first - 1;
+ }
+ }
+ if (textInfoPtr->selectFirst > textInfoPtr->selectLast) {
+ textInfoPtr->selItemPtr = NULL;
+ }
+ if ((textInfoPtr->anchorItemPtr == itemPtr)
+ && (textInfoPtr->selectAnchor > first)) {
+ textInfoPtr->selectAnchor -= charsRemoved;
+ if (textInfoPtr->selectAnchor < first) {
+ textInfoPtr->selectAnchor = first;
+ }
+ }
+ }
+ if (textPtr->insertPos > first) {
+ textPtr->insertPos -= charsRemoved;
+ if (textPtr->insertPos < first) {
+ textPtr->insertPos = first;
+ }
+ }
+ ComputeTextBbox(canvas, textPtr);
+ return;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * TextToPoint --
+ *
+ * Computes the distance from a given point to a given text item, in
+ * canvas units.
+ *
+ * Results:
+ * The return value is 0 if the point whose x and y coordinates are
+ * pointPtr[0] and pointPtr[1] is inside the text item. If the point
+ * isn't inside the text item then the return value is the distance from
+ * the point to the text item.
+ *
+ * Side effects:
+ * None.
+ *
+ *--------------------------------------------------------------
+ */
+
+static double
+TextToPoint(
+ Tk_Canvas canvas, /* Canvas containing itemPtr. */
+ Tk_Item *itemPtr, /* Item to check against point. */
+ double *pointPtr) /* Pointer to x and y coordinates. */
+{
+ TextItem *textPtr;
+ Tk_State state = itemPtr->state;
+ double value, px, py;
+
+ if (state == TK_STATE_NULL) {
+ state = Canvas(canvas)->canvas_state;
+ }
+ textPtr = (TextItem *) itemPtr;
+ px = pointPtr[0] - textPtr->drawOrigin[0];
+ py = pointPtr[1] - textPtr->drawOrigin[1];
+ value = (double) Tk_DistanceToTextLayout(textPtr->textLayout,
+ (int) (px*textPtr->cosine - py*textPtr->sine),
+ (int) (py*textPtr->cosine + px*textPtr->sine));
+
+ if ((state == TK_STATE_HIDDEN) || (textPtr->color == NULL) ||
+ (textPtr->text == NULL) || (*textPtr->text == 0)) {
+ value = 1.0e36;
+ }
+ return value;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * TextToArea --
+ *
+ * This function is called to determine whether an item lies entirely
+ * inside, entirely outside, or overlapping a given rectangle.
+ *
+ * Results:
+ * -1 is returned if the item is entirely outside the area given by
+ * rectPtr, 0 if it overlaps, and 1 if it is entirely inside the given
+ * area.
+ *
+ * Side effects:
+ * None.
+ *
+ *--------------------------------------------------------------
+ */
+
+static int
+TextToArea(
+ Tk_Canvas canvas, /* Canvas containing itemPtr. */
+ Tk_Item *itemPtr, /* Item to check against rectangle. */
+ double *rectPtr) /* Pointer to array of four coordinates
+ * (x1,y1,x2,y2) describing rectangular
+ * area. */
+{
+ TextItem *textPtr;
+ Tk_State state = itemPtr->state;
+
+ if (state == TK_STATE_NULL) {
+ state = Canvas(canvas)->canvas_state;
+ }
+
+ textPtr = (TextItem *) itemPtr;
+ return TkIntersectAngledTextLayout(textPtr->textLayout,
+ (int) ((rectPtr[0] + 0.5) - textPtr->drawOrigin[0]),
+ (int) ((rectPtr[1] + 0.5) - textPtr->drawOrigin[1]),
+ (int) (rectPtr[2] - rectPtr[0] + 0.5),
+ (int) (rectPtr[3] - rectPtr[1] + 0.5),
+ textPtr->angle);
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * ScaleText --
+ *
+ * This function is invoked to rescale a text item.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Scales the position of the text, but not the size of the font for the
+ * text.
+ *
+ *--------------------------------------------------------------
+ */
+
+ /* ARGSUSED */
+static void
+ScaleText(
+ Tk_Canvas canvas, /* Canvas containing rectangle. */
+ Tk_Item *itemPtr, /* Rectangle to be scaled. */
+ double originX, double originY,
+ /* Origin about which to scale rect. */
+ double scaleX, /* Amount to scale in X direction. */
+ double scaleY) /* Amount to scale in Y direction. */
+{
+ TextItem *textPtr = (TextItem *) itemPtr;
+
+ textPtr->x = originX + scaleX*(textPtr->x - originX);
+ textPtr->y = originY + scaleY*(textPtr->y - originY);
+ ComputeTextBbox(canvas, textPtr);
+ return;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * TranslateText --
+ *
+ * This function is called to move a text item by a given amount.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The position of the text item is offset by (xDelta, yDelta), and the
+ * bounding box is updated in the generic part of the item structure.
+ *
+ *--------------------------------------------------------------
+ */
+
+static void
+TranslateText(
+ Tk_Canvas canvas, /* Canvas containing item. */
+ Tk_Item *itemPtr, /* Item that is being moved. */
+ double deltaX, double deltaY)
+ /* Amount by which item is to be moved. */
+{
+ TextItem *textPtr = (TextItem *) itemPtr;
+
+ textPtr->x += deltaX;
+ textPtr->y += deltaY;
+ ComputeTextBbox(canvas, textPtr);
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * GetTextIndex --
+ *
+ * Parse an index into a text item and return either its value or an
+ * error.
+ *
+ * Results:
+ * A standard Tcl result. If all went well, then *indexPtr is filled in
+ * with the index (into itemPtr) corresponding to string. Otherwise an
+ * error message is left in the interp's result.
+ *
+ * Side effects:
+ * None.
+ *
+ *--------------------------------------------------------------
+ */
+
+static int
+GetTextIndex(
+ Tcl_Interp *interp, /* Used for error reporting. */
+ Tk_Canvas canvas, /* Canvas containing item. */
+ Tk_Item *itemPtr, /* Item for which the index is being
+ * specified. */
+ Tcl_Obj *obj, /* Specification of a particular character in
+ * itemPtr's text. */
+ int *indexPtr) /* Where to store converted character
+ * index. */
+{
+ TextItem *textPtr = (TextItem *) itemPtr;
+ int length;
+ int c;
+ TkCanvas *canvasPtr = (TkCanvas *) canvas;
+ Tk_CanvasTextInfo *textInfoPtr = textPtr->textInfoPtr;
+ const char *string = Tcl_GetStringFromObj(obj, &length);
+
+ c = string[0];
+
+ if ((c == 'e') && (strncmp(string, "end", (unsigned) length) == 0)) {
+ *indexPtr = textPtr->numChars;
+ } else if ((c == 'i')
+ && (strncmp(string, "insert", (unsigned) length) == 0)) {
+ *indexPtr = textPtr->insertPos;
+ } else if ((c == 's') && (length >= 5)
+ && (strncmp(string, "sel.first", (unsigned) length) == 0)) {
+ if (textInfoPtr->selItemPtr != itemPtr) {
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "selection isn't in item", -1));
+ Tcl_SetErrorCode(interp, "TK", "CANVAS", "UNSELECTED", NULL);
+ return TCL_ERROR;
+ }
+ *indexPtr = textInfoPtr->selectFirst;
+ } else if ((c == 's') && (length >= 5)
+ && (strncmp(string, "sel.last", (unsigned) length) == 0)) {
+ if (textInfoPtr->selItemPtr != itemPtr) {
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "selection isn't in item", -1));
+ Tcl_SetErrorCode(interp, "TK", "CANVAS", "UNSELECTED", NULL);
+ return TCL_ERROR;
+ }
+ *indexPtr = textInfoPtr->selectLast;
+ } else if (c == '@') {
+ int x, y;
+ double tmp, c = textPtr->cosine, s = textPtr->sine;
+ char *end;
+ const char *p;
+
+ p = string+1;
+ tmp = strtod(p, &end);
+ if ((end == p) || (*end != ',')) {
+ goto badIndex;
+ }
+ x = (int) ((tmp < 0) ? tmp - 0.5 : tmp + 0.5);
+ p = end+1;
+ tmp = strtod(p, &end);
+ if ((end == p) || (*end != 0)) {
+ goto badIndex;
+ }
+ y = (int) ((tmp < 0) ? tmp - 0.5 : tmp + 0.5);
+ x += canvasPtr->scrollX1 - (int) textPtr->drawOrigin[0];
+ y += canvasPtr->scrollY1 - (int) textPtr->drawOrigin[1];
+ *indexPtr = Tk_PointToChar(textPtr->textLayout,
+ (int) (x*c - y*s), (int) (y*c + x*s));
+ } else if (Tcl_GetIntFromObj(NULL, obj, indexPtr) == TCL_OK) {
+ if (*indexPtr < 0) {
+ *indexPtr = 0;
+ } else if (*indexPtr > textPtr->numChars) {
+ *indexPtr = textPtr->numChars;
+ }
+ } else {
+ /*
+ * Some of the paths here leave messages in the interp's result, so we
+ * have to clear it out before storing our own message.
+ */
+
+ badIndex:
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf("bad index \"%s\"", string));
+ Tcl_SetErrorCode(interp, "TK", "CANVAS", "ITEM_INDEX", "TEXT", NULL);
+ return TCL_ERROR;
+ }
+ return TCL_OK;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * SetTextCursor --
+ *
+ * Set the position of the insertion cursor in this item.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The cursor position will change.
+ *
+ *--------------------------------------------------------------
+ */
+
+ /* ARGSUSED */
+static void
+SetTextCursor(
+ Tk_Canvas canvas, /* Record describing canvas widget. */
+ Tk_Item *itemPtr, /* Text item in which cursor position is to be
+ * set. */
+ int index) /* Character index of character just before
+ * which cursor is to be positioned. */
+{
+ TextItem *textPtr = (TextItem *) itemPtr;
+
+ if (index < 0) {
+ textPtr->insertPos = 0;
+ } else if (index > textPtr->numChars) {
+ textPtr->insertPos = textPtr->numChars;
+ } else {
+ textPtr->insertPos = index;
+ }
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * GetSelText --
+ *
+ * This function is invoked to return the selected portion of a text
+ * item. It is only called when this item has the selection.
+ *
+ * Results:
+ * The return value is the number of non-NULL bytes stored at buffer.
+ * Buffer is filled (or partially filled) with a NULL-terminated string
+ * containing part or all of the selection, as given by offset and
+ * maxBytes.
+ *
+ * Side effects:
+ * None.
+ *
+ *--------------------------------------------------------------
+ */
+
+static int
+GetSelText(
+ Tk_Canvas canvas, /* Canvas containing selection. */
+ Tk_Item *itemPtr, /* Text item containing selection. */
+ int offset, /* Byte offset within selection of first
+ * character to be returned. */
+ char *buffer, /* Location in which to place selection. */
+ int maxBytes) /* Maximum number of bytes to place at buffer,
+ * not including terminating NULL
+ * character. */
+{
+ TextItem *textPtr = (TextItem *) itemPtr;
+ int byteCount;
+ char *text;
+ const char *selStart, *selEnd;
+ Tk_CanvasTextInfo *textInfoPtr = textPtr->textInfoPtr;
+
+ if ((textInfoPtr->selectFirst < 0) ||
+ (textInfoPtr->selectFirst > textInfoPtr->selectLast)) {
+ return 0;
+ }
+ text = textPtr->text;
+ selStart = Tcl_UtfAtIndex(text, textInfoPtr->selectFirst);
+ selEnd = Tcl_UtfAtIndex(selStart,
+ textInfoPtr->selectLast + 1 - textInfoPtr->selectFirst);
+ byteCount = selEnd - selStart - offset;
+ if (byteCount > maxBytes) {
+ byteCount = maxBytes;
+ }
+ if (byteCount <= 0) {
+ return 0;
+ }
+ memcpy(buffer, selStart + offset, (size_t) byteCount);
+ buffer[byteCount] = '\0';
+ return byteCount;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * TextToPostscript --
+ *
+ * This function is called to generate Postscript for text items.
+ *
+ * Results:
+ * The return value is a standard Tcl result. If an error occurs in
+ * generating Postscript then an error message is left in the interp's
+ * result, replacing whatever used to be there. If no error occurs, then
+ * Postscript for the item is appended to the result.
+ *
+ * Side effects:
+ * None.
+ *
+ *--------------------------------------------------------------
+ */
+
+static int
+TextToPostscript(
+ 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;
+ double x, y;
+ Tk_FontMetrics fm;
+ const char *justify;
+ XColor *color;
+ Pixmap stipple;
+ Tk_State state = itemPtr->state;
+ Tcl_Obj *psObj;
+ Tcl_InterpState interpState;
+
+ if (state == TK_STATE_NULL) {
+ state = Canvas(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 (Canvas(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;
+ }
+ }
+
+ /*
+ * Make our working space.
+ */
+
+ psObj = Tcl_NewObj();
+ interpState = Tcl_SaveInterpState(interp, TCL_OK);
+
+ /*
+ * Generate postscript.
+ */
+
+ Tcl_ResetResult(interp);
+ if (Tk_CanvasPsFont(interp, canvas, textPtr->tkfont) != TCL_OK) {
+ goto error;
+ }
+ Tcl_AppendObjToObj(psObj, Tcl_GetObjResult(interp));
+
+ if (prepass != 0) {
+ goto done;
+ }
+
+ Tcl_ResetResult(interp);
+ if (Tk_CanvasPsColor(interp, canvas, color) != TCL_OK) {
+ goto error;
+ }
+ Tcl_AppendObjToObj(psObj, Tcl_GetObjResult(interp));
+
+ if (stipple != None) {
+ Tcl_ResetResult(interp);
+ Tk_CanvasPsStipple(interp, canvas, stipple);
+ Tcl_AppendPrintfToObj(psObj, "/StippleText {\n %s} bind def\n",
+ Tcl_GetString(Tcl_GetObjResult(interp)));
+ }
+
+ x = 0; y = 0; justify = NULL; /* lint. */
+ switch (textPtr->anchor) {
+ case TK_ANCHOR_NW: x = 0; y = 0; break;
+ case TK_ANCHOR_N: x = 1; y = 0; break;
+ case TK_ANCHOR_NE: x = 2; y = 0; break;
+ case TK_ANCHOR_E: x = 2; y = 1; break;
+ case TK_ANCHOR_SE: x = 2; y = 2; break;
+ case TK_ANCHOR_S: x = 1; y = 2; break;
+ case TK_ANCHOR_SW: x = 0; y = 2; break;
+ case TK_ANCHOR_W: x = 0; y = 1; break;
+ case TK_ANCHOR_CENTER: x = 1; y = 1; break;
+ }
+ switch (textPtr->justify) {
+ case TK_JUSTIFY_LEFT: justify = "0"; break;
+ case TK_JUSTIFY_CENTER: justify = "0.5"; break;
+ case TK_JUSTIFY_RIGHT: justify = "1"; break;
+ }
+
+ Tk_GetFontMetrics(textPtr->tkfont, &fm);
+
+ Tcl_AppendPrintfToObj(psObj, "%.15g %.15g %.15g [\n",
+ textPtr->angle, textPtr->x, Tk_CanvasPsY(canvas, textPtr->y));
+ Tcl_ResetResult(interp);
+ Tk_TextLayoutToPostscript(interp, textPtr->textLayout);
+ Tcl_AppendObjToObj(psObj, Tcl_GetObjResult(interp));
+ Tcl_AppendPrintfToObj(psObj,
+ "] %d %g %g %s %s DrawText\n",
+ fm.linespace, x / -2.0, y / 2.0, justify,
+ ((stipple == None) ? "false" : "true"));
+
+ /*
+ * Plug the accumulated postscript back into the result.
+ */
+
+ done:
+ (void) Tcl_RestoreInterpState(interp, interpState);
+ Tcl_AppendObjToObj(Tcl_GetObjResult(interp), psObj);
+ Tcl_DecrRefCount(psObj);
+ return TCL_OK;
+
+ error:
+ Tcl_DiscardInterpState(interpState);
+ Tcl_DecrRefCount(psObj);
+ return TCL_ERROR;
+}
+
+/*
+ * Local Variables:
+ * mode: c
+ * c-basic-offset: 4
+ * fill-column: 78
+ * End:
+ */
diff --git a/tk8.6/generic/tkCanvUtil.c b/tk8.6/generic/tkCanvUtil.c
new file mode 100644
index 0000000..cbbc2b4
--- /dev/null
+++ b/tk8.6/generic/tkCanvUtil.c
@@ -0,0 +1,1869 @@
+/*
+ * tkCanvUtil.c --
+ *
+ * This file contains a collection of utility functions used by the
+ * implementations of various canvas item types.
+ *
+ * Copyright (c) 1994 Sun Microsystems, Inc.
+ *
+ * See the file "license.terms" for information on usage and redistribution of
+ * this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ */
+
+#include "tkInt.h"
+#include "tkCanvas.h"
+#include <assert.h>
+
+/*
+ * Structures defined only in this file.
+ */
+
+typedef struct SmoothAssocData {
+ struct SmoothAssocData *nextPtr;
+ /* Pointer to next SmoothAssocData. */
+ Tk_SmoothMethod smooth; /* Name and functions associated with this
+ * option. */
+} SmoothAssocData;
+
+const Tk_SmoothMethod tkBezierSmoothMethod = {
+ "true",
+ TkMakeBezierCurve,
+ (void (*) (Tcl_Interp *interp, Tk_Canvas canvas, double *coordPtr,
+ int numPoints, int numSteps)) TkMakeBezierPostscript,
+};
+static const Tk_SmoothMethod tkRawSmoothMethod = {
+ "raw",
+ TkMakeRawCurve,
+ (void (*) (Tcl_Interp *interp, Tk_Canvas canvas, double *coordPtr,
+ int numPoints, int numSteps)) TkMakeRawCurvePostscript,
+};
+
+/*
+ * Function forward-declarations.
+ */
+
+static void SmoothMethodCleanupProc(ClientData clientData,
+ Tcl_Interp *interp);
+static SmoothAssocData *InitSmoothMethods(Tcl_Interp *interp);
+static int DashConvert(char *l, const char *p, int n,
+ double width);
+static void TranslateAndAppendCoords(TkCanvas *canvPtr,
+ double x, double y, XPoint *outArr, int numOut);
+static inline Tcl_Obj * GetPostscriptBuffer(Tcl_Interp *interp);
+
+#define ABS(a) ((a>=0)?(a):(-(a)))
+
+static inline Tcl_Obj *
+GetPostscriptBuffer(
+ Tcl_Interp *interp)
+{
+ Tcl_Obj *psObj = Tcl_GetObjResult(interp);
+
+ if (Tcl_IsShared(psObj)) {
+ psObj = Tcl_DuplicateObj(psObj);
+ Tcl_SetObjResult(interp, psObj);
+ }
+ return psObj;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_CanvasTkwin --
+ *
+ * Given a token for a canvas, this function returns the widget that
+ * represents the canvas.
+ *
+ * Results:
+ * The return value is a handle for the widget.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+Tk_Window
+Tk_CanvasTkwin(
+ Tk_Canvas canvas) /* Token for the canvas. */
+{
+ return Canvas(canvas)->tkwin;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_CanvasDrawableCoords --
+ *
+ * Given an (x,y) coordinate pair within a canvas, this function
+ * returns the corresponding coordinates at which the point should
+ * be drawn in the drawable used for display.
+ *
+ * Results:
+ * There is no return value. The values at *drawableXPtr and
+ * *drawableYPtr are filled in with the coordinates at which x and y
+ * should be drawn. These coordinates are clipped to fit within a
+ * "short", since this is what X uses in most cases for drawing.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tk_CanvasDrawableCoords(
+ Tk_Canvas canvas, /* Token for the canvas. */
+ double x, /* Coordinates in canvas space. */
+ double y,
+ short *drawableXPtr, /* Screen coordinates are stored here. */
+ short *drawableYPtr)
+{
+ double tmp;
+
+ tmp = x - Canvas(canvas)->drawableXOrigin;
+ if (tmp > 0) {
+ tmp += 0.5;
+ } else {
+ tmp -= 0.5;
+ }
+ if (tmp > 32767) {
+ *drawableXPtr = 32767;
+ } else if (tmp < -32768) {
+ *drawableXPtr = -32768;
+ } else {
+ *drawableXPtr = (short) tmp;
+ }
+
+ tmp = y - Canvas(canvas)->drawableYOrigin;
+ if (tmp > 0) {
+ tmp += 0.5;
+ } else {
+ tmp -= 0.5;
+ }
+ if (tmp > 32767) {
+ *drawableYPtr = 32767;
+ } else if (tmp < -32768) {
+ *drawableYPtr = -32768;
+ } else {
+ *drawableYPtr = (short) tmp;
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_CanvasWindowCoords --
+ *
+ * Given an (x,y) coordinate pair within a canvas, this function returns
+ * the corresponding coordinates in the canvas's window.
+ *
+ * Results:
+ * There is no return value. The values at *screenXPtr and *screenYPtr
+ * are filled in with the coordinates at which (x,y) appears in the
+ * canvas's window. These coordinates are clipped to fit within a
+ * "short", since this is what X uses in most cases for drawing.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tk_CanvasWindowCoords(
+ Tk_Canvas canvas, /* Token for the canvas. */
+ double x, /* Coordinates in canvas space. */
+ double y,
+ short *screenXPtr, /* Screen coordinates are stored here. */
+ short *screenYPtr)
+{
+ double tmp;
+
+ tmp = x - Canvas(canvas)->xOrigin;
+ if (tmp > 0) {
+ tmp += 0.5;
+ } else {
+ tmp -= 0.5;
+ }
+ if (tmp > 32767) {
+ *screenXPtr = 32767;
+ } else if (tmp < -32768) {
+ *screenXPtr = -32768;
+ } else {
+ *screenXPtr = (short) tmp;
+ }
+
+ tmp = y - Canvas(canvas)->yOrigin;
+ if (tmp > 0) {
+ tmp += 0.5;
+ } else {
+ tmp -= 0.5;
+ }
+ if (tmp > 32767) {
+ *screenYPtr = 32767;
+ } else if (tmp < -32768) {
+ *screenYPtr = -32768;
+ } else {
+ *screenYPtr = (short) tmp;
+ }
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * Tk_CanvasGetCoord --
+ *
+ * Given a string, returns a floating-point canvas coordinate
+ * corresponding to that string.
+ *
+ * Results:
+ * The return value is a standard Tcl return result. If TCL_OK is
+ * returned, then everything went well and the canvas coordinate is
+ * stored at *doublePtr; otherwise TCL_ERROR is returned and an error
+ * message is left in the interp's result.
+ *
+ * Side effects:
+ * None.
+ *
+ *--------------------------------------------------------------
+ */
+
+int
+Tk_CanvasGetCoord(
+ Tcl_Interp *interp, /* Interpreter for error reporting. */
+ Tk_Canvas canvas, /* Canvas to which coordinate applies. */
+ const char *string, /* Describes coordinate (any screen coordinate
+ * form may be used here). */
+ double *doublePtr) /* Place to store converted coordinate. */
+{
+ if (Tk_GetScreenMM(Canvas(canvas)->interp, Canvas(canvas)->tkwin, string,
+ doublePtr) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ *doublePtr *= Canvas(canvas)->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(
+ 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. */
+{
+ return Tk_GetDoublePixelsFromObj(Canvas(canvas)->interp, Canvas(canvas)->tkwin, obj, doublePtr);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_CanvasSetStippleOrigin --
+ *
+ * This function sets the stipple origin in a graphics context so that
+ * stipples drawn with the GC will line up with other stipples previously
+ * drawn in the canvas.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The graphics context is modified.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tk_CanvasSetStippleOrigin(
+ 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. */
+{
+ XSetTSOrigin(Canvas(canvas)->display, gc,
+ -Canvas(canvas)->drawableXOrigin,
+ -Canvas(canvas)->drawableYOrigin);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_CanvasSetOffset--
+ *
+ * This function 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(
+ 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)*/
+{
+ register TkCanvas *canvasPtr = Canvas(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 function returns a pointer to a structure containing information
+ * about the selection and insertion cursor for a canvas widget. Items
+ * such as text items save the pointer and use it to share access to the
+ * information with the generic canvas code.
+ *
+ * Results:
+ * The return value is a pointer to the structure holding text
+ * information for the canvas. Most of the fields should not be modified
+ * outside the generic canvas code; see the user documentation for
+ * details.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+Tk_CanvasTextInfo *
+Tk_CanvasGetTextInfo(
+ Tk_Canvas canvas) /* Token for the canvas widget. */
+{
+ return &Canvas(canvas)->textInfo;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * Tk_CanvasTagsParseProc --
+ *
+ * This function is invoked during option processing to handle "-tags"
+ * options for canvas items.
+ *
+ * Results:
+ * A standard Tcl return value.
+ *
+ * Side effects:
+ * The tags for a given item get replaced by those indicated in the value
+ * argument.
+ *
+ *--------------------------------------------------------------
+ */
+
+int
+Tk_CanvasTagsParseProc(
+ ClientData clientData, /* Not used.*/
+ Tcl_Interp *interp, /* Used for reporting errors. */
+ Tk_Window tkwin, /* Window containing canvas widget. */
+ const char *value, /* Value of option (list of tag names). */
+ char *widgRec, /* Pointer to record for item. */
+ int offset) /* Offset into item (ignored). */
+{
+ register Tk_Item *itemPtr = (Tk_Item *) widgRec;
+ int argc, i;
+ const char **argv;
+ Tk_Uid *newPtr;
+
+ /*
+ * Break the value up into the individual tag names.
+ */
+
+ if (Tcl_SplitList(interp, value, &argc, &argv) != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ /*
+ * Make sure that there's enough space in the item to hold the tag names.
+ */
+
+ if (itemPtr->tagSpace < argc) {
+ newPtr = ckalloc(argc * sizeof(Tk_Uid));
+ for (i = itemPtr->numTags-1; i >= 0; i--) {
+ newPtr[i] = itemPtr->tagPtr[i];
+ }
+ if (itemPtr->tagPtr != itemPtr->staticTagSpace) {
+ ckfree(itemPtr->tagPtr);
+ }
+ itemPtr->tagPtr = newPtr;
+ itemPtr->tagSpace = argc;
+ }
+ itemPtr->numTags = argc;
+ for (i = 0; i < argc; i++) {
+ itemPtr->tagPtr[i] = Tk_GetUid(argv[i]);
+ }
+ ckfree(argv);
+ return TCL_OK;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * Tk_CanvasTagsPrintProc --
+ *
+ * This function is invoked by the Tk configuration code to produce a
+ * printable string for the "-tags" configuration option for canvas
+ * items.
+ *
+ * Results:
+ * The return value is a string describing all the tags for the item
+ * referred to by "widgRec". In addition, *freeProcPtr is filled in with
+ * the address of a function 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.
+ *
+ *--------------------------------------------------------------
+ */
+
+const char *
+Tk_CanvasTagsPrintProc(
+ ClientData clientData, /* Ignored. */
+ Tk_Window tkwin, /* Window containing canvas widget. */
+ char *widgRec, /* Pointer to record for item. */
+ int offset, /* Ignored. */
+ Tcl_FreeProc **freeProcPtr) /* Pointer to variable to fill in with
+ * information about how to reclaim storage
+ * for return string. */
+{
+ register Tk_Item *itemPtr = (Tk_Item *) widgRec;
+
+ if (itemPtr->numTags == 0) {
+ *freeProcPtr = NULL;
+ return "";
+ }
+ if (itemPtr->numTags == 1) {
+ *freeProcPtr = NULL;
+ return (const char *) itemPtr->tagPtr[0];
+ }
+ *freeProcPtr = TCL_DYNAMIC;
+ return Tcl_Merge(itemPtr->numTags, (const char **) itemPtr->tagPtr);
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * TkCanvasDashParseProc --
+ *
+ * This function 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 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 function 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 function 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.
+ *
+ *--------------------------------------------------------------
+ */
+
+const char *
+TkCanvasDashPrintProc(
+ 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, *p;
+ int i = dash->number;
+
+ if (i < 0) {
+ i = -i;
+ *freeProcPtr = TCL_DYNAMIC;
+ buffer = ckalloc(i + 1);
+ p = (i > (int)sizeof(char *)) ? dash->pattern.pt : dash->pattern.array;
+ memcpy(buffer, p, (unsigned int) i);
+ buffer[i] = 0;
+ return buffer;
+ } else if (!i) {
+ *freeProcPtr = NULL;
+ return "";
+ }
+ buffer = ckalloc(4 * i);
+ *freeProcPtr = TCL_DYNAMIC;
+
+ p = (i > (int)sizeof(char *)) ? dash->pattern.pt : dash->pattern.array;
+ sprintf(buffer, "%d", *p++ & 0xff);
+ while (--i) {
+ sprintf(buffer+strlen(buffer), " %d", *p++ & 0xff);
+ }
+ return buffer;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * InitSmoothMethods --
+ *
+ * This function is invoked to set up the initial state of the list of
+ * "-smooth" methods. It should only be called when the list installed
+ * in the interpreter is NULL.
+ *
+ * Results:
+ * Pointer to the start of the list of default smooth methods.
+ *
+ * Side effects:
+ * A linked list of smooth methods is created and attached to the
+ * interpreter's association key "smoothMethod"
+ *
+ *--------------------------------------------------------------
+ */
+
+static SmoothAssocData *
+InitSmoothMethods(
+ Tcl_Interp *interp)
+{
+ SmoothAssocData *methods, *ptr;
+
+ methods = ckalloc(sizeof(SmoothAssocData));
+ methods->smooth.name = tkRawSmoothMethod.name;
+ methods->smooth.coordProc = tkRawSmoothMethod.coordProc;
+ methods->smooth.postscriptProc = tkRawSmoothMethod.postscriptProc;
+
+ ptr = methods->nextPtr = ckalloc(sizeof(SmoothAssocData));
+ ptr->smooth.name = tkBezierSmoothMethod.name;
+ ptr->smooth.coordProc = tkBezierSmoothMethod.coordProc;
+ ptr->smooth.postscriptProc = tkBezierSmoothMethod.postscriptProc;
+ ptr->nextPtr = NULL;
+
+ Tcl_SetAssocData(interp, "smoothMethod", SmoothMethodCleanupProc,methods);
+ return methods;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * Tk_CreateSmoothMethod --
+ *
+ * This function 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.
+ *
+ *--------------------------------------------------------------
+ */
+
+void
+Tk_CreateSmoothMethod(
+ Tcl_Interp *interp,
+ const Tk_SmoothMethod *smooth)
+{
+ SmoothAssocData *methods, *typePtr2, *prevPtr, *ptr;
+ methods = Tcl_GetAssocData(interp, "smoothMethod", NULL);
+
+ /*
+ * Initialize if we were not previously initialized.
+ */
+
+ if (methods == NULL) {
+ methods = InitSmoothMethods(interp);
+ }
+
+ /*
+ * 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(typePtr2);
+ break;
+ }
+ }
+ ptr = 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, ptr);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * SmoothMethodCleanupProc --
+ *
+ * This function is invoked whenever an interpreter is deleted to
+ * cleanup the smooth methods.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Smooth methods are removed.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+SmoothMethodCleanupProc(
+ ClientData clientData, /* Points to "smoothMethod" AssocData for the
+ * interpreter. */
+ Tcl_Interp *interp) /* Interpreter that is being deleted. */
+{
+ SmoothAssocData *ptr, *methods = clientData;
+
+ while (methods != NULL) {
+ ptr = methods;
+ methods = methods->nextPtr;
+ ckfree(ptr);
+ }
+}
+/*
+ *--------------------------------------------------------------
+ *
+ * TkSmoothParseProc --
+ *
+ * This function 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 clientData, /* Ignored. */
+ 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 const Tk_SmoothMethod **smoothPtr =
+ (const Tk_SmoothMethod **) (widgRec + offset);
+ const Tk_SmoothMethod *smooth = NULL;
+ int b;
+ size_t length;
+ SmoothAssocData *methods;
+
+ if (value == NULL || *value == 0) {
+ *smoothPtr = NULL;
+ return TCL_OK;
+ }
+ length = strlen(value);
+ methods = Tcl_GetAssocData(interp, "smoothMethod", NULL);
+
+ /*
+ * Not initialized yet; fix that now.
+ */
+
+ if (methods == NULL) {
+ methods = InitSmoothMethods(interp);
+ }
+
+ /*
+ * Backward compatability hack.
+ */
+
+ if (strncmp(value, "bezier", length) == 0) {
+ smooth = &tkBezierSmoothMethod;
+ }
+
+ /*
+ * Search the list of installed smooth methods.
+ */
+
+ while (methods != NULL) {
+ if (strncmp(value, methods->smooth.name, length) == 0) {
+ if (smooth != NULL) {
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "ambiguous smooth method \"%s\"", value));
+ Tcl_SetErrorCode(interp, "TK", "LOOKUP", "SMOOTH", value,
+ NULL);
+ return TCL_ERROR;
+ }
+ smooth = &methods->smooth;
+ }
+ methods = methods->nextPtr;
+ }
+ if (smooth) {
+ *smoothPtr = smooth;
+ return TCL_OK;
+ }
+
+ /*
+ * Did not find it. Try parsing as a boolean instead.
+ */
+
+ if (Tcl_GetBoolean(interp, (char *) value, &b) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ *smoothPtr = b ? &tkBezierSmoothMethod : NULL;
+ return TCL_OK;
+}
+/*
+ *--------------------------------------------------------------
+ *
+ * TkSmoothPrintProc --
+ *
+ * This function 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 function 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.
+ *
+ *--------------------------------------------------------------
+ */
+
+const char *
+TkSmoothPrintProc(
+ 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 const Tk_SmoothMethod *smoothPtr =
+ * (Tk_SmoothMethod **) (widgRec + offset);
+
+ return smoothPtr ? smoothPtr->name : "0";
+}
+/*
+ *--------------------------------------------------------------
+ *
+ * Tk_GetDash
+ *
+ * This function 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(
+ Tcl_Interp *interp, /* Used for error reporting. */
+ const char *value, /* Textual specification of dash list. */
+ Tk_Dash *dash) /* Pointer to record in which to store dash
+ * information. */
+{
+ int argc, i;
+ const char **largv, **argv = NULL;
+ char *pt;
+
+ if ((value == NULL) || (*value == '\0')) {
+ dash->number = 0;
+ return TCL_OK;
+ }
+
+ /*
+ * switch is usually compiled more efficiently than a chain of conditions.
+ */
+
+ switch (*value) {
+ case '.': case ',': case '-': case '_':
+ i = DashConvert(NULL, value, -1, 0.0);
+ if (i <= 0) {
+ goto badDashList;
+ }
+ i = strlen(value);
+ if (i > (int) sizeof(char *)) {
+ dash->pattern.pt = pt = ckalloc(strlen(value));
+ } else {
+ pt = dash->pattern.array;
+ }
+ memcpy(pt, value, (unsigned) i);
+ dash->number = -i;
+ return TCL_OK;
+ }
+
+ if (Tcl_SplitList(interp, (char *) value, &argc, &argv) != TCL_OK) {
+ Tcl_ResetResult(interp);
+ goto badDashList;
+ }
+
+ if ((unsigned) ABS(dash->number) > sizeof(char *)) {
+ ckfree(dash->pattern.pt);
+ }
+ if (argc > (int) sizeof(char *)) {
+ dash->pattern.pt = pt = ckalloc(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_SetObjResult(interp, Tcl_ObjPrintf(
+ "expected integer in the range 1..255 but got \"%s\"",
+ *largv));
+ Tcl_SetErrorCode(interp, "TK", "VALUE", "DASH", NULL);
+ goto syntaxError;
+ }
+ *pt++ = i;
+ argc--;
+ largv++;
+ }
+
+ if (argv != NULL) {
+ ckfree(argv);
+ }
+ return TCL_OK;
+
+ /*
+ * Something went wrong. Generate error message, clean up and return.
+ */
+
+ badDashList:
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "bad dash list \"%s\": must be a list of integers or a format like \"-..\"",
+ value));
+ Tcl_SetErrorCode(interp, "TK", "VALUE", "DASH", NULL);
+ syntaxError:
+ if (argv != NULL) {
+ ckfree(argv);
+ }
+ if ((unsigned) ABS(dash->number) > sizeof(char *)) {
+ ckfree(dash->pattern.pt);
+ }
+ dash->number = 0;
+ return TCL_ERROR;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * Tk_CreateOutline
+ *
+ * This function initializes the Tk_Outline structure with default
+ * values.
+ *
+ * Results:
+ * None
+ *
+ * Side effects:
+ * None
+ *
+ *--------------------------------------------------------------
+ */
+
+void
+Tk_CreateOutline(
+ Tk_Outline *outline) /* Outline structure to be filled in. */
+{
+ 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 function frees all memory that might be allocated and referenced
+ * in the Tk_Outline structure.
+ *
+ * Results:
+ * None
+ *
+ * Side effects:
+ * None
+ *
+ *--------------------------------------------------------------
+ */
+
+void
+Tk_DeleteOutline(
+ Display *display, /* Display containing window. */
+ Tk_Outline *outline)
+{
+ if (outline->gc != None) {
+ Tk_FreeGC(display, outline->gc);
+ }
+ if ((unsigned) ABS(outline->dash.number) > sizeof(char *)) {
+ ckfree(outline->dash.pattern.pt);
+ }
+ if ((unsigned) ABS(outline->activeDash.number) > sizeof(char *)) {
+ ckfree(outline->activeDash.pattern.pt);
+ }
+ if ((unsigned) ABS(outline->disabledDash.number) > sizeof(char *)) {
+ ckfree(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 function 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(
+ 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 = Canvas(canvas)->canvas_state;
+ }
+ if (Canvas(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 > 0) {
+ gcValues->dashes = dash->pattern.array[0];
+ } else {
+ gcValues->dashes = (char) (4 * width + 0.5);
+ }
+ 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, and 0 otherwise.
+ *
+ * Side effects:
+ * GC is updated.
+ *
+ *--------------------------------------------------------------
+ */
+
+int
+Tk_ChangeOutlineGC(
+ 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 = Canvas(canvas)->canvas_state;
+ }
+ if (Canvas(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[0] != ','))) {
+ char *q;
+ int i = -dash->number;
+
+ p = (i > (int)sizeof(char *)) ? dash->pattern.pt : dash->pattern.array;
+ q = ckalloc(2 * i);
+ i = DashConvert(q, p, i, width);
+ XSetDashes(Canvas(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 = (dash->number > (int) sizeof(char *))
+ ? dash->pattern.pt : dash->pattern.array;
+ XSetDashes(Canvas(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(Canvas(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_ChangeOutlineGC() 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, and 0 otherwise.
+ *
+ * Side effects:
+ * GC is updated.
+ *
+ *--------------------------------------------------------------
+ */
+
+int
+Tk_ResetOutlineGC(
+ 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 = Canvas(canvas)->canvas_state;
+ }
+ if (Canvas(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[0] != ','))) {
+ if (dash->number > 0) {
+ dashList = dash->pattern.array[0];
+ } else {
+ dashList = (char) (4 * width + 0.5);
+ }
+ XSetDashes(Canvas(canvas)->display, outline->gc, outline->offset,
+ &dashList , 1);
+ }
+ if (stipple != None) {
+ XSetTSOrigin(Canvas(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(
+ Tk_Canvas canvas,
+ Tk_Item *item,
+ Tk_Outline *outline)
+{
+ char pattern[11];
+ int i;
+ char *ptr, *lptr = pattern;
+ Tcl_Interp *interp = Canvas(canvas)->interp;
+ double width = outline->width;
+ Tk_Dash *dash = &outline->dash;
+ XColor *color = outline->color;
+ Pixmap stipple = outline->stipple;
+ Tk_State state = item->state;
+ Tcl_Obj *psObj = GetPostscriptBuffer(interp);
+
+ if (state == TK_STATE_NULL) {
+ state = Canvas(canvas)->canvas_state;
+ }
+
+ if (Canvas(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;
+ }
+ }
+
+ Tcl_AppendPrintfToObj(psObj, "%.15g setlinewidth\n", width);
+
+ ptr = ((unsigned) ABS(dash->number) > sizeof(char *)) ?
+ dash->pattern.pt : dash->pattern.array;
+ Tcl_AppendToObj(psObj, "[", -1);
+ if (dash->number > 0) {
+ Tcl_Obj *converted;
+ char *p = ptr;
+
+ converted = Tcl_ObjPrintf("%d", *p++ & 0xff);
+ for (i = dash->number-1 ; i>0 ; i--) {
+ Tcl_AppendPrintfToObj(converted, " %d", *p++ & 0xff);
+ }
+ Tcl_AppendObjToObj(psObj, converted);
+ if (dash->number & 1) {
+ Tcl_AppendToObj(psObj, " ", -1);
+ Tcl_AppendObjToObj(psObj, converted);
+ }
+ Tcl_DecrRefCount(converted);
+ Tcl_AppendPrintfToObj(psObj, "] %d setdash\n", outline->offset);
+ } else if (dash->number < 0) {
+ if (dash->number < -5) {
+ lptr = ckalloc(1 - 2*dash->number);
+ }
+ i = DashConvert(lptr, ptr, -dash->number, width);
+ if (i > 0) {
+ char *p = lptr;
+
+ Tcl_AppendPrintfToObj(psObj, "%d", *p++ & 0xff);
+ for (; --i>0 ;) {
+ Tcl_AppendPrintfToObj(psObj, " %d", *p++ & 0xff);
+ }
+ Tcl_AppendPrintfToObj(psObj, "] %d setdash\n", outline->offset);
+ } else {
+ Tcl_AppendToObj(psObj, "] 0 setdash\n", -1);
+ }
+ if (lptr != pattern) {
+ ckfree(lptr);
+ }
+ } else {
+ Tcl_AppendToObj(psObj, "] 0 setdash\n", -1);
+ }
+
+ if (Tk_CanvasPsColor(interp, canvas, color) != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ /*
+ * Note that psObj might hold an invalid reference now.
+ */
+
+ if (stipple != None) {
+ Tcl_AppendToObj(GetPostscriptBuffer(interp), "StrokeClip ", -1);
+ if (Tk_CanvasPsStipple(interp, canvas, stipple) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ } else {
+ Tcl_AppendToObj(GetPostscriptBuffer(interp), "stroke\n", -1);
+ }
+
+ 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(
+ char *l, /* Must be at least 2*n chars long, or NULL to
+ * indicate "just check syntax". */
+ const char *p, /* String to parse. */
+ int n, /* Length of string to parse, or -1 to
+ * indicate that strlen() should be used. */
+ double width) /* Width of line. */
+{
+ 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;
+ }
+ return 0;
+ 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;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TranslateAndAppendCoords --
+ *
+ * This is a helper routine for TkCanvTranslatePath() below.
+ *
+ * Given an (x,y) coordinate pair within a canvas, this function computes
+ * the corresponding coordinates at which the point should be drawn in
+ * the drawable used for display. Those coordinates are then written into
+ * outArr[numOut*2] and outArr[numOut*2+1].
+ *
+ * Results:
+ * There is no return value.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+TranslateAndAppendCoords(
+ TkCanvas *canvPtr, /* The canvas. */
+ double x, /* Coordinates in canvas space. */
+ double y,
+ XPoint *outArr, /* Write results into this array */
+ int numOut) /* Num of prior entries in outArr[] */
+{
+ double tmp;
+
+ tmp = x - canvPtr->drawableXOrigin;
+ if (tmp > 0) {
+ tmp += 0.5;
+ } else {
+ tmp -= 0.5;
+ }
+ outArr[numOut].x = (short) tmp;
+
+ tmp = y - canvPtr->drawableYOrigin;
+ if (tmp > 0) {
+ tmp += 0.5;
+ } else {
+ tmp -= 0.5;
+ }
+ outArr[numOut].y = (short) tmp;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * TkCanvTranslatePath
+ *
+ * Translate a line or polygon path so that all vertices are within a
+ * rectangle that is 1000 pixels larger than the total size of the canvas
+ * window. This will prevent pixel coordinates from overflowing the
+ * 16-bit integer size limitation imposed by most windowing systems.
+ *
+ * coordPtr must point to an array of doubles, two doubles per vertex.
+ * There are a total of numVertex vertices, or 2*numVertex entries in
+ * coordPtr. The result vertices written into outArr have their
+ * coordinate origin shifted to canvPtr->drawableXOrigin by
+ * canvPtr->drawableYOrigin. There might be as many as 3 times more
+ * output vertices than there are input vertices. The calling function
+ * should allocate space accordingly.
+ *
+ * This routine limits the width and height of a canvas window to 31767
+ * pixels. At the highest resolution display devices available today (210
+ * ppi in Jan 2003) that's a window that is over 13 feet wide and tall.
+ * Should be enough for the near future.
+ *
+ * Results:
+ * Clipped and translated path vertices are written into outArr[]. There
+ * might be as many as twice the vertices in outArr[] as there are in
+ * coordPtr[]. The return value is the number of vertices actually
+ * written into outArr[].
+ *
+ * Side effects:
+ * None
+ *
+ *--------------------------------------------------------------
+ */
+
+int
+TkCanvTranslatePath(
+ TkCanvas *canvPtr, /* The canvas */
+ int numVertex, /* Number of vertices specified by
+ * coordArr[] */
+ double *coordArr, /* X and Y coordinates for each vertex */
+ int closedPath, /* True if this is a closed polygon */
+ XPoint *outArr) /* Write results here, if not NULL */
+{
+ int numOutput = 0; /* Number of output coordinates */
+ double lft, rgh; /* Left and right sides of the bounding box */
+ double top, btm; /* Top and bottom sizes of the bounding box */
+ double *tempArr; /* Temporary storage used by the clipper */
+ double *a, *b, *t; /* Pointers to parts of the temporary
+ * storage */
+ int i, j; /* Loop counters */
+ double limit[4]; /* Boundries at which clipping occurs */
+ double staticSpace[480]; /* Temp space from the stack */
+
+ /*
+ * Constrain all vertices of the path to be within a box that is no larger
+ * than 32000 pixels wide or height. The top-left corner of this clipping
+ * box is 1000 pixels above and to the left of the top left corner of the
+ * window on which the canvas is displayed.
+ *
+ * This means that a canvas will not display properly on a canvas window
+ * that is larger than 31000 pixels wide or high. That is not a problem
+ * today, but might someday become a factor for ultra-high resolutions
+ * displays.
+ *
+ * The X11 protocol allows us (in theory) to expand the size of the
+ * clipping box to 32767 pixels. But we have found experimentally that
+ * XFree86 sometimes fails to draw lines correctly if they are longer than
+ * about 32500 pixels. So we have left a little margin in the size to mask
+ * that bug.
+ */
+
+ lft = canvPtr->xOrigin - 1000.0;
+ top = canvPtr->yOrigin - 1000.0;
+ rgh = lft + 32000.0;
+ btm = top + 32000.0;
+
+ /*
+ * Try the common case first - no clipping. Loop over the input
+ * coordinates and translate them into appropriate output coordinates.
+ * But if a vertex outside of the bounding box is seen, break out of the
+ * loop.
+ *
+ * Most of the time, no clipping is needed, so this one loop is sufficient
+ * to do the translation.
+ */
+
+ for (i=0; i<numVertex; i++){
+ double x, y;
+
+ x = coordArr[i*2];
+ y = coordArr[i*2 + 1];
+ if (x<lft || x>rgh || y<top || y>btm) {
+ break;
+ }
+ TranslateAndAppendCoords(canvPtr, x, y, outArr, numOutput++);
+ }
+ if (i == numVertex){
+ assert(numOutput == numVertex);
+ return numOutput;
+ }
+
+ /*
+ * If we reach this point, it means that some clipping is required. Begin
+ * by allocating some working storage - at least 6 times as much space as
+ * coordArr[] requires. Divide this space into two separate arrays a[] and
+ * b[]. Initialize a[] to be equal to coordArr[].
+ */
+
+ if (numVertex*12 <= (int) (sizeof(staticSpace) / sizeof(double))) {
+ tempArr = staticSpace;
+ } else {
+ tempArr = ckalloc(numVertex * 12 * sizeof(double));
+ }
+ for (i=0; i<numVertex*2; i++){
+ tempArr[i] = coordArr[i];
+ }
+ a = tempArr;
+ b = &tempArr[numVertex*6];
+
+ /*
+ * We will make four passes through the input data. On each pass, we copy
+ * the contents of a[] over into b[]. As we copy, we clip any line
+ * segments that extend to the right past xClip then we rotate the
+ * coordinate system 90 degrees clockwise. After each pass is complete, we
+ * interchange a[] and b[] in preparation for the next pass.
+ *
+ * Each pass clips line segments that extend beyond a single side of the
+ * bounding box, and four passes rotate the coordinate system back to its
+ * original value. I'm not an expert on graphics algorithms, but I think
+ * this is called Cohen-Sutherland polygon clipping.
+ *
+ * The limit[] array contains the xClip value used for each of the four
+ * passes.
+ */
+
+ limit[0] = rgh;
+ limit[1] = -top;
+ limit[2] = -lft;
+ limit[3] = btm;
+
+ /*
+ * This is the loop that makes the four passes through the data.
+ */
+
+ for (j=0; j<4; j++) {
+ double xClip = limit[j];
+ int inside = a[0] < xClip;
+ double priorY = a[1];
+ numOutput = 0;
+
+ /*
+ * Clip everything to the right of xClip. Store the results in b[]
+ * rotated by 90 degrees clockwise.
+ */
+
+ for (i=0; i<numVertex; i++) {
+ double x = a[i*2];
+ double y = a[i*2 + 1];
+
+ if (x >= xClip) {
+ /*
+ * The current vertex is to the right of xClip.
+ */
+
+ if (inside) {
+ /*
+ * If the current vertex is to the right of xClip but the
+ * previous vertex was left of xClip, then draw a line
+ * segment from the previous vertex to until it intersects
+ * the vertical at xClip.
+ */
+
+ double x0, y0, yN;
+
+ assert(i > 0);
+ x0 = a[i*2 - 2];
+ y0 = a[i*2 - 1];
+ yN = y0 + (y - y0)*(xClip-x0)/(x-x0);
+ b[numOutput*2] = -yN;
+ b[numOutput*2 + 1] = xClip;
+ numOutput++;
+ assert(numOutput <= numVertex*3);
+ priorY = yN;
+ inside = 0;
+ } else if (i == 0) {
+ /*
+ * If the first vertex is to the right of xClip, add a
+ * vertex that is the projection of the first vertex onto
+ * the vertical xClip line.
+ */
+
+ b[0] = -y;
+ b[1] = xClip;
+ numOutput = 1;
+ priorY = y;
+ }
+ } else {
+ /*
+ * The current vertex is to the left of xClip
+ */
+
+ if (!inside) {
+ /*
+ * If the current vertex is on the left of xClip and one
+ * or more prior vertices where to the right, then we have
+ * to draw a line segment along xClip that extends from
+ * the spot where we first crossed from left to right to
+ * the spot where we cross back from right to left.
+ */
+
+ double x0, y0, yN;
+
+ assert(i > 0);
+ x0 = a[i*2 - 2];
+ y0 = a[i*2 - 1];
+ yN = y0 + (y - y0)*(xClip-x0)/(x-x0);
+ if (yN != priorY) {
+ b[numOutput*2] = -yN;
+ b[numOutput*2 + 1] = xClip;
+ numOutput++;
+ assert(numOutput <= numVertex*3);
+ }
+ inside = 1;
+ }
+ b[numOutput*2] = -y;
+ b[numOutput*2 + 1] = x;
+ numOutput++;
+ assert(numOutput <= numVertex*3);
+ }
+ }
+
+ /*
+ * Interchange a[] and b[] in preparation for the next pass.
+ */
+
+ t = a;
+ a = b;
+ b = t;
+ numVertex = numOutput;
+ }
+
+ /*
+ * All clipping is now finished. Convert the coordinates from doubles into
+ * XPoints and translate the origin for the drawable.
+ */
+
+ for (i=0; i<numVertex; i++) {
+ TranslateAndAppendCoords(canvPtr, a[i*2], a[i*2+1], outArr, i);
+ }
+ if (tempArr != staticSpace) {
+ ckfree(tempArr);
+ }
+ return numOutput;
+}
+
+/*
+ * Local Variables:
+ * mode: c
+ * c-basic-offset: 4
+ * fill-column: 78
+ * End:
+ */
diff --git a/tk8.6/generic/tkCanvWind.c b/tk8.6/generic/tkCanvWind.c
new file mode 100644
index 0000000..f73546f
--- /dev/null
+++ b/tk8.6/generic/tkCanvWind.c
@@ -0,0 +1,1095 @@
+/*
+ * tkCanvWind.c --
+ *
+ * This file implements window items for canvas widgets.
+ *
+ * Copyright (c) 1992-1994 The Regents of the University of California.
+ * Copyright (c) 1994-1997 Sun Microsystems, Inc.
+ *
+ * See the file "license.terms" for information on usage and redistribution of
+ * this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ */
+
+#include "tkInt.h"
+#include "tkCanvas.h"
+
+/*
+ * The structure below defines the record for each window item.
+ */
+
+typedef struct WindowItem {
+ Tk_Item header; /* Generic stuff that's the same for all
+ * types. MUST BE FIRST IN STRUCTURE. */
+ double x, y; /* Coordinates of positioning point for
+ * window. */
+ Tk_Window tkwin; /* Window associated with item. NULL means
+ * window has been destroyed. */
+ int width; /* Width to use for window (<= 0 means use
+ * window's requested width). */
+ int height; /* Width to use for window (<= 0 means use
+ * window's requested width). */
+ Tk_Anchor anchor; /* Where to anchor window relative to
+ * (x,y). */
+ Tk_Canvas canvas; /* Canvas containing this item. */
+} WindowItem;
+
+/*
+ * Information used for parsing configuration specs:
+ */
+
+static const Tk_CustomOption stateOption = {
+ TkStateParseProc, TkStatePrintProc, INT2PTR(2)
+};
+static const Tk_CustomOption tagsOption = {
+ Tk_CanvasTagsParseProc, Tk_CanvasTagsPrintProc, NULL
+};
+
+static const Tk_ConfigSpec configSpecs[] = {
+ {TK_CONFIG_ANCHOR, "-anchor", NULL, NULL,
+ "center", Tk_Offset(WindowItem, anchor), TK_CONFIG_DONT_SET_DEFAULT, NULL},
+ {TK_CONFIG_PIXELS, "-height", NULL, NULL,
+ "0", Tk_Offset(WindowItem, height), TK_CONFIG_DONT_SET_DEFAULT, NULL},
+ {TK_CONFIG_CUSTOM, "-state", NULL, NULL,
+ NULL, Tk_Offset(Tk_Item, state), TK_CONFIG_NULL_OK, &stateOption},
+ {TK_CONFIG_CUSTOM, "-tags", NULL, NULL,
+ NULL, 0, TK_CONFIG_NULL_OK, &tagsOption},
+ {TK_CONFIG_PIXELS, "-width", NULL, NULL,
+ "0", Tk_Offset(WindowItem, width), TK_CONFIG_DONT_SET_DEFAULT, NULL},
+ {TK_CONFIG_WINDOW, "-window", NULL, NULL,
+ NULL, Tk_Offset(WindowItem, tkwin), TK_CONFIG_NULL_OK, NULL},
+ {TK_CONFIG_END, NULL, NULL, NULL, NULL, 0, 0, NULL}
+};
+
+/*
+ * Prototypes for functions defined in this file:
+ */
+
+static void ComputeWindowBbox(Tk_Canvas canvas,
+ WindowItem *winItemPtr);
+static int ConfigureWinItem(Tcl_Interp *interp,
+ Tk_Canvas canvas, Tk_Item *itemPtr, int objc,
+ Tcl_Obj *const objv[], int flags);
+static int CreateWinItem(Tcl_Interp *interp,
+ Tk_Canvas canvas, struct Tk_Item *itemPtr,
+ int objc, Tcl_Obj *const objv[]);
+static void DeleteWinItem(Tk_Canvas canvas,
+ Tk_Item *itemPtr, Display *display);
+static void DisplayWinItem(Tk_Canvas canvas,
+ Tk_Item *itemPtr, Display *display, Drawable dst,
+ int x, int y, int width, int height);
+static void ScaleWinItem(Tk_Canvas canvas,
+ Tk_Item *itemPtr, double originX, double originY,
+ double scaleX, double scaleY);
+static void TranslateWinItem(Tk_Canvas canvas,
+ Tk_Item *itemPtr, double deltaX, double deltaY);
+static int WinItemCoords(Tcl_Interp *interp,
+ Tk_Canvas canvas, Tk_Item *itemPtr, int objc,
+ Tcl_Obj *const objv[]);
+static void WinItemLostSlaveProc(ClientData clientData,
+ Tk_Window tkwin);
+static void WinItemRequestProc(ClientData clientData,
+ Tk_Window tkwin);
+static void WinItemStructureProc(ClientData clientData,
+ XEvent *eventPtr);
+static int WinItemToArea(Tk_Canvas canvas,
+ Tk_Item *itemPtr, double *rectPtr);
+static int WinItemToPostscript(Tcl_Interp *interp,
+ Tk_Canvas canvas, Tk_Item *itemPtr, int prepass);
+static double WinItemToPoint(Tk_Canvas canvas,
+ Tk_Item *itemPtr, double *pointPtr);
+#ifdef X_GetImage
+static int xerrorhandler(ClientData clientData, XErrorEvent *e);
+#endif
+static int CanvasPsWindow(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 functions
+ * that can be invoked by generic item code.
+ */
+
+Tk_ItemType tkWindowType = {
+ "window", /* name */
+ sizeof(WindowItem), /* itemSize */
+ CreateWinItem, /* createProc */
+ configSpecs, /* configSpecs */
+ ConfigureWinItem, /* configureProc */
+ WinItemCoords, /* coordProc */
+ DeleteWinItem, /* deleteProc */
+ DisplayWinItem, /* displayProc */
+ 1|TK_CONFIG_OBJS, /* flags */
+ WinItemToPoint, /* pointProc */
+ WinItemToArea, /* areaProc */
+ WinItemToPostscript, /* postscriptProc */
+ ScaleWinItem, /* scaleProc */
+ TranslateWinItem, /* translateProc */
+ NULL, /* indexProc */
+ NULL, /* cursorProc */
+ NULL, /* selectionProc */
+ NULL, /* insertProc */
+ NULL, /* dTextProc */
+ NULL, /* nextPtr */
+ NULL, 0, NULL, NULL
+};
+
+/*
+ * The structure below defines the official type record for the canvas (as
+ * geometry manager):
+ */
+
+static const Tk_GeomMgr canvasGeomType = {
+ "canvas", /* name */
+ WinItemRequestProc, /* requestProc */
+ WinItemLostSlaveProc, /* lostSlaveProc */
+};
+
+/*
+ *--------------------------------------------------------------
+ *
+ * CreateWinItem --
+ *
+ * This function is invoked to create a new window item in a canvas.
+ *
+ * Results:
+ * A standard Tcl return value. If an error occurred in creating the
+ * item, then an error message is left in the interp's result; in this
+ * case itemPtr is left uninitialized, so it can be safely freed by the
+ * caller.
+ *
+ * Side effects:
+ * A new window item is created.
+ *
+ *--------------------------------------------------------------
+ */
+
+static int
+CreateWinItem(
+ Tcl_Interp *interp, /* Interpreter for error reporting. */
+ Tk_Canvas canvas, /* Canvas to hold new item. */
+ Tk_Item *itemPtr, /* Record to hold new item; header has been
+ * initialized by caller. */
+ int objc, /* Number of arguments in objv. */
+ Tcl_Obj *const objv[]) /* Arguments describing window. */
+{
+ WindowItem *winItemPtr = (WindowItem *) itemPtr;
+ int i;
+
+ if (objc == 0) {
+ Tcl_Panic("canvas did not pass any coords");
+ }
+
+ /*
+ * Initialize item's record.
+ */
+
+ winItemPtr->tkwin = NULL;
+ winItemPtr->width = 0;
+ winItemPtr->height = 0;
+ winItemPtr->anchor = TK_ANCHOR_CENTER;
+ winItemPtr->canvas = canvas;
+
+ /*
+ * Process the arguments to fill in the item record. Only 1 (list) or 2 (x
+ * y) coords are allowed.
+ */
+
+ if (objc == 1) {
+ i = 1;
+ } else {
+ const char *arg = Tcl_GetString(objv[1]);
+
+ i = 2;
+ if ((arg[0] == '-') && (arg[1] >= 'a') && (arg[1] <= 'z')) {
+ i = 1;
+ }
+ }
+ if (WinItemCoords(interp, canvas, itemPtr, i, objv) != TCL_OK) {
+ goto error;
+ }
+ if (ConfigureWinItem(interp, canvas, itemPtr, objc-i, objv+i, 0)
+ == TCL_OK) {
+ return TCL_OK;
+ }
+
+ error:
+ DeleteWinItem(canvas, itemPtr, Tk_Display(Tk_CanvasTkwin(canvas)));
+ return TCL_ERROR;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * WinItemCoords --
+ *
+ * This function is invoked to process the "coords" widget command on
+ * window items. See the user documentation for details on what it does.
+ *
+ * Results:
+ * Returns TCL_OK or TCL_ERROR, and sets the interp's result.
+ *
+ * Side effects:
+ * The coordinates for the given item may be changed.
+ *
+ *--------------------------------------------------------------
+ */
+
+static int
+WinItemCoords(
+ Tcl_Interp *interp, /* Used for error reporting. */
+ Tk_Canvas canvas, /* Canvas containing item. */
+ Tk_Item *itemPtr, /* Item whose coordinates are to be read or
+ * modified. */
+ int objc, /* Number of coordinates supplied in objv. */
+ Tcl_Obj *const objv[]) /* Array of coordinates: x1, y1, x2, y2, ... */
+{
+ WindowItem *winItemPtr = (WindowItem *) itemPtr;
+
+ if (objc == 0) {
+ Tcl_Obj *objs[2];
+
+ objs[0] = Tcl_NewDoubleObj(winItemPtr->x);
+ objs[1] = Tcl_NewDoubleObj(winItemPtr->y);
+ Tcl_SetObjResult(interp, Tcl_NewListObj(2, objs));
+ } else if (objc < 3) {
+ if (objc==1) {
+ if (Tcl_ListObjGetElements(interp, objv[0], &objc,
+ (Tcl_Obj ***) &objv) != TCL_OK) {
+ return TCL_ERROR;
+ } else if (objc != 2) {
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "wrong # coordinates: expected 2, got %d", objc));
+ Tcl_SetErrorCode(interp, "TK", "CANVAS", "COORDS", "WINDOW",
+ NULL);
+ return TCL_ERROR;
+ }
+ }
+ if ((Tk_CanvasGetCoordFromObj(interp, canvas, objv[0], &winItemPtr->x)
+ != TCL_OK) || (Tk_CanvasGetCoordFromObj(interp, canvas, objv[1],
+ &winItemPtr->y) != TCL_OK)) {
+ return TCL_ERROR;
+ }
+ ComputeWindowBbox(canvas, winItemPtr);
+ } else {
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "wrong # coordinates: expected 0 or 2, got %d", objc));
+ Tcl_SetErrorCode(interp, "TK", "CANVAS", "COORDS", "WINDOW", NULL);
+ return TCL_ERROR;
+ }
+ return TCL_OK;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * ConfigureWinItem --
+ *
+ * This function is invoked to configure various aspects of a window
+ * item, such as its anchor position.
+ *
+ * Results:
+ * A standard Tcl result code. If an error occurs, then an error message
+ * is left in the interp's result.
+ *
+ * Side effects:
+ * Configuration information may be set for itemPtr.
+ *
+ *--------------------------------------------------------------
+ */
+
+static int
+ConfigureWinItem(
+ Tcl_Interp *interp, /* Used for error reporting. */
+ Tk_Canvas canvas, /* Canvas containing itemPtr. */
+ Tk_Item *itemPtr, /* Window item to reconfigure. */
+ int objc, /* Number of elements in objv. */
+ Tcl_Obj *const objv[], /* Arguments describing things to configure. */
+ int flags) /* Flags to pass to Tk_ConfigureWidget. */
+{
+ WindowItem *winItemPtr = (WindowItem *) itemPtr;
+ Tk_Window oldWindow;
+ Tk_Window canvasTkwin;
+
+ oldWindow = winItemPtr->tkwin;
+ canvasTkwin = Tk_CanvasTkwin(canvas);
+ if (TCL_OK != Tk_ConfigureWidget(interp, canvasTkwin, configSpecs, objc,
+ (const char **) objv, (char *) winItemPtr, flags|TK_CONFIG_OBJS)) {
+ return TCL_ERROR;
+ }
+
+ /*
+ * A few of the options require additional processing.
+ */
+
+ if (oldWindow != winItemPtr->tkwin) {
+ if (oldWindow != NULL) {
+ Tk_DeleteEventHandler(oldWindow, StructureNotifyMask,
+ WinItemStructureProc, winItemPtr);
+ Tk_ManageGeometry(oldWindow, NULL, NULL);
+ Tk_UnmaintainGeometry(oldWindow, canvasTkwin);
+ Tk_UnmapWindow(oldWindow);
+ }
+ if (winItemPtr->tkwin != NULL) {
+ Tk_Window ancestor, parent;
+
+ /*
+ * Make sure that the canvas is either the parent of the window
+ * associated with the item or a descendant of that parent. Also,
+ * don't allow a top-of-hierarchy window to be managed inside a
+ * canvas.
+ */
+
+ parent = Tk_Parent(winItemPtr->tkwin);
+ for (ancestor = canvasTkwin ;; ancestor = Tk_Parent(ancestor)) {
+ if (ancestor == parent) {
+ break;
+ }
+ if (((Tk_FakeWin *) ancestor)->flags & TK_TOP_HIERARCHY) {
+ goto badWindow;
+ }
+ }
+ if (((Tk_FakeWin *) winItemPtr->tkwin)->flags & TK_TOP_HIERARCHY){
+ goto badWindow;
+ }
+ if (winItemPtr->tkwin == canvasTkwin) {
+ goto badWindow;
+ }
+ Tk_CreateEventHandler(winItemPtr->tkwin, StructureNotifyMask,
+ WinItemStructureProc, winItemPtr);
+ Tk_ManageGeometry(winItemPtr->tkwin, &canvasGeomType, winItemPtr);
+ }
+ }
+ if ((winItemPtr->tkwin != NULL)
+ && (itemPtr->state == TK_STATE_HIDDEN)) {
+ if (canvasTkwin == Tk_Parent(winItemPtr->tkwin)) {
+ Tk_UnmapWindow(winItemPtr->tkwin);
+ } else {
+ Tk_UnmaintainGeometry(winItemPtr->tkwin, canvasTkwin);
+ }
+ }
+
+ ComputeWindowBbox(canvas, winItemPtr);
+ return TCL_OK;
+
+ badWindow:
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "can't use %s in a window item of this canvas",
+ Tk_PathName(winItemPtr->tkwin)));
+ Tcl_SetErrorCode(interp, "TK", "GEOMETRY", "HIERARCHY", NULL);
+ winItemPtr->tkwin = NULL;
+ return TCL_ERROR;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * DeleteWinItem --
+ *
+ * This function is called to clean up the data structure associated with
+ * a window item.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Resources associated with itemPtr are released.
+ *
+ *--------------------------------------------------------------
+ */
+
+static void
+DeleteWinItem(
+ Tk_Canvas canvas, /* Overall info about widget. */
+ Tk_Item *itemPtr, /* Item that is being deleted. */
+ Display *display) /* Display containing window for canvas. */
+{
+ WindowItem *winItemPtr = (WindowItem *) itemPtr;
+ Tk_Window canvasTkwin = Tk_CanvasTkwin(canvas);
+
+ if (winItemPtr->tkwin != NULL) {
+ Tk_DeleteEventHandler(winItemPtr->tkwin, StructureNotifyMask,
+ WinItemStructureProc, winItemPtr);
+ Tk_ManageGeometry(winItemPtr->tkwin, NULL, NULL);
+ if (canvasTkwin != Tk_Parent(winItemPtr->tkwin)) {
+ Tk_UnmaintainGeometry(winItemPtr->tkwin, canvasTkwin);
+ }
+ Tk_UnmapWindow(winItemPtr->tkwin);
+ }
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * ComputeWindowBbox --
+ *
+ * This function is invoked to compute the bounding box of all the pixels
+ * that may be drawn as part of a window item. This function is where the
+ * child window's placement is computed.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The fields x1, y1, x2, and y2 are updated in the header for itemPtr.
+ *
+ *--------------------------------------------------------------
+ */
+
+static void
+ComputeWindowBbox(
+ Tk_Canvas canvas, /* Canvas that contains item. */
+ WindowItem *winItemPtr) /* Item whose bbox is to be recomputed. */
+{
+ int width, height, x, y;
+ Tk_State state = winItemPtr->header.state;
+
+ x = (int) (winItemPtr->x + ((winItemPtr->x >= 0) ? 0.5 : - 0.5));
+ y = (int) (winItemPtr->y + ((winItemPtr->y >= 0) ? 0.5 : - 0.5));
+
+ if (state == TK_STATE_NULL) {
+ state = Canvas(canvas)->canvas_state;
+ }
+ if ((winItemPtr->tkwin == NULL) || (state == TK_STATE_HIDDEN)) {
+ /*
+ * There is no window for this item yet. Just give it a 1x1 bounding
+ * box. Don't give it a 0x0 bounding box; there are strange cases
+ * where this bounding box might be used as the dimensions of the
+ * window, and 0x0 causes problems under X.
+ */
+
+ winItemPtr->header.x1 = x;
+ winItemPtr->header.x2 = winItemPtr->header.x1 + 1;
+ winItemPtr->header.y1 = y;
+ winItemPtr->header.y2 = winItemPtr->header.y1 + 1;
+ return;
+ }
+
+ /*
+ * Compute dimensions of window.
+ */
+
+ width = winItemPtr->width;
+ if (width <= 0) {
+ width = Tk_ReqWidth(winItemPtr->tkwin);
+ if (width <= 0) {
+ width = 1;
+ }
+ }
+ height = winItemPtr->height;
+ if (height <= 0) {
+ height = Tk_ReqHeight(winItemPtr->tkwin);
+ if (height <= 0) {
+ height = 1;
+ }
+ }
+
+ /*
+ * Compute location of window, using anchor information.
+ */
+
+ switch (winItemPtr->anchor) {
+ case TK_ANCHOR_N:
+ x -= width/2;
+ break;
+ case TK_ANCHOR_NE:
+ x -= width;
+ break;
+ case TK_ANCHOR_E:
+ x -= width;
+ y -= height/2;
+ break;
+ case TK_ANCHOR_SE:
+ x -= width;
+ y -= height;
+ break;
+ case TK_ANCHOR_S:
+ x -= width/2;
+ y -= height;
+ break;
+ case TK_ANCHOR_SW:
+ y -= height;
+ break;
+ case TK_ANCHOR_W:
+ y -= height/2;
+ break;
+ case TK_ANCHOR_NW:
+ break;
+ case TK_ANCHOR_CENTER:
+ x -= width/2;
+ y -= height/2;
+ break;
+ }
+
+ /*
+ * Store the information in the item header.
+ */
+
+ winItemPtr->header.x1 = x;
+ winItemPtr->header.y1 = y;
+ winItemPtr->header.x2 = x + width;
+ winItemPtr->header.y2 = y + height;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * DisplayWinItem --
+ *
+ * This function is invoked to "draw" a window item in a given drawable.
+ * Since the window draws itself, we needn't do any actual redisplay
+ * here. However, this function takes care of actually repositioning the
+ * child window so that it occupies the correct screen position.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The child window's position may get changed. Note: this function gets
+ * called both when a window needs to be displayed and when it ceases to
+ * be visible on the screen (e.g. it was scrolled or moved off-screen or
+ * the enclosing canvas is unmapped).
+ *
+ *--------------------------------------------------------------
+ */
+
+static void
+DisplayWinItem(
+ Tk_Canvas canvas, /* Canvas that contains item. */
+ Tk_Item *itemPtr, /* Item to be displayed. */
+ Display *display, /* Display on which to draw item. */
+ Drawable drawable, /* Pixmap or window in which to draw item. */
+ int regionX, int regionY, int regionWidth, int regionHeight)
+ /* Describes region of canvas that must be
+ * redisplayed (not used). */
+{
+ WindowItem *winItemPtr = (WindowItem *) itemPtr;
+ int width, height;
+ short x, y;
+ Tk_Window canvasTkwin = Tk_CanvasTkwin(canvas);
+ Tk_State state = itemPtr->state;
+
+ if (winItemPtr->tkwin == NULL) {
+ return;
+ }
+ if (state == TK_STATE_NULL) {
+ state = Canvas(canvas)->canvas_state;
+ }
+
+ /*
+ * A drawable of None is used by the canvas UnmapNotify handler
+ * to indicate that we should no longer display ourselves.
+ */
+ if (state == TK_STATE_HIDDEN || drawable == None) {
+ if (canvasTkwin == Tk_Parent(winItemPtr->tkwin)) {
+ Tk_UnmapWindow(winItemPtr->tkwin);
+ } else {
+ Tk_UnmaintainGeometry(winItemPtr->tkwin, canvasTkwin);
+ }
+ return;
+ }
+ Tk_CanvasWindowCoords(canvas, (double) winItemPtr->header.x1,
+ (double) winItemPtr->header.y1, &x, &y);
+ width = winItemPtr->header.x2 - winItemPtr->header.x1;
+ height = winItemPtr->header.y2 - winItemPtr->header.y1;
+
+ /*
+ * If the window is completely out of the visible area of the canvas then
+ * unmap it. This code used not to be present (why unmap the window if it
+ * isn't visible anyway?) but this could cause the window to suddenly
+ * reappear if the canvas window got resized.
+ */
+
+ if (((x + width) <= 0) || ((y + height) <= 0)
+ || (x >= Tk_Width(canvasTkwin)) || (y >= Tk_Height(canvasTkwin))) {
+ if (canvasTkwin == Tk_Parent(winItemPtr->tkwin)) {
+ Tk_UnmapWindow(winItemPtr->tkwin);
+ } else {
+ Tk_UnmaintainGeometry(winItemPtr->tkwin, canvasTkwin);
+ }
+ return;
+ }
+
+ /*
+ * Reposition and map the window (but in different ways depending on
+ * whether the canvas is the window's parent).
+ */
+
+ if (canvasTkwin == Tk_Parent(winItemPtr->tkwin)) {
+ if ((x != Tk_X(winItemPtr->tkwin)) || (y != Tk_Y(winItemPtr->tkwin))
+ || (width != Tk_Width(winItemPtr->tkwin))
+ || (height != Tk_Height(winItemPtr->tkwin))) {
+ Tk_MoveResizeWindow(winItemPtr->tkwin, x, y, width, height);
+ }
+ Tk_MapWindow(winItemPtr->tkwin);
+ } else {
+ Tk_MaintainGeometry(winItemPtr->tkwin, canvasTkwin, x, y,
+ width, height);
+ }
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * WinItemToPoint --
+ *
+ * Computes the distance from a given point to a given window, in canvas
+ * units.
+ *
+ * Results:
+ * The return value is 0 if the point whose x and y coordinates are
+ * coordPtr[0] and coordPtr[1] is inside the window. If the point isn't
+ * inside the window then the return value is the distance from the point
+ * to the window.
+ *
+ * Side effects:
+ * None.
+ *
+ *--------------------------------------------------------------
+ */
+
+static double
+WinItemToPoint(
+ Tk_Canvas canvas, /* Canvas containing item. */
+ Tk_Item *itemPtr, /* Item to check against point. */
+ double *pointPtr) /* Pointer to x and y coordinates. */
+{
+ WindowItem *winItemPtr = (WindowItem *) itemPtr;
+ double x1, x2, y1, y2, xDiff, yDiff;
+
+ x1 = winItemPtr->header.x1;
+ y1 = winItemPtr->header.y1;
+ x2 = winItemPtr->header.x2;
+ y2 = winItemPtr->header.y2;
+
+ /*
+ * Point is outside window.
+ */
+
+ if (pointPtr[0] < x1) {
+ xDiff = x1 - pointPtr[0];
+ } else if (pointPtr[0] >= x2) {
+ xDiff = pointPtr[0] + 1 - x2;
+ } else {
+ xDiff = 0;
+ }
+
+ if (pointPtr[1] < y1) {
+ yDiff = y1 - pointPtr[1];
+ } else if (pointPtr[1] >= y2) {
+ yDiff = pointPtr[1] + 1 - y2;
+ } else {
+ yDiff = 0;
+ }
+
+ return hypot(xDiff, yDiff);
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * WinItemToArea --
+ *
+ * This function is called to determine whether an item lies entirely
+ * inside, entirely outside, or overlapping a given rectangle.
+ *
+ * Results:
+ * -1 is returned if the item is entirely outside the area given by
+ * rectPtr, 0 if it overlaps, and 1 if it is entirely inside the given
+ * area.
+ *
+ * Side effects:
+ * None.
+ *
+ *--------------------------------------------------------------
+ */
+
+static int
+WinItemToArea(
+ Tk_Canvas canvas, /* Canvas containing item. */
+ Tk_Item *itemPtr, /* Item to check against rectangle. */
+ double *rectPtr) /* Pointer to array of four coordinates
+ * (x1,y1,x2,y2) describing rectangular
+ * area. */
+{
+ WindowItem *winItemPtr = (WindowItem *) itemPtr;
+
+ if ((rectPtr[2] <= winItemPtr->header.x1)
+ || (rectPtr[0] >= winItemPtr->header.x2)
+ || (rectPtr[3] <= winItemPtr->header.y1)
+ || (rectPtr[1] >= winItemPtr->header.y2)) {
+ return -1;
+ }
+ if ((rectPtr[0] <= winItemPtr->header.x1)
+ && (rectPtr[1] <= winItemPtr->header.y1)
+ && (rectPtr[2] >= winItemPtr->header.x2)
+ && (rectPtr[3] >= winItemPtr->header.y2)) {
+ return 1;
+ }
+ return 0;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * xerrorhandler --
+ *
+ * This is a dummy function to catch X11 errors during an attempt to
+ * print a canvas window.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * None.
+ *
+ *--------------------------------------------------------------
+ */
+
+#ifdef X_GetImage
+static int
+xerrorhandler(
+ ClientData clientData,
+ XErrorEvent *e)
+{
+ return 0;
+}
+#endif /* X_GetImage */
+
+/*
+ *--------------------------------------------------------------
+ *
+ * WinItemToPostscript --
+ *
+ * This function 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(
+ 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(
+ 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, double y, /* origin of window. */
+ int width, int height) /* width/height of window. */
+{
+ XImage *ximage;
+ int result;
+#ifdef X_GetImage
+ Tk_ErrorHandler handle;
+#endif
+ Tcl_Obj *cmdObj, *psObj;
+ Tcl_InterpState interpState = Tcl_SaveInterpState(interp, TCL_OK);
+
+ /*
+ * Locate the subwindow within the wider window.
+ */
+
+ psObj = Tcl_ObjPrintf(
+ "\n%%%% %s item (%s, %d x %d)\n" /* Comment */
+ "%.15g %.15g translate\n", /* Position */
+ Tk_Class(tkwin), Tk_PathName(tkwin), width, height, x, y);
+
+ /*
+ * 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_ResetResult(interp);
+ cmdObj = Tcl_ObjPrintf("%s postscript -prolog 0", Tk_PathName(tkwin));
+ Tcl_IncrRefCount(cmdObj);
+ result = Tcl_EvalObjEx(interp, cmdObj, 0);
+ Tcl_DecrRefCount(cmdObj);
+
+ if (result == TCL_OK) {
+ Tcl_AppendPrintfToObj(psObj,
+ "50 dict begin\nsave\ngsave\n"
+ "0 %d moveto %d 0 rlineto 0 -%d rlineto -%d 0 rlineto closepath\n"
+ "1.000 1.000 1.000 setrgbcolor AdjustColor\nfill\ngrestore\n",
+ height, width, height, width);
+ Tcl_AppendObjToObj(psObj, Tcl_GetObjResult(interp));
+ Tcl_AppendToObj(psObj, "\nrestore\nend\n\n\n", -1);
+ goto done;
+ }
+
+ /*
+ * If the window is off the screen it will generate a BadMatch/XError. We
+ * catch any BadMatch errors here
+ */
+
+#ifdef X_GetImage
+ handle = Tk_CreateErrorHandler(Tk_Display(tkwin), BadMatch,
+ X_GetImage, -1, xerrorhandler, 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) width, (unsigned) height, AllPlanes, ZPixmap);
+
+#ifdef X_GetImage
+ Tk_DeleteErrorHandler(handle);
+#endif
+
+ if (ximage == NULL) {
+ result = TCL_OK;
+ } else {
+ Tcl_ResetResult(interp);
+ result = TkPostscriptImage(interp, tkwin, Canvas(canvas)->psInfo,
+ ximage, 0, 0, width, height);
+ Tcl_AppendObjToObj(psObj, Tcl_GetObjResult(interp));
+ XDestroyImage(ximage);
+ }
+
+ /*
+ * Plug the accumulated postscript back into the result.
+ */
+
+ done:
+ if (result == TCL_OK) {
+ (void) Tcl_RestoreInterpState(interp, interpState);
+ Tcl_AppendObjToObj(Tcl_GetObjResult(interp), psObj);
+ } else {
+ Tcl_DiscardInterpState(interpState);
+ }
+ Tcl_DecrRefCount(psObj);
+ return result;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * ScaleWinItem --
+ *
+ * This function is invoked to rescale a window item.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The window referred to by itemPtr is rescaled so that the following
+ * transformation is applied to all point coordinates:
+ * x' = originX + scaleX*(x-originX)
+ * y' = originY + scaleY*(y-originY)
+ *
+ *--------------------------------------------------------------
+ */
+
+static void
+ScaleWinItem(
+ Tk_Canvas canvas, /* Canvas containing window. */
+ Tk_Item *itemPtr, /* Window to be scaled. */
+ double originX, double originY,
+ /* Origin about which to scale window. */
+ double scaleX, /* Amount to scale in X direction. */
+ double scaleY) /* Amount to scale in Y direction. */
+{
+ WindowItem *winItemPtr = (WindowItem *) itemPtr;
+
+ winItemPtr->x = originX + scaleX*(winItemPtr->x - originX);
+ winItemPtr->y = originY + scaleY*(winItemPtr->y - originY);
+ if (winItemPtr->width > 0) {
+ winItemPtr->width = (int) (scaleX*winItemPtr->width);
+ }
+ if (winItemPtr->height > 0) {
+ winItemPtr->height = (int) (scaleY*winItemPtr->height);
+ }
+ ComputeWindowBbox(canvas, winItemPtr);
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * TranslateWinItem --
+ *
+ * This function is called to move a window by a given amount.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The position of the window is offset by (xDelta, yDelta), and the
+ * bounding box is updated in the generic part of the item structure.
+ *
+ *--------------------------------------------------------------
+ */
+
+static void
+TranslateWinItem(
+ Tk_Canvas canvas, /* Canvas containing item. */
+ Tk_Item *itemPtr, /* Item that is being moved. */
+ double deltaX, double deltaY)
+ /* Amount by which item is to be moved. */
+{
+ WindowItem *winItemPtr = (WindowItem *) itemPtr;
+
+ winItemPtr->x += deltaX;
+ winItemPtr->y += deltaY;
+ ComputeWindowBbox(canvas, winItemPtr);
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * WinItemStructureProc --
+ *
+ * This function is invoked whenever StructureNotify events occur for a
+ * window that's managed as part of a canvas window item. This function's
+ * only purpose is to clean up when windows are deleted.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The window is disassociated from the window item when it is deleted.
+ *
+ *--------------------------------------------------------------
+ */
+
+static void
+WinItemStructureProc(
+ ClientData clientData, /* Pointer to record describing window item. */
+ XEvent *eventPtr) /* Describes what just happened. */
+{
+ WindowItem *winItemPtr = clientData;
+
+ if (eventPtr->type == DestroyNotify) {
+ winItemPtr->tkwin = NULL;
+ }
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * WinItemRequestProc --
+ *
+ * This function is invoked whenever a window that's associated with a
+ * window canvas item changes its requested dimensions.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The size and location on the screen of the window may change,
+ * depending on the options specified for the window item.
+ *
+ *--------------------------------------------------------------
+ */
+
+static void
+WinItemRequestProc(
+ ClientData clientData, /* Pointer to record for window item. */
+ Tk_Window tkwin) /* Window that changed its desired size. */
+{
+ WindowItem *winItemPtr = clientData;
+
+ ComputeWindowBbox(winItemPtr->canvas, winItemPtr);
+
+ /*
+ * A drawable argument of None to DisplayWinItem is used by the canvas
+ * UnmapNotify handler to indicate that we should no longer display
+ * ourselves, so need to pass a (bogus) non-zero drawable value here.
+ */
+ DisplayWinItem(winItemPtr->canvas, (Tk_Item *) winItemPtr, NULL,
+ (Drawable) -1, 0, 0, 0, 0);
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * WinItemLostSlaveProc --
+ *
+ * This function is invoked by Tk whenever some other geometry claims
+ * control over a slave that used to be managed by us.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Forgets all canvas-related information about the slave.
+ *
+ *--------------------------------------------------------------
+ */
+
+ /* ARGSUSED */
+static void
+WinItemLostSlaveProc(
+ ClientData clientData, /* WindowItem structure for slave window that
+ * was stolen away. */
+ Tk_Window tkwin) /* Tk's handle for the slave window. */
+{
+ WindowItem *winItemPtr = clientData;
+ Tk_Window canvasTkwin = Tk_CanvasTkwin(winItemPtr->canvas);
+
+ Tk_DeleteEventHandler(winItemPtr->tkwin, StructureNotifyMask,
+ WinItemStructureProc, winItemPtr);
+ if (canvasTkwin != Tk_Parent(winItemPtr->tkwin)) {
+ Tk_UnmaintainGeometry(winItemPtr->tkwin, canvasTkwin);
+ }
+ Tk_UnmapWindow(winItemPtr->tkwin);
+ winItemPtr->tkwin = NULL;
+}
+
+/*
+ * Local Variables:
+ * mode: c
+ * c-basic-offset: 4
+ * fill-column: 78
+ * End:
+ */
diff --git a/tk8.6/generic/tkCanvas.c b/tk8.6/generic/tkCanvas.c
new file mode 100644
index 0000000..9c4d60a
--- /dev/null
+++ b/tk8.6/generic/tkCanvas.c
@@ -0,0 +1,5979 @@
+/*
+ * tkCanvas.c --
+ *
+ * This module implements canvas widgets for the Tk toolkit. A canvas
+ * displays a background and a collection of graphical objects such as
+ * rectangles, lines, and texts.
+ *
+ * Copyright (c) 1991-1994 The Regents of the University of California.
+ * Copyright (c) 1994-1997 Sun Microsystems, Inc.
+ * Copyright (c) 1998-1999 by Scriptics Corporation.
+ *
+ * See the file "license.terms" for information on usage and redistribution of
+ * this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ */
+
+/* #define USE_OLD_TAG_SEARCH 1 */
+
+#include "default.h"
+#include "tkInt.h"
+#include "tkCanvas.h"
+#ifdef TK_NO_DOUBLE_BUFFERING
+#ifdef MAC_OSX_TK
+#include "tkMacOSXInt.h"
+#endif
+#endif /* TK_NO_DOUBLE_BUFFERING */
+
+/*
+ * See tkCanvas.h for key data structures used to implement canvases.
+ */
+
+#ifdef USE_OLD_TAG_SEARCH
+/*
+ * The structure defined below is used to keep track of a tag search in
+ * progress. No field should be accessed by anyone other than StartTagSearch
+ * and NextItem.
+ */
+
+typedef struct TagSearch {
+ TkCanvas *canvasPtr; /* Canvas widget being searched. */
+ Tk_Uid tag; /* Tag to search for. 0 means return all
+ * items. */
+ Tk_Item *currentPtr; /* Pointer to last item returned. */
+ Tk_Item *lastPtr; /* The item right before the currentPtr is
+ * tracked so if the currentPtr is deleted we
+ * don't have to start from the beginning. */
+ int searchOver; /* Non-zero means NextItem should always
+ * return NULL. */
+} TagSearch;
+
+#else /* USE_OLD_TAG_SEARCH */
+/*
+ * The structure defined below is used to keep track of a tag search in
+ * progress. No field should be accessed by anyone other than TagSearchScan,
+ * TagSearchFirst, TagSearchNext, TagSearchScanExpr, TagSearchEvalExpr,
+ * TagSearchExprInit, TagSearchExprDestroy, TagSearchDestroy.
+ * (
+ * Not quite accurate: the TagSearch structure is also accessed from:
+ * CanvasWidgetCmd, FindItems, RelinkItems
+ * The only instances of the structure are owned by:
+ * CanvasWidgetCmd
+ * CanvasWidgetCmd is the only function that calls:
+ * FindItems, RelinkItems
+ * CanvasWidgetCmd, FindItems, RelinkItems, are the only functions that call
+ * TagSearch*
+ * )
+ */
+
+typedef struct TagSearch {
+ TkCanvas *canvasPtr; /* Canvas widget being searched. */
+ Tk_Item *currentPtr; /* Pointer to last item returned. */
+ Tk_Item *lastPtr; /* The item right before the currentPtr is
+ * tracked so if the currentPtr is deleted we
+ * don't have to start from the beginning. */
+ int searchOver; /* Non-zero means NextItem should always
+ * return NULL. */
+ int type; /* Search type (see #defs below) */
+ int id; /* Item id for searches by id */
+ const 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;
+
+/*
+ * Values for the TagSearch type field.
+ */
+
+#define SEARCH_TYPE_EMPTY 0 /* Looking for empty tag */
+#define SEARCH_TYPE_ID 1 /* Looking for an item by id */
+#define SEARCH_TYPE_ALL 2 /* Looking for all items */
+#define SEARCH_TYPE_TAG 3 /* Looking for an item by simple tag */
+#define SEARCH_TYPE_EXPR 4 /* Compound search */
+
+#endif /* USE_OLD_TAG_SEARCH */
+
+/*
+ * Custom option for handling "-state" and "-offset"
+ */
+
+static const Tk_CustomOption stateOption = {
+ TkStateParseProc, TkStatePrintProc,
+ NULL /* Only "normal" and "disabled". */
+};
+
+static const Tk_CustomOption offsetOption = {
+ TkOffsetParseProc, TkOffsetPrintProc, INT2PTR(TK_OFFSET_RELATIVE)
+};
+
+/*
+ * Information used for argv parsing.
+ */
+
+static const Tk_ConfigSpec configSpecs[] = {
+ {TK_CONFIG_BORDER, "-background", "background", "Background",
+ DEF_CANVAS_BG_COLOR, Tk_Offset(TkCanvas, bgBorder),
+ TK_CONFIG_COLOR_ONLY, NULL},
+ {TK_CONFIG_BORDER, "-background", "background", "Background",
+ DEF_CANVAS_BG_MONO, Tk_Offset(TkCanvas, bgBorder),
+ TK_CONFIG_MONO_ONLY, NULL},
+ {TK_CONFIG_SYNONYM, "-bd", "borderWidth", NULL, NULL, 0, 0, NULL},
+ {TK_CONFIG_SYNONYM, "-bg", "background", NULL, NULL, 0, 0, NULL},
+ {TK_CONFIG_PIXELS, "-borderwidth", "borderWidth", "BorderWidth",
+ DEF_CANVAS_BORDER_WIDTH, Tk_Offset(TkCanvas, borderWidth), 0, NULL},
+ {TK_CONFIG_DOUBLE, "-closeenough", "closeEnough", "CloseEnough",
+ DEF_CANVAS_CLOSE_ENOUGH, Tk_Offset(TkCanvas, closeEnough), 0, NULL},
+ {TK_CONFIG_BOOLEAN, "-confine", "confine", "Confine",
+ DEF_CANVAS_CONFINE, Tk_Offset(TkCanvas, confine), 0, NULL},
+ {TK_CONFIG_ACTIVE_CURSOR, "-cursor", "cursor", "Cursor",
+ DEF_CANVAS_CURSOR, Tk_Offset(TkCanvas, cursor), TK_CONFIG_NULL_OK, NULL},
+ {TK_CONFIG_PIXELS, "-height", "height", "Height",
+ DEF_CANVAS_HEIGHT, Tk_Offset(TkCanvas, height), 0, NULL},
+ {TK_CONFIG_COLOR, "-highlightbackground", "highlightBackground",
+ "HighlightBackground", DEF_CANVAS_HIGHLIGHT_BG,
+ Tk_Offset(TkCanvas, highlightBgColorPtr), 0, NULL},
+ {TK_CONFIG_COLOR, "-highlightcolor", "highlightColor", "HighlightColor",
+ DEF_CANVAS_HIGHLIGHT, Tk_Offset(TkCanvas, highlightColorPtr), 0, NULL},
+ {TK_CONFIG_PIXELS, "-highlightthickness", "highlightThickness",
+ "HighlightThickness",
+ DEF_CANVAS_HIGHLIGHT_WIDTH, Tk_Offset(TkCanvas, highlightWidth), 0, NULL},
+ {TK_CONFIG_BORDER, "-insertbackground", "insertBackground", "Foreground",
+ DEF_CANVAS_INSERT_BG, Tk_Offset(TkCanvas, textInfo.insertBorder), 0, NULL},
+ {TK_CONFIG_PIXELS, "-insertborderwidth", "insertBorderWidth", "BorderWidth",
+ DEF_CANVAS_INSERT_BD_COLOR,
+ Tk_Offset(TkCanvas, textInfo.insertBorderWidth), TK_CONFIG_COLOR_ONLY, NULL},
+ {TK_CONFIG_PIXELS, "-insertborderwidth", "insertBorderWidth", "BorderWidth",
+ DEF_CANVAS_INSERT_BD_MONO,
+ Tk_Offset(TkCanvas, textInfo.insertBorderWidth), TK_CONFIG_MONO_ONLY, NULL},
+ {TK_CONFIG_INT, "-insertofftime", "insertOffTime", "OffTime",
+ DEF_CANVAS_INSERT_OFF_TIME, Tk_Offset(TkCanvas, insertOffTime), 0, NULL},
+ {TK_CONFIG_INT, "-insertontime", "insertOnTime", "OnTime",
+ DEF_CANVAS_INSERT_ON_TIME, Tk_Offset(TkCanvas, insertOnTime), 0, NULL},
+ {TK_CONFIG_PIXELS, "-insertwidth", "insertWidth", "InsertWidth",
+ DEF_CANVAS_INSERT_WIDTH, Tk_Offset(TkCanvas, textInfo.insertWidth), 0, NULL},
+ {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, NULL},
+ {TK_CONFIG_STRING, "-scrollregion", "scrollRegion", "ScrollRegion",
+ DEF_CANVAS_SCROLL_REGION, Tk_Offset(TkCanvas, regionString),
+ TK_CONFIG_NULL_OK, NULL},
+ {TK_CONFIG_BORDER, "-selectbackground", "selectBackground", "Foreground",
+ DEF_CANVAS_SELECT_COLOR, Tk_Offset(TkCanvas, textInfo.selBorder),
+ TK_CONFIG_COLOR_ONLY, NULL},
+ {TK_CONFIG_BORDER, "-selectbackground", "selectBackground", "Foreground",
+ DEF_CANVAS_SELECT_MONO, Tk_Offset(TkCanvas, textInfo.selBorder),
+ TK_CONFIG_MONO_ONLY, NULL},
+ {TK_CONFIG_PIXELS, "-selectborderwidth", "selectBorderWidth", "BorderWidth",
+ DEF_CANVAS_SELECT_BD_COLOR,
+ Tk_Offset(TkCanvas, textInfo.selBorderWidth), TK_CONFIG_COLOR_ONLY, NULL},
+ {TK_CONFIG_PIXELS, "-selectborderwidth", "selectBorderWidth", "BorderWidth",
+ DEF_CANVAS_SELECT_BD_MONO, Tk_Offset(TkCanvas, textInfo.selBorderWidth),
+ TK_CONFIG_MONO_ONLY, NULL},
+ {TK_CONFIG_COLOR, "-selectforeground", "selectForeground", "Background",
+ DEF_CANVAS_SELECT_FG_COLOR, Tk_Offset(TkCanvas, textInfo.selFgColorPtr),
+ TK_CONFIG_COLOR_ONLY|TK_CONFIG_NULL_OK, NULL},
+ {TK_CONFIG_COLOR, "-selectforeground", "selectForeground", "Background",
+ DEF_CANVAS_SELECT_FG_MONO, Tk_Offset(TkCanvas, textInfo.selFgColorPtr),
+ TK_CONFIG_MONO_ONLY|TK_CONFIG_NULL_OK, NULL},
+ {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, NULL},
+ {TK_CONFIG_PIXELS, "-width", "width", "Width",
+ DEF_CANVAS_WIDTH, Tk_Offset(TkCanvas, width), 0, NULL},
+ {TK_CONFIG_STRING, "-xscrollcommand", "xScrollCommand", "ScrollCommand",
+ DEF_CANVAS_X_SCROLL_CMD, Tk_Offset(TkCanvas, xScrollCmd),
+ TK_CONFIG_NULL_OK, NULL},
+ {TK_CONFIG_PIXELS, "-xscrollincrement", "xScrollIncrement",
+ "ScrollIncrement",
+ DEF_CANVAS_X_SCROLL_INCREMENT, Tk_Offset(TkCanvas, xScrollIncrement),
+ 0, NULL},
+ {TK_CONFIG_STRING, "-yscrollcommand", "yScrollCommand", "ScrollCommand",
+ DEF_CANVAS_Y_SCROLL_CMD, Tk_Offset(TkCanvas, yScrollCmd),
+ TK_CONFIG_NULL_OK, NULL},
+ {TK_CONFIG_PIXELS, "-yscrollincrement", "yScrollIncrement",
+ "ScrollIncrement",
+ DEF_CANVAS_Y_SCROLL_INCREMENT, Tk_Offset(TkCanvas, yScrollIncrement),
+ 0, NULL},
+ {TK_CONFIG_END, NULL, NULL, NULL, NULL, 0, 0, NULL}
+};
+
+/*
+ * List of all the item types known at present. This is *global* and is
+ * protected by typeListMutex.
+ */
+
+static Tk_ItemType *typeList = NULL;
+ /* NULL means initialization hasn't been done
+ * yet. */
+TCL_DECLARE_MUTEX(typeListMutex)
+
+#ifndef USE_OLD_TAG_SEARCH
+/*
+ * Uids for operands in compiled advanced tag search expressions.
+ * Initialization is done by GetStaticUids()
+ */
+
+typedef struct {
+ Tk_Uid allUid;
+ Tk_Uid currentUid;
+ Tk_Uid andUid;
+ Tk_Uid orUid;
+ Tk_Uid xorUid;
+ Tk_Uid parenUid;
+ Tk_Uid negparenUid;
+ Tk_Uid endparenUid;
+ Tk_Uid tagvalUid;
+ Tk_Uid negtagvalUid;
+} SearchUids;
+
+static Tcl_ThreadDataKey dataKey;
+static SearchUids * GetStaticUids(void);
+#endif /* USE_OLD_TAG_SEARCH */
+
+/*
+ * Prototypes for functions defined later in this file:
+ */
+
+static void CanvasBindProc(ClientData clientData,
+ XEvent *eventPtr);
+static void CanvasBlinkProc(ClientData clientData);
+static void CanvasCmdDeletedProc(ClientData clientData);
+static void CanvasDoEvent(TkCanvas *canvasPtr, XEvent *eventPtr);
+static void CanvasEventProc(ClientData clientData,
+ XEvent *eventPtr);
+static int CanvasFetchSelection(ClientData clientData, int offset,
+ char *buffer, int maxBytes);
+static Tk_Item * CanvasFindClosest(TkCanvas *canvasPtr,
+ double coords[2]);
+static void CanvasFocusProc(TkCanvas *canvasPtr, int gotFocus);
+static void CanvasLostSelection(ClientData clientData);
+static void CanvasSelectTo(TkCanvas *canvasPtr,
+ Tk_Item *itemPtr, int index);
+static void CanvasSetOrigin(TkCanvas *canvasPtr,
+ int xOrigin, int yOrigin);
+static void CanvasUpdateScrollbars(TkCanvas *canvasPtr);
+static int CanvasWidgetCmd(ClientData clientData,
+ Tcl_Interp *interp, int argc,
+ Tcl_Obj *const *argv);
+static void CanvasWorldChanged(ClientData instanceData);
+static int ConfigureCanvas(Tcl_Interp *interp,
+ TkCanvas *canvasPtr, int argc,
+ Tcl_Obj *const *argv, int flags);
+static void DestroyCanvas(char *memPtr);
+static void DisplayCanvas(ClientData clientData);
+static void DoItem(Tcl_Obj *accumObj,
+ Tk_Item *itemPtr, Tk_Uid tag);
+static void EventuallyRedrawItem(TkCanvas *canvasPtr,
+ Tk_Item *itemPtr);
+#ifdef USE_OLD_TAG_SEARCH
+static int FindItems(Tcl_Interp *interp, TkCanvas *canvasPtr,
+ int argc, Tcl_Obj *const *argv,
+ Tcl_Obj *newTagObj, int first);
+#else /* USE_OLD_TAG_SEARCH */
+static int FindItems(Tcl_Interp *interp, TkCanvas *canvasPtr,
+ int argc, Tcl_Obj *const *argv,
+ Tcl_Obj *newTagObj, int first,
+ TagSearch **searchPtrPtr);
+#endif /* USE_OLD_TAG_SEARCH */
+static int FindArea(Tcl_Interp *interp, TkCanvas *canvasPtr,
+ Tcl_Obj *const *argv, Tk_Uid uid, int enclosed);
+static double GridAlign(double coord, double spacing);
+static const char** TkGetStringsFromObjs(int argc, Tcl_Obj *const *objv);
+static void InitCanvas(void);
+#ifdef USE_OLD_TAG_SEARCH
+static Tk_Item * NextItem(TagSearch *searchPtr);
+#endif /* USE_OLD_TAG_SEARCH */
+static void PickCurrentItem(TkCanvas *canvasPtr, XEvent *eventPtr);
+static Tcl_Obj * ScrollFractions(int screen1,
+ int screen2, int object1, int object2);
+#ifdef USE_OLD_TAG_SEARCH
+static void RelinkItems(TkCanvas *canvasPtr,
+ Tcl_Obj *tag, Tk_Item *prevPtr);
+static Tk_Item * StartTagSearch(TkCanvas *canvasPtr,
+ Tcl_Obj *tag, TagSearch *searchPtr);
+#else /* USE_OLD_TAG_SEARCH */
+static int RelinkItems(TkCanvas *canvasPtr, Tcl_Obj *tag,
+ Tk_Item *prevPtr, TagSearch **searchPtrPtr);
+static void TagSearchExprInit(TagSearchExpr **exprPtrPtr);
+static void TagSearchExprDestroy(TagSearchExpr *expr);
+static void TagSearchDestroy(TagSearch *searchPtr);
+static int TagSearchScan(TkCanvas *canvasPtr,
+ Tcl_Obj *tag, TagSearch **searchPtrPtr);
+static int TagSearchScanExpr(Tcl_Interp *interp,
+ TagSearch *searchPtr, TagSearchExpr *expr);
+static int TagSearchEvalExpr(TagSearchExpr *expr,
+ Tk_Item *itemPtr);
+static Tk_Item * TagSearchFirst(TagSearch *searchPtr);
+static Tk_Item * TagSearchNext(TagSearch *searchPtr);
+#endif /* USE_OLD_TAG_SEARCH */
+
+/*
+ * The structure below defines canvas class behavior by means of functions
+ * that can be invoked from generic window code.
+ */
+
+static const Tk_ClassProcs canvasClass = {
+ sizeof(Tk_ClassProcs), /* size */
+ CanvasWorldChanged, /* worldChangedProc */
+ NULL, /* createProc */
+ NULL /* modalProc */
+};
+
+/*
+ * Macros that significantly simplify all code that finds items.
+ */
+
+#ifdef USE_OLD_TAG_SEARCH
+#define FIRST_CANVAS_ITEM_MATCHING(objPtr,searchPtrPtr,errorExitClause) \
+ itemPtr = StartTagSearch(canvasPtr,(objPtr),&search)
+#define FOR_EVERY_CANVAS_ITEM_MATCHING(objPtr,searchPtrPtr,errorExitClause) \
+ for (itemPtr = StartTagSearch(canvasPtr, (objPtr), &search); \
+ itemPtr != NULL; itemPtr = NextItem(&search))
+#define FIND_ITEMS(objPtr, n) \
+ FindItems(interp, canvasPtr, objc, objv, (objPtr), (n))
+#define RELINK_ITEMS(objPtr, itemPtr) \
+ RelinkItems(canvasPtr, (objPtr), (itemPtr))
+#else /* USE_OLD_TAG_SEARCH */
+#define FIRST_CANVAS_ITEM_MATCHING(objPtr,searchPtrPtr,errorExitClause) \
+ if ((result=TagSearchScan(canvasPtr,(objPtr),(searchPtrPtr))) != TCL_OK){ \
+ errorExitClause; \
+ } \
+ itemPtr = TagSearchFirst(*(searchPtrPtr));
+#define FOR_EVERY_CANVAS_ITEM_MATCHING(objPtr,searchPtrPtr,errorExitClause) \
+ if ((result=TagSearchScan(canvasPtr,(objPtr),(searchPtrPtr))) != TCL_OK){ \
+ errorExitClause; \
+ } \
+ for (itemPtr = TagSearchFirst(*(searchPtrPtr)); \
+ itemPtr != NULL; itemPtr = TagSearchNext(*(searchPtrPtr)))
+#define FIND_ITEMS(objPtr, n) \
+ FindItems(interp, canvasPtr, objc, objv, (objPtr), (n), &searchPtr)
+#define RELINK_ITEMS(objPtr, itemPtr) \
+ result = RelinkItems(canvasPtr, (objPtr), (itemPtr), &searchPtr)
+#endif /* USE_OLD_TAG_SEARCH */
+
+/*
+ * ----------------------------------------------------------------------
+ *
+ * AlwaysRedraw, ItemConfigure, ItemCoords, etc. --
+ *
+ * Helper functions that make access to canvas item functions simpler.
+ * Note that these are all inline functions.
+ *
+ * ----------------------------------------------------------------------
+ */
+
+static inline int
+AlwaysRedraw(
+ Tk_Item *itemPtr)
+{
+ return itemPtr->typePtr->alwaysRedraw & 1;
+}
+
+static inline int
+ItemConfigure(
+ TkCanvas *canvasPtr,
+ Tk_Item *itemPtr,
+ int objc,
+ Tcl_Obj *const objv[])
+{
+ Tcl_Interp *interp = canvasPtr->interp;
+ int result;
+
+ if (itemPtr->typePtr->alwaysRedraw & TK_CONFIG_OBJS) {
+ result = itemPtr->typePtr->configProc(interp, (Tk_Canvas) canvasPtr,
+ itemPtr, objc, objv, TK_CONFIG_ARGV_ONLY);
+ } else {
+ const char **args = TkGetStringsFromObjs(objc, objv);
+
+ result = itemPtr->typePtr->configProc(interp, (Tk_Canvas) canvasPtr,
+ itemPtr, objc, (Tcl_Obj **) args, TK_CONFIG_ARGV_ONLY);
+ if (args != NULL) {
+ ckfree(args);
+ }
+ }
+ return result;
+}
+
+static inline int
+ItemConfigInfo(
+ TkCanvas *canvasPtr,
+ Tk_Item *itemPtr,
+ Tcl_Obj *fieldName)
+{
+ return Tk_ConfigureInfo(canvasPtr->interp, canvasPtr->tkwin,
+ itemPtr->typePtr->configSpecs, (char *) itemPtr,
+ (fieldName ? Tcl_GetString(fieldName) : NULL), 0);
+}
+
+static inline int
+ItemConfigValue(
+ TkCanvas *canvasPtr,
+ Tk_Item *itemPtr,
+ Tcl_Obj *fieldName)
+{
+ return Tk_ConfigureValue(canvasPtr->interp, canvasPtr->tkwin,
+ itemPtr->typePtr->configSpecs, (char *) itemPtr,
+ Tcl_GetString(fieldName), 0);
+}
+
+static inline int
+ItemCoords(
+ TkCanvas *canvasPtr,
+ Tk_Item *itemPtr,
+ int objc,
+ Tcl_Obj *const objv[])
+{
+ Tcl_Interp *interp = canvasPtr->interp;
+ int result;
+
+ if (itemPtr->typePtr->coordProc == NULL) {
+ result = TCL_OK;
+ } else if (itemPtr->typePtr->alwaysRedraw & TK_CONFIG_OBJS) {
+ result = itemPtr->typePtr->coordProc(interp, (Tk_Canvas) canvasPtr,
+ itemPtr, objc, objv);
+ } else {
+ const char **args = TkGetStringsFromObjs(objc, objv);
+
+ result = itemPtr->typePtr->coordProc(interp, (Tk_Canvas) canvasPtr,
+ itemPtr, objc, (Tcl_Obj **) args);
+ if (args != NULL) {
+ ckfree(args);
+ }
+ }
+ return result;
+}
+
+static inline int
+ItemCreate(
+ TkCanvas *canvasPtr,
+ Tk_Item *itemPtr, /* Warning: incomplete! typePtr field must be
+ * set by this point. */
+ int objc,
+ Tcl_Obj *const objv[])
+{
+ Tcl_Interp *interp = canvasPtr->interp;
+ int result;
+
+ if (itemPtr->typePtr->alwaysRedraw & TK_CONFIG_OBJS) {
+ result = itemPtr->typePtr->createProc(interp, (Tk_Canvas) canvasPtr,
+ itemPtr, objc-3, objv+3);
+ } else {
+ const char **args = TkGetStringsFromObjs(objc-3, objv+3);
+
+ result = itemPtr->typePtr->createProc(interp, (Tk_Canvas) canvasPtr,
+ itemPtr, objc-3, (Tcl_Obj **) args);
+ if (args != NULL) {
+ ckfree(args);
+ }
+ }
+ return result;
+}
+
+static inline void
+ItemCursor(
+ TkCanvas *canvasPtr,
+ Tk_Item *itemPtr,
+ int index)
+{
+ itemPtr->typePtr->icursorProc((Tk_Canvas) canvasPtr, itemPtr, index);
+}
+
+static inline void
+ItemDelChars(
+ TkCanvas *canvasPtr,
+ Tk_Item *itemPtr,
+ int first,
+ int last)
+{
+ itemPtr->typePtr->dCharsProc((Tk_Canvas) canvasPtr, itemPtr, first, last);
+}
+
+static inline void
+ItemDelete(
+ TkCanvas *canvasPtr,
+ Tk_Item *itemPtr)
+{
+ itemPtr->typePtr->deleteProc((Tk_Canvas) canvasPtr, itemPtr,
+ canvasPtr->display);
+}
+
+static inline void
+ItemDisplay(
+ TkCanvas *canvasPtr,
+ Tk_Item *itemPtr,
+ Pixmap pixmap,
+ int screenX1, int screenY1,
+ int width, int height)
+{
+ itemPtr->typePtr->displayProc((Tk_Canvas) canvasPtr, itemPtr,
+ canvasPtr->display, pixmap, screenX1, screenY1, width, height);
+}
+
+static inline int
+ItemIndex(
+ TkCanvas *canvasPtr,
+ Tk_Item *itemPtr,
+ Tcl_Obj *objPtr,
+ int *indexPtr)
+{
+ Tcl_Interp *interp = canvasPtr->interp;
+
+ if (itemPtr->typePtr->indexProc == NULL) {
+ return TCL_OK;
+ } else if (itemPtr->typePtr->alwaysRedraw & TK_CONFIG_OBJS) {
+ return itemPtr->typePtr->indexProc(interp, (Tk_Canvas) canvasPtr,
+ itemPtr, objPtr, indexPtr);
+ } else {
+ return itemPtr->typePtr->indexProc(interp, (Tk_Canvas) canvasPtr,
+ itemPtr, (Tcl_Obj *) Tcl_GetString(objPtr), indexPtr);
+ }
+}
+
+static inline void
+ItemInsert(
+ TkCanvas *canvasPtr,
+ Tk_Item *itemPtr,
+ int beforeThis,
+ Tcl_Obj *toInsert)
+{
+ if (itemPtr->typePtr->alwaysRedraw & TK_CONFIG_OBJS) {
+ itemPtr->typePtr->insertProc((Tk_Canvas) canvasPtr, itemPtr,
+ beforeThis, toInsert);
+ } else {
+ itemPtr->typePtr->insertProc((Tk_Canvas) canvasPtr, itemPtr,
+ beforeThis, (Tcl_Obj *) Tcl_GetString(toInsert));
+ }
+}
+
+static inline int
+ItemOverlap(
+ TkCanvas *canvasPtr,
+ Tk_Item *itemPtr,
+ double rect[])
+{
+ return itemPtr->typePtr->areaProc((Tk_Canvas) canvasPtr, itemPtr, rect);
+}
+
+static inline double
+ItemPoint(
+ TkCanvas *canvasPtr,
+ Tk_Item *itemPtr,
+ double coords[],
+ double halo)
+{
+ double dist;
+
+ dist = itemPtr->typePtr->pointProc((Tk_Canvas) canvasPtr, itemPtr,
+ coords) - halo;
+ return (dist < 0.0) ? 0.0 : dist;
+}
+
+static inline void
+ItemScale(
+ TkCanvas *canvasPtr,
+ Tk_Item *itemPtr,
+ double xOrigin, double yOrigin,
+ double xScale, double yScale)
+{
+ itemPtr->typePtr->scaleProc((Tk_Canvas) canvasPtr, itemPtr,
+ xOrigin, yOrigin, xScale, yScale);
+}
+
+static inline int
+ItemSelection(
+ TkCanvas *canvasPtr,
+ Tk_Item *itemPtr,
+ int offset,
+ char *buffer,
+ int maxBytes)
+{
+ if (itemPtr == NULL || itemPtr->typePtr->selectionProc == NULL) {
+ return -1;
+ }
+
+ return itemPtr->typePtr->selectionProc((Tk_Canvas) canvasPtr, itemPtr,
+ offset, buffer, maxBytes);
+}
+
+static inline void
+ItemTranslate(
+ TkCanvas *canvasPtr,
+ Tk_Item *itemPtr,
+ double xDelta,
+ double yDelta)
+{
+ itemPtr->typePtr->translateProc((Tk_Canvas) canvasPtr, itemPtr,
+ xDelta, yDelta);
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * Tk_CanvasObjCmd --
+ *
+ * This function is invoked to process the "canvas" Tcl command. See the
+ * user documentation for details on what it does.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * See the user documentation.
+ *
+ *--------------------------------------------------------------
+ */
+
+int
+Tk_CanvasObjCmd(
+ ClientData clientData, /* Main window associated with interpreter. */
+ Tcl_Interp *interp, /* Current interpreter. */
+ int argc, /* Number of arguments. */
+ Tcl_Obj *const argv[]) /* Argument objects. */
+{
+ Tk_Window tkwin = clientData;
+ TkCanvas *canvasPtr;
+ Tk_Window newWin;
+
+ if (typeList == NULL) {
+ InitCanvas();
+ }
+
+ if (argc < 2) {
+ Tcl_WrongNumArgs(interp, 1, argv, "pathName ?-option value ...?");
+ return TCL_ERROR;
+ }
+
+ newWin = Tk_CreateWindowFromPath(interp,tkwin,Tcl_GetString(argv[1]),NULL);
+ if (newWin == NULL) {
+ return TCL_ERROR;
+ }
+
+ /*
+ * Initialize fields that won't be initialized by ConfigureCanvas, or
+ * which ConfigureCanvas expects to have reasonable values (e.g. resource
+ * pointers).
+ */
+
+ canvasPtr = ckalloc(sizeof(TkCanvas));
+ canvasPtr->tkwin = newWin;
+ canvasPtr->display = Tk_Display(newWin);
+ canvasPtr->interp = interp;
+ canvasPtr->widgetCmd = Tcl_CreateObjCommand(interp,
+ Tk_PathName(canvasPtr->tkwin), CanvasWidgetCmd, canvasPtr,
+ CanvasCmdDeletedProc);
+ canvasPtr->firstItemPtr = NULL;
+ canvasPtr->lastItemPtr = NULL;
+ canvasPtr->borderWidth = 0;
+ canvasPtr->bgBorder = NULL;
+ canvasPtr->relief = TK_RELIEF_FLAT;
+ canvasPtr->highlightWidth = 0;
+ canvasPtr->highlightBgColorPtr = NULL;
+ canvasPtr->highlightColorPtr = NULL;
+ canvasPtr->inset = 0;
+ canvasPtr->pixmapGC = None;
+ canvasPtr->width = None;
+ canvasPtr->height = None;
+ canvasPtr->confine = 0;
+ canvasPtr->textInfo.selBorder = NULL;
+ canvasPtr->textInfo.selBorderWidth = 0;
+ canvasPtr->textInfo.selFgColorPtr = NULL;
+ canvasPtr->textInfo.selItemPtr = NULL;
+ canvasPtr->textInfo.selectFirst = -1;
+ canvasPtr->textInfo.selectLast = -1;
+ canvasPtr->textInfo.anchorItemPtr = NULL;
+ canvasPtr->textInfo.selectAnchor = 0;
+ canvasPtr->textInfo.insertBorder = NULL;
+ canvasPtr->textInfo.insertWidth = 0;
+ canvasPtr->textInfo.insertBorderWidth = 0;
+ canvasPtr->textInfo.focusItemPtr = NULL;
+ canvasPtr->textInfo.gotFocus = 0;
+ canvasPtr->textInfo.cursorOn = 0;
+ canvasPtr->insertOnTime = 0;
+ canvasPtr->insertOffTime = 0;
+ canvasPtr->insertBlinkHandler = (Tcl_TimerToken) NULL;
+ canvasPtr->xOrigin = canvasPtr->yOrigin = 0;
+ canvasPtr->drawableXOrigin = canvasPtr->drawableYOrigin = 0;
+ canvasPtr->bindingTable = NULL;
+ canvasPtr->currentItemPtr = NULL;
+ canvasPtr->newCurrentPtr = NULL;
+ canvasPtr->closeEnough = 0.0;
+ canvasPtr->pickEvent.type = LeaveNotify;
+ canvasPtr->pickEvent.xcrossing.x = 0;
+ canvasPtr->pickEvent.xcrossing.y = 0;
+ canvasPtr->state = 0;
+ canvasPtr->xScrollCmd = NULL;
+ canvasPtr->yScrollCmd = NULL;
+ canvasPtr->scrollX1 = 0;
+ canvasPtr->scrollY1 = 0;
+ canvasPtr->scrollX2 = 0;
+ canvasPtr->scrollY2 = 0;
+ canvasPtr->regionString = NULL;
+ canvasPtr->xScrollIncrement = 0;
+ canvasPtr->yScrollIncrement = 0;
+ canvasPtr->scanX = 0;
+ canvasPtr->scanXOrigin = 0;
+ canvasPtr->scanY = 0;
+ canvasPtr->scanYOrigin = 0;
+ canvasPtr->hotPtr = NULL;
+ canvasPtr->hotPrevPtr = NULL;
+ canvasPtr->cursor = None;
+ canvasPtr->takeFocus = NULL;
+ canvasPtr->pixelsPerMM = WidthOfScreen(Tk_Screen(newWin));
+ canvasPtr->pixelsPerMM /= WidthMMOfScreen(Tk_Screen(newWin));
+ canvasPtr->flags = 0;
+ canvasPtr->nextId = 1;
+ canvasPtr->psInfo = NULL;
+ canvasPtr->canvas_state = TK_STATE_NORMAL;
+ canvasPtr->tsoffset.flags = 0;
+ canvasPtr->tsoffset.xoffset = 0;
+ canvasPtr->tsoffset.yoffset = 0;
+#ifndef USE_OLD_TAG_SEARCH
+ canvasPtr->bindTagExprs = NULL;
+#endif
+ Tcl_InitHashTable(&canvasPtr->idTable, TCL_ONE_WORD_KEYS);
+
+ Tk_SetClass(canvasPtr->tkwin, "Canvas");
+ Tk_SetClassProcs(canvasPtr->tkwin, &canvasClass, canvasPtr);
+ Tk_CreateEventHandler(canvasPtr->tkwin,
+ ExposureMask|StructureNotifyMask|FocusChangeMask,
+ CanvasEventProc, canvasPtr);
+ Tk_CreateEventHandler(canvasPtr->tkwin, KeyPressMask|KeyReleaseMask
+ |ButtonPressMask|ButtonReleaseMask|EnterWindowMask
+ |LeaveWindowMask|PointerMotionMask|VirtualEventMask,
+ CanvasBindProc, canvasPtr);
+ Tk_CreateSelHandler(canvasPtr->tkwin, XA_PRIMARY, XA_STRING,
+ CanvasFetchSelection, canvasPtr, XA_STRING);
+ if (ConfigureCanvas(interp, canvasPtr, argc-2, argv+2, 0) != TCL_OK) {
+ goto error;
+ }
+
+ Tcl_SetObjResult(interp, TkNewWindowObj(canvasPtr->tkwin));
+ return TCL_OK;
+
+ error:
+ Tk_DestroyWindow(canvasPtr->tkwin);
+ return TCL_ERROR;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * CanvasWidgetCmd --
+ *
+ * This function is invoked to process the Tcl command that corresponds
+ * to a widget managed by this module. See the user documentation for
+ * details on what it does.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * See the user documentation.
+ *
+ *--------------------------------------------------------------
+ */
+
+static int
+CanvasWidgetCmd(
+ ClientData clientData, /* Information about canvas widget. */
+ Tcl_Interp *interp, /* Current interpreter. */
+ int objc, /* Number of arguments. */
+ Tcl_Obj *const objv[]) /* Argument objects. */
+{
+ TkCanvas *canvasPtr = clientData;
+ int c, result;
+ Tk_Item *itemPtr = NULL; /* Initialization needed only to prevent
+ * compiler warning. */
+#ifdef USE_OLD_TAG_SEARCH
+ TagSearch search;
+#else /* USE_OLD_TAG_SEARCH */
+ TagSearch *searchPtr = NULL;/* Allocated by first TagSearchScan, freed by
+ * TagSearchDestroy */
+#endif /* USE_OLD_TAG_SEARCH */
+
+ int index;
+ static const char *const optionStrings[] = {
+ "addtag", "bbox", "bind", "canvasx",
+ "canvasy", "cget", "configure", "coords",
+ "create", "dchars", "delete", "dtag",
+ "find", "focus", "gettags", "icursor",
+ "imove", "index", "insert", "itemcget",
+ "itemconfigure",
+ "lower", "move", "moveto", "postscript",
+ "raise", "rchars", "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_IMOVE, CANV_INDEX, CANV_INSERT, CANV_ITEMCGET,
+ CANV_ITEMCONFIGURE,
+ CANV_LOWER, CANV_MOVE, CANV_MOVETO, CANV_POSTSCRIPT,
+ CANV_RAISE, CANV_RCHARS, CANV_SCALE, CANV_SCAN,
+ CANV_SELECT, CANV_TYPE, CANV_XVIEW, CANV_YVIEW
+ };
+
+ 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;
+ }
+ Tcl_Preserve(canvasPtr);
+
+ result = TCL_OK;
+ switch ((enum options) index) {
+ case CANV_ADDTAG:
+ if (objc < 4) {
+ Tcl_WrongNumArgs(interp, 2, objv, "tag searchCommand ?arg ...?");
+ result = TCL_ERROR;
+ goto done;
+ }
+ result = FIND_ITEMS(objv[2], 3);
+ break;
+
+ case CANV_BBOX: {
+ int i, gotAny;
+ int x1 = 0, y1 = 0, x2 = 0, y2 = 0; /* Initializations needed only
+ * to prevent overcautious
+ * compiler warnings. */
+
+ if (objc < 3) {
+ Tcl_WrongNumArgs(interp, 2, objv, "tagOrId ?tagOrId ...?");
+ result = TCL_ERROR;
+ goto done;
+ }
+ gotAny = 0;
+ for (i = 2; i < objc; i++) {
+ FOR_EVERY_CANVAS_ITEM_MATCHING(objv[i], &searchPtr, goto done) {
+ if ((itemPtr->x1 >= itemPtr->x2)
+ || (itemPtr->y1 >= itemPtr->y2)) {
+ continue;
+ }
+ if (!gotAny) {
+ x1 = itemPtr->x1;
+ y1 = itemPtr->y1;
+ x2 = itemPtr->x2;
+ y2 = itemPtr->y2;
+ gotAny = 1;
+ } else {
+ if (itemPtr->x1 < x1) {
+ x1 = itemPtr->x1;
+ }
+ if (itemPtr->y1 < y1) {
+ y1 = itemPtr->y1;
+ }
+ if (itemPtr->x2 > x2) {
+ x2 = itemPtr->x2;
+ }
+ if (itemPtr->y2 > y2) {
+ y2 = itemPtr->y2;
+ }
+ }
+ }
+ }
+ if (gotAny) {
+ Tcl_Obj *resultObjs[4];
+
+ resultObjs[0] = Tcl_NewIntObj(x1);
+ resultObjs[1] = Tcl_NewIntObj(y1);
+ resultObjs[2] = Tcl_NewIntObj(x2);
+ resultObjs[3] = Tcl_NewIntObj(y2);
+ Tcl_SetObjResult(interp, Tcl_NewListObj(4, resultObjs));
+ }
+ break;
+ }
+ case CANV_BIND: {
+ ClientData object;
+
+ if ((objc < 3) || (objc > 5)) {
+ Tcl_WrongNumArgs(interp, 2, objv, "tagOrId ?sequence? ?command?");
+ result = TCL_ERROR;
+ goto done;
+ }
+
+ /*
+ * Figure out what object to use for the binding (individual item vs.
+ * tag).
+ */
+
+ object = NULL;
+#ifdef USE_OLD_TAG_SEARCH
+ if (isdigit(UCHAR(Tcl_GetString(objv[2])[0]))) {
+ int id;
+ char *end;
+ Tcl_HashEntry *entryPtr;
+
+ id = strtoul(Tcl_GetString(objv[2]), &end, 0);
+ if (*end != 0) {
+ goto bindByTag;
+ }
+ entryPtr = Tcl_FindHashEntry(&canvasPtr->idTable, (char *) id);
+ if (entryPtr != NULL) {
+ itemPtr = Tcl_GetHashValue(entryPtr);
+ object = itemPtr;
+ }
+
+ if (object == NULL) {
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "item \"%s\" doesn't exist", Tcl_GetString(objv[2])));
+ Tcl_SetErrorCode(interp, "TK", "LOOKUP", "CANVAS_ITEM",
+ Tcl_GetString(objv[2]), NULL);
+ result = TCL_ERROR;
+ goto done;
+ }
+ } else {
+ bindByTag:
+ object = Tk_GetUid(Tcl_GetString(objv[2]));
+ }
+#else /* USE_OLD_TAG_SEARCH */
+ result = TagSearchScan(canvasPtr, objv[2], &searchPtr);
+ if (result != TCL_OK) {
+ goto done;
+ }
+ if (searchPtr->type == SEARCH_TYPE_ID) {
+ Tcl_HashEntry *entryPtr;
+
+ entryPtr = Tcl_FindHashEntry(&canvasPtr->idTable,
+ (char *) INT2PTR(searchPtr->id));
+ if (entryPtr != NULL) {
+ itemPtr = Tcl_GetHashValue(entryPtr);
+ object = itemPtr;
+ }
+
+ if (object == 0) {
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "item \"%s\" doesn't exist", Tcl_GetString(objv[2])));
+ Tcl_SetErrorCode(interp, "TK", "LOOKUP", "CANVAS_ITEM",
+ Tcl_GetString(objv[2]), NULL);
+ result = TCL_ERROR;
+ goto done;
+ }
+ } else {
+ object = (ClientData) searchPtr->expr->uid;
+ }
+#endif /* USE_OLD_TAG_SEARCH */
+
+ /*
+ * Make a binding table if the canvas doesn't already have one.
+ */
+
+ if (canvasPtr->bindingTable == NULL) {
+ canvasPtr->bindingTable = Tk_CreateBindingTable(interp);
+ }
+
+ if (objc == 5) {
+ int append = 0;
+ unsigned long mask;
+ const char *argv4 = Tcl_GetString(objv[4]);
+
+ if (argv4[0] == 0) {
+ result = Tk_DeleteBinding(interp, canvasPtr->bindingTable,
+ object, Tcl_GetString(objv[3]));
+ goto done;
+ }
+#ifndef USE_OLD_TAG_SEARCH
+ if (searchPtr->type == SEARCH_TYPE_EXPR) {
+ /*
+ * If new tag expression, then insert in linked list.
+ */
+
+ TagSearchExpr *expr, **lastPtr;
+
+ lastPtr = &(canvasPtr->bindTagExprs);
+ while ((expr = *lastPtr) != NULL) {
+ if (expr->uid == searchPtr->expr->uid) {
+ break;
+ }
+ lastPtr = &(expr->next);
+ }
+ if (!expr) {
+ /*
+ * Transfer ownership of expr to bindTagExprs list.
+ */
+
+ *lastPtr = searchPtr->expr;
+ searchPtr->expr->next = NULL;
+
+ /*
+ * Flag in TagSearch that expr has changed ownership so
+ * that TagSearchDestroy doesn't try to free it.
+ */
+
+ searchPtr->expr = NULL;
+ }
+ }
+#endif /* not USE_OLD_TAG_SEARCH */
+ if (argv4[0] == '+') {
+ argv4++;
+ append = 1;
+ }
+ mask = Tk_CreateBinding(interp, canvasPtr->bindingTable,
+ object, Tcl_GetString(objv[3]), argv4, append);
+ if (mask == 0) {
+ result = TCL_ERROR;
+ goto done;
+ }
+ if (mask & (unsigned) ~(ButtonMotionMask|Button1MotionMask
+ |Button2MotionMask|Button3MotionMask|Button4MotionMask
+ |Button5MotionMask|ButtonPressMask|ButtonReleaseMask
+ |EnterWindowMask|LeaveWindowMask|KeyPressMask
+ |KeyReleaseMask|PointerMotionMask|VirtualEventMask)) {
+ Tk_DeleteBinding(interp, canvasPtr->bindingTable,
+ object, Tcl_GetString(objv[3]));
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "requested illegal events; only key, button, motion,"
+ " enter, leave, and virtual events may be used", -1));
+ Tcl_SetErrorCode(interp, "TK", "CANVAS", "BAD_EVENTS", NULL);
+ result = TCL_ERROR;
+ goto done;
+ }
+ } else if (objc == 4) {
+ const char *command;
+
+ command = Tk_GetBinding(interp, canvasPtr->bindingTable,
+ object, Tcl_GetString(objv[3]));
+ if (command == NULL) {
+ const char *string = Tcl_GetString(Tcl_GetObjResult(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;
+ }
+ Tcl_ResetResult(interp);
+ } else {
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(command, -1));
+ }
+ } else {
+ Tk_GetAllBindings(interp, canvasPtr->bindingTable, object);
+ }
+ break;
+ }
+ case CANV_CANVASX: {
+ int x;
+ double grid;
+
+ if ((objc < 3) || (objc > 4)) {
+ Tcl_WrongNumArgs(interp, 2, objv, "screenx ?gridspacing?");
+ result = TCL_ERROR;
+ goto done;
+ }
+ if (Tk_GetPixelsFromObj(interp, canvasPtr->tkwin, objv[2],
+ &x) != TCL_OK) {
+ result = TCL_ERROR;
+ goto done;
+ }
+ if (objc == 4) {
+ if (Tk_CanvasGetCoordFromObj(interp, (Tk_Canvas) canvasPtr,
+ objv[3], &grid) != TCL_OK) {
+ result = TCL_ERROR;
+ goto done;
+ }
+ } else {
+ grid = 0.0;
+ }
+ x += canvasPtr->xOrigin;
+ Tcl_SetObjResult(interp, Tcl_NewDoubleObj(GridAlign((double)x,grid)));
+ break;
+ }
+ case CANV_CANVASY: {
+ int y;
+ double grid;
+
+ if ((objc < 3) || (objc > 4)) {
+ Tcl_WrongNumArgs(interp, 2, objv, "screeny ?gridspacing?");
+ result = TCL_ERROR;
+ goto done;
+ }
+ if (Tk_GetPixelsFromObj(interp, canvasPtr->tkwin, objv[2],
+ &y) != TCL_OK) {
+ result = TCL_ERROR;
+ goto done;
+ }
+ if (objc == 4) {
+ if (Tk_CanvasGetCoordFromObj(interp, (Tk_Canvas) canvasPtr,
+ objv[3], &grid) != TCL_OK) {
+ result = TCL_ERROR;
+ goto done;
+ }
+ } else {
+ grid = 0.0;
+ }
+ y += canvasPtr->yOrigin;
+ Tcl_SetObjResult(interp, Tcl_NewDoubleObj(GridAlign((double)y,grid)));
+ break;
+ }
+ case CANV_CGET:
+ if (objc != 3) {
+ Tcl_WrongNumArgs(interp, 2, objv, "option");
+ result = TCL_ERROR;
+ goto done;
+ }
+ result = Tk_ConfigureValue(interp, canvasPtr->tkwin, configSpecs,
+ (char *) canvasPtr, Tcl_GetString(objv[2]), 0);
+ break;
+ case CANV_CONFIGURE:
+ if (objc == 2) {
+ result = Tk_ConfigureInfo(interp, canvasPtr->tkwin, configSpecs,
+ (char *) canvasPtr, NULL, 0);
+ } else if (objc == 3) {
+ result = Tk_ConfigureInfo(interp, canvasPtr->tkwin, configSpecs,
+ (char *) canvasPtr, Tcl_GetString(objv[2]), 0);
+ } else {
+ result = ConfigureCanvas(interp, canvasPtr, objc-2, objv+2,
+ TK_CONFIG_ARGV_ONLY);
+ }
+ break;
+ case CANV_COORDS:
+ if (objc < 3) {
+ Tcl_WrongNumArgs(interp, 2, objv, "tagOrId ?x y x y ...?");
+ result = TCL_ERROR;
+ goto done;
+ }
+ FIRST_CANVAS_ITEM_MATCHING(objv[2], &searchPtr, goto done);
+ if (itemPtr != NULL) {
+ if (objc != 3) {
+ EventuallyRedrawItem(canvasPtr, itemPtr);
+ }
+ result = ItemCoords(canvasPtr, itemPtr, objc-3, objv+3);
+ if (objc != 3) {
+ EventuallyRedrawItem(canvasPtr, itemPtr);
+ }
+ }
+ break;
+ case CANV_IMOVE: {
+ double ignored;
+ Tcl_Obj *tmpObj;
+
+ if (objc != 6) {
+ Tcl_WrongNumArgs(interp, 2, objv, "tagOrId index x y");
+ result = TCL_ERROR;
+ goto done;
+ }
+ if (Tk_CanvasGetCoordFromObj(interp, (Tk_Canvas) canvasPtr,
+ objv[4], &ignored) != TCL_OK
+ || Tk_CanvasGetCoordFromObj(interp, (Tk_Canvas) canvasPtr,
+ objv[5], &ignored) != TCL_OK) {
+ result = TCL_ERROR;
+ goto done;
+ }
+
+ /*
+ * Make a temporary object here that we can reuse for all the
+ * modifications in the loop.
+ */
+
+ tmpObj = Tcl_NewListObj(2, objv+4);
+
+ FOR_EVERY_CANVAS_ITEM_MATCHING(objv[2], &searchPtr, goto doneImove) {
+ int index;
+ int x1,x2,y1,y2;
+ int dontRedraw1,dontRedraw2;
+
+ /*
+ * The TK_MOVABLE_POINTS flag should only be set for types that
+ * support the same semantics of index, dChars and insert methods
+ * as lines and canvases.
+ */
+
+ if (itemPtr == NULL ||
+ !(itemPtr->typePtr->alwaysRedraw & TK_MOVABLE_POINTS)) {
+ continue;
+ }
+
+ result = ItemIndex(canvasPtr, itemPtr, objv[3], &index);
+ if (result != TCL_OK) {
+ break;
+ }
+
+ /*
+ * Redraw both item's old and new areas: it's possible that a
+ * replace could result in a new area larger than the old area.
+ * Except if the dCharsProc or insertProc sets the
+ * TK_ITEM_DONT_REDRAW flag, nothing more needs to be done.
+ */
+
+ x1 = itemPtr->x1; y1 = itemPtr->y1;
+ x2 = itemPtr->x2; y2 = itemPtr->y2;
+
+ itemPtr->redraw_flags &= ~TK_ITEM_DONT_REDRAW;
+ ItemDelChars(canvasPtr, itemPtr, index, index);
+ dontRedraw1=itemPtr->redraw_flags & TK_ITEM_DONT_REDRAW;
+
+ itemPtr->redraw_flags &= ~TK_ITEM_DONT_REDRAW;
+ ItemInsert(canvasPtr, itemPtr, index, tmpObj);
+ dontRedraw2=itemPtr->redraw_flags & TK_ITEM_DONT_REDRAW;
+
+ if (!(dontRedraw1 && dontRedraw2)) {
+ Tk_CanvasEventuallyRedraw((Tk_Canvas) canvasPtr,
+ x1, y1, x2, y2);
+ EventuallyRedrawItem(canvasPtr, itemPtr);
+ }
+ itemPtr->redraw_flags &= ~TK_ITEM_DONT_REDRAW;
+ }
+
+ doneImove:
+ Tcl_DecrRefCount(tmpObj);
+ break;
+ }
+ case CANV_CREATE: {
+ Tk_ItemType *typePtr;
+ Tk_ItemType *matchPtr = NULL;
+ Tk_Item *itemPtr;
+ int isNew = 0;
+ Tcl_HashEntry *entryPtr;
+ const char *arg;
+ size_t length;
+
+ if (objc < 3) {
+ Tcl_WrongNumArgs(interp, 2, objv, "type coords ?arg ...?");
+ result = TCL_ERROR;
+ goto done;
+ }
+ arg = Tcl_GetString(objv[2]);
+ length = objv[2]->length;
+ c = arg[0];
+
+ /*
+ * Lock because the list of types is a global resource that could be
+ * updated by another thread. That's fairly unlikely, but not
+ * impossible.
+ */
+
+ Tcl_MutexLock(&typeListMutex);
+ for (typePtr = typeList; typePtr != NULL; typePtr = typePtr->nextPtr){
+ if ((c == typePtr->name[0])
+ && (!strncmp(arg, typePtr->name, length))) {
+ if (matchPtr != NULL) {
+ Tcl_MutexUnlock(&typeListMutex);
+ goto badType;
+ }
+ matchPtr = typePtr;
+ }
+ }
+
+ /*
+ * Can unlock now because we no longer look at the fields of the
+ * matched item type that are potentially modified by other threads.
+ */
+
+ Tcl_MutexUnlock(&typeListMutex);
+ if (matchPtr == NULL) {
+ badType:
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "unknown or ambiguous item type \"%s\"", arg));
+ Tcl_SetErrorCode(interp, "TK", "LOOKUP", "CANVAS_ITEM_TYPE", arg,
+ NULL);
+ result = TCL_ERROR;
+ goto done;
+ }
+ if (objc < 4) {
+ /*
+ * Allow more specific error return.
+ */
+
+ Tcl_WrongNumArgs(interp, 3, objv, "coords ?arg ...?");
+ result = TCL_ERROR;
+ goto done;
+ }
+
+ typePtr = matchPtr;
+ itemPtr = ckalloc(typePtr->itemSize);
+ itemPtr->id = canvasPtr->nextId;
+ canvasPtr->nextId++;
+ itemPtr->tagPtr = itemPtr->staticTagSpace;
+ itemPtr->tagSpace = TK_TAG_SPACE;
+ itemPtr->numTags = 0;
+ itemPtr->typePtr = typePtr;
+ itemPtr->state = TK_STATE_NULL;
+ itemPtr->redraw_flags = 0;
+
+ if (ItemCreate(canvasPtr, itemPtr, objc, objv) != TCL_OK) {
+ ckfree(itemPtr);
+ result = TCL_ERROR;
+ goto done;
+ }
+
+ itemPtr->nextPtr = NULL;
+ entryPtr = Tcl_CreateHashEntry(&canvasPtr->idTable,
+ (char *) INT2PTR(itemPtr->id), &isNew);
+ Tcl_SetHashValue(entryPtr, itemPtr);
+ itemPtr->prevPtr = canvasPtr->lastItemPtr;
+ canvasPtr->hotPtr = itemPtr;
+ canvasPtr->hotPrevPtr = canvasPtr->lastItemPtr;
+ if (canvasPtr->lastItemPtr == NULL) {
+ canvasPtr->firstItemPtr = itemPtr;
+ } else {
+ canvasPtr->lastItemPtr->nextPtr = itemPtr;
+ }
+ canvasPtr->lastItemPtr = itemPtr;
+ itemPtr->redraw_flags |= FORCE_REDRAW;
+ EventuallyRedrawItem(canvasPtr, itemPtr);
+ canvasPtr->flags |= REPICK_NEEDED;
+ Tcl_SetObjResult(interp, Tcl_NewIntObj(itemPtr->id));
+ break;
+ }
+ case CANV_DCHARS: {
+ int first, last;
+ int x1,x2,y1,y2;
+
+ if ((objc != 4) && (objc != 5)) {
+ Tcl_WrongNumArgs(interp, 2, objv, "tagOrId first ?last?");
+ result = TCL_ERROR;
+ goto done;
+ }
+ FOR_EVERY_CANVAS_ITEM_MATCHING(objv[2], &searchPtr, goto done) {
+ if ((itemPtr->typePtr->indexProc == NULL)
+ || (itemPtr->typePtr->dCharsProc == NULL)) {
+ continue;
+ }
+ result = ItemIndex(canvasPtr, itemPtr, objv[3], &first);
+ if (result != TCL_OK) {
+ goto done;
+ }
+ if (objc == 5) {
+ result = ItemIndex(canvasPtr, itemPtr, objv[4], &last);
+ if (result != TCL_OK) {
+ goto done;
+ }
+ } else {
+ last = first;
+ }
+
+ /*
+ * Redraw both item's old and new areas: it's possible that a
+ * delete could result in a new area larger than the old area.
+ * Except if the insertProc sets the TK_ITEM_DONT_REDRAW flag,
+ * nothing more needs to be done.
+ */
+
+ x1 = itemPtr->x1; y1 = itemPtr->y1;
+ x2 = itemPtr->x2; y2 = itemPtr->y2;
+ itemPtr->redraw_flags &= ~TK_ITEM_DONT_REDRAW;
+ ItemDelChars(canvasPtr, itemPtr, first, last);
+ if (!(itemPtr->redraw_flags & TK_ITEM_DONT_REDRAW)) {
+ Tk_CanvasEventuallyRedraw((Tk_Canvas) canvasPtr,
+ x1, y1, x2, y2);
+ EventuallyRedrawItem(canvasPtr, itemPtr);
+ }
+ itemPtr->redraw_flags &= ~TK_ITEM_DONT_REDRAW;
+ }
+ break;
+ }
+ case CANV_DELETE: {
+ int i;
+ Tcl_HashEntry *entryPtr;
+
+ for (i = 2; i < objc; i++) {
+ FOR_EVERY_CANVAS_ITEM_MATCHING(objv[i], &searchPtr, goto done) {
+ EventuallyRedrawItem(canvasPtr, itemPtr);
+ if (canvasPtr->bindingTable != NULL) {
+ Tk_DeleteAllBindings(canvasPtr->bindingTable, itemPtr);
+ }
+ ItemDelete(canvasPtr, itemPtr);
+ if (itemPtr->tagPtr != itemPtr->staticTagSpace) {
+ ckfree(itemPtr->tagPtr);
+ }
+ entryPtr = Tcl_FindHashEntry(&canvasPtr->idTable,
+ (char *) INT2PTR(itemPtr->id));
+ Tcl_DeleteHashEntry(entryPtr);
+ if (itemPtr->nextPtr != NULL) {
+ itemPtr->nextPtr->prevPtr = itemPtr->prevPtr;
+ }
+ if (itemPtr->prevPtr != NULL) {
+ itemPtr->prevPtr->nextPtr = itemPtr->nextPtr;
+ }
+ if (canvasPtr->firstItemPtr == itemPtr) {
+ canvasPtr->firstItemPtr = itemPtr->nextPtr;
+ if (canvasPtr->firstItemPtr == NULL) {
+ canvasPtr->lastItemPtr = NULL;
+ }
+ }
+ if (canvasPtr->lastItemPtr == itemPtr) {
+ canvasPtr->lastItemPtr = itemPtr->prevPtr;
+ }
+ ckfree(itemPtr);
+ if (itemPtr == canvasPtr->currentItemPtr) {
+ canvasPtr->currentItemPtr = NULL;
+ canvasPtr->flags |= REPICK_NEEDED;
+ }
+ if (itemPtr == canvasPtr->newCurrentPtr) {
+ canvasPtr->newCurrentPtr = NULL;
+ canvasPtr->flags |= REPICK_NEEDED;
+ }
+ if (itemPtr == canvasPtr->textInfo.focusItemPtr) {
+ canvasPtr->textInfo.focusItemPtr = NULL;
+ }
+ if (itemPtr == canvasPtr->textInfo.selItemPtr) {
+ canvasPtr->textInfo.selItemPtr = NULL;
+ }
+ if ((itemPtr == canvasPtr->hotPtr)
+ || (itemPtr == canvasPtr->hotPrevPtr)) {
+ canvasPtr->hotPtr = NULL;
+ }
+ }
+ }
+ break;
+ }
+ case CANV_DTAG: {
+ Tk_Uid tag;
+ int i;
+
+ if ((objc != 3) && (objc != 4)) {
+ Tcl_WrongNumArgs(interp, 2, objv, "tagOrId ?tagToDelete?");
+ result = TCL_ERROR;
+ goto done;
+ }
+ if (objc == 4) {
+ tag = Tk_GetUid(Tcl_GetString(objv[3]));
+ } else {
+ tag = Tk_GetUid(Tcl_GetString(objv[2]));
+ }
+ FOR_EVERY_CANVAS_ITEM_MATCHING(objv[2], &searchPtr, goto done) {
+ for (i = itemPtr->numTags-1; i >= 0; i--) {
+ if (itemPtr->tagPtr[i] == tag) {
+ itemPtr->tagPtr[i] = itemPtr->tagPtr[itemPtr->numTags-1];
+ itemPtr->numTags--;
+ }
+ }
+ }
+ break;
+ }
+ case CANV_FIND:
+ if (objc < 3) {
+ Tcl_WrongNumArgs(interp, 2, objv, "searchCommand ?arg ...?");
+ result = TCL_ERROR;
+ goto done;
+ }
+ result = FIND_ITEMS(NULL, 2);
+ break;
+ case CANV_FOCUS:
+ if (objc > 3) {
+ Tcl_WrongNumArgs(interp, 2, objv, "?tagOrId?");
+ result = TCL_ERROR;
+ goto done;
+ }
+ itemPtr = canvasPtr->textInfo.focusItemPtr;
+ if (objc == 2) {
+ if (itemPtr != NULL) {
+ Tcl_SetObjResult(interp, Tcl_NewIntObj(itemPtr->id));
+ }
+ goto done;
+ }
+ if (canvasPtr->textInfo.gotFocus) {
+ EventuallyRedrawItem(canvasPtr, itemPtr);
+ }
+ if (Tcl_GetString(objv[2])[0] == 0) {
+ canvasPtr->textInfo.focusItemPtr = NULL;
+ goto done;
+ }
+ FOR_EVERY_CANVAS_ITEM_MATCHING(objv[2], &searchPtr, goto done) {
+ if (itemPtr->typePtr->icursorProc != NULL) {
+ break;
+ }
+ }
+ if (itemPtr == NULL) {
+ goto done;
+ }
+ canvasPtr->textInfo.focusItemPtr = itemPtr;
+ if (canvasPtr->textInfo.gotFocus) {
+ EventuallyRedrawItem(canvasPtr, itemPtr);
+ }
+ break;
+ case CANV_GETTAGS:
+ if (objc != 3) {
+ Tcl_WrongNumArgs(interp, 2, objv, "tagOrId");
+ result = TCL_ERROR;
+ goto done;
+ }
+ FIRST_CANVAS_ITEM_MATCHING(objv[2], &searchPtr, goto done);
+ if (itemPtr != NULL) {
+ int i;
+ Tcl_Obj *resultObj = Tcl_NewObj();
+
+ for (i = 0; i < itemPtr->numTags; i++) {
+ Tcl_ListObjAppendElement(NULL, resultObj,
+ Tcl_NewStringObj(itemPtr->tagPtr[i], -1));
+ }
+ Tcl_SetObjResult(interp, resultObj);
+ }
+ break;
+ case CANV_ICURSOR: {
+ int index;
+
+ if (objc != 4) {
+ Tcl_WrongNumArgs(interp, 2, objv, "tagOrId index");
+ result = TCL_ERROR;
+ goto done;
+ }
+ FOR_EVERY_CANVAS_ITEM_MATCHING(objv[2], &searchPtr, goto done) {
+ if ((itemPtr->typePtr->indexProc == NULL)
+ || (itemPtr->typePtr->icursorProc == NULL)) {
+ goto done;
+ }
+ result = ItemIndex(canvasPtr, itemPtr, objv[3], &index);
+ if (result != TCL_OK) {
+ goto done;
+ }
+ ItemCursor(canvasPtr, itemPtr, index);
+ if ((itemPtr == canvasPtr->textInfo.focusItemPtr)
+ && (canvasPtr->textInfo.cursorOn)) {
+ EventuallyRedrawItem(canvasPtr, itemPtr);
+ }
+ }
+ break;
+ }
+ case CANV_INDEX: {
+ int index;
+
+ if (objc != 4) {
+ Tcl_WrongNumArgs(interp, 2, objv, "tagOrId string");
+ result = TCL_ERROR;
+ goto done;
+ }
+ FOR_EVERY_CANVAS_ITEM_MATCHING(objv[2], &searchPtr, goto done) {
+ if (itemPtr->typePtr->indexProc != NULL) {
+ break;
+ }
+ }
+ if (itemPtr == NULL) {
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "can't find an indexable item \"%s\"",
+ Tcl_GetString(objv[2])));
+ Tcl_SetErrorCode(interp, "TK", "CANVAS", "INDEXABLE_ITEM", NULL);
+ result = TCL_ERROR;
+ goto done;
+ }
+ result = ItemIndex(canvasPtr, itemPtr, objv[3], &index);
+ if (result != TCL_OK) {
+ goto done;
+ }
+ Tcl_SetObjResult(interp, Tcl_NewIntObj(index));
+ break;
+ }
+ case CANV_INSERT: {
+ int beforeThis;
+ int x1,x2,y1,y2;
+
+ if (objc != 5) {
+ Tcl_WrongNumArgs(interp, 2, objv, "tagOrId beforeThis string");
+ result = TCL_ERROR;
+ goto done;
+ }
+ FOR_EVERY_CANVAS_ITEM_MATCHING(objv[2], &searchPtr, goto done) {
+ if ((itemPtr->typePtr->indexProc == NULL)
+ || (itemPtr->typePtr->insertProc == NULL)) {
+ continue;
+ }
+ result = ItemIndex(canvasPtr, itemPtr, objv[3], &beforeThis);
+ if (result != TCL_OK) {
+ goto done;
+ }
+
+ /*
+ * Redraw both item's old and new areas: it's possible that an
+ * insertion could result in a new area either larger or smaller
+ * than the old area. Except if the insertProc sets the
+ * TK_ITEM_DONT_REDRAW flag, nothing more needs to be done.
+ */
+
+ x1 = itemPtr->x1; y1 = itemPtr->y1;
+ x2 = itemPtr->x2; y2 = itemPtr->y2;
+ itemPtr->redraw_flags &= ~TK_ITEM_DONT_REDRAW;
+ ItemInsert(canvasPtr, itemPtr, beforeThis, objv[4]);
+ if (!(itemPtr->redraw_flags & TK_ITEM_DONT_REDRAW)) {
+ Tk_CanvasEventuallyRedraw((Tk_Canvas) canvasPtr,
+ x1, y1, x2, y2);
+ EventuallyRedrawItem(canvasPtr, itemPtr);
+ }
+ itemPtr->redraw_flags &= ~TK_ITEM_DONT_REDRAW;
+ }
+ break;
+ }
+ case CANV_ITEMCGET:
+ if (objc != 4) {
+ Tcl_WrongNumArgs(interp, 2, objv, "tagOrId option");
+ result = TCL_ERROR;
+ goto done;
+ }
+ FIRST_CANVAS_ITEM_MATCHING(objv[2], &searchPtr, goto done);
+ if (itemPtr != NULL) {
+ result = ItemConfigValue(canvasPtr, itemPtr, objv[3]);
+ }
+ break;
+ case CANV_ITEMCONFIGURE:
+ if (objc < 3) {
+ Tcl_WrongNumArgs(interp, 2, objv, "tagOrId ?-option value ...?");
+ result = TCL_ERROR;
+ goto done;
+ }
+ FOR_EVERY_CANVAS_ITEM_MATCHING(objv[2], &searchPtr, goto done) {
+ if (objc == 3) {
+ result = ItemConfigInfo(canvasPtr, itemPtr, NULL);
+ } else if (objc == 4) {
+ result = ItemConfigInfo(canvasPtr, itemPtr, objv[3]);
+ } else {
+ EventuallyRedrawItem(canvasPtr, itemPtr);
+ result = ItemConfigure(canvasPtr, itemPtr, objc-3, objv+3);
+ EventuallyRedrawItem(canvasPtr, itemPtr);
+ canvasPtr->flags |= REPICK_NEEDED;
+ }
+ if ((result != TCL_OK) || (objc < 5)) {
+ break;
+ }
+ }
+ break;
+ case CANV_LOWER: {
+ Tk_Item *itemPtr;
+
+ if ((objc != 3) && (objc != 4)) {
+ Tcl_WrongNumArgs(interp, 2, objv, "tagOrId ?belowThis?");
+ result = TCL_ERROR;
+ goto done;
+ }
+
+ /*
+ * First find the item just after which we'll insert the named items.
+ */
+
+ if (objc == 3) {
+ itemPtr = NULL;
+ } else {
+ FIRST_CANVAS_ITEM_MATCHING(objv[3], &searchPtr, goto done);
+ if (itemPtr == NULL) {
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "tagOrId \"%s\" doesn't match any items",
+ Tcl_GetString(objv[3])));
+ Tcl_SetErrorCode(interp, "TK", "CANVAS", "ITEM", NULL);
+ result = TCL_ERROR;
+ goto done;
+ }
+ itemPtr = itemPtr->prevPtr;
+ }
+ RELINK_ITEMS(objv[2], itemPtr);
+ break;
+ }
+ case CANV_MOVE: {
+ double xAmount, yAmount;
+
+ if (objc != 5) {
+ Tcl_WrongNumArgs(interp, 2, objv, "tagOrId xAmount yAmount");
+ result = TCL_ERROR;
+ goto done;
+ }
+ if ((Tk_CanvasGetCoordFromObj(interp, (Tk_Canvas) canvasPtr, objv[3],
+ &xAmount) != TCL_OK) || (Tk_CanvasGetCoordFromObj(interp,
+ (Tk_Canvas) canvasPtr, objv[4], &yAmount) != TCL_OK)) {
+ result = TCL_ERROR;
+ goto done;
+ }
+ FOR_EVERY_CANVAS_ITEM_MATCHING(objv[2], &searchPtr, goto done) {
+ EventuallyRedrawItem(canvasPtr, itemPtr);
+ ItemTranslate(canvasPtr, itemPtr, xAmount, yAmount);
+ EventuallyRedrawItem(canvasPtr, itemPtr);
+ canvasPtr->flags |= REPICK_NEEDED;
+ }
+ break;
+ }
+ case CANV_MOVETO: {
+ int xBlank, yBlank;
+ double xAmount, yAmount;
+ double oldX = 0, oldY = 0, newX, newY;
+
+ if (objc != 5) {
+ Tcl_WrongNumArgs(interp, 2, objv, "tagOrId x y");
+ result = TCL_ERROR;
+ goto done;
+ }
+
+ xBlank = 0;
+ if (Tcl_GetString(objv[3])[0] == '\0') {
+ xBlank = 1;
+ } else if (Tk_CanvasGetCoordFromObj(interp, (Tk_Canvas) canvasPtr,
+ objv[3], &newX) != TCL_OK) {
+ result = TCL_ERROR;
+ goto done;
+ }
+
+ yBlank = 0;
+ if (Tcl_GetString(objv[4])[0] == '\0') {
+ yBlank = 1;
+ } else if (Tk_CanvasGetCoordFromObj(interp, (Tk_Canvas) canvasPtr,
+ objv[4], &newY) != TCL_OK) {
+ result = TCL_ERROR;
+ goto done;
+ }
+
+ FIRST_CANVAS_ITEM_MATCHING(objv[2], &searchPtr, goto done);
+ if (itemPtr != NULL) {
+ oldX = itemPtr->x1;
+ oldY = itemPtr->y1;
+
+ /*
+ * Calculate the displacement.
+ */
+
+ if (xBlank) {
+ xAmount = 0;
+ } else {
+ xAmount = newX - oldX;
+ }
+
+ if (yBlank) {
+ yAmount = 0;
+ } else {
+ yAmount = newY - oldY;
+ }
+
+ /*
+ * Move the object(s).
+ */
+
+ FOR_EVERY_CANVAS_ITEM_MATCHING(objv[2], &searchPtr, goto done) {
+ EventuallyRedrawItem(canvasPtr, itemPtr);
+ ItemTranslate(canvasPtr, itemPtr, xAmount, yAmount);
+ EventuallyRedrawItem(canvasPtr, itemPtr);
+ canvasPtr->flags |= REPICK_NEEDED;
+ }
+ }
+ break;
+ }
+ case CANV_POSTSCRIPT: {
+ const char **args = TkGetStringsFromObjs(objc, objv);
+
+ result = TkCanvPostscriptCmd(canvasPtr, interp, objc, args);
+ if (args != NULL) {
+ ckfree(args);
+ }
+ break;
+ }
+ case CANV_RAISE: {
+ Tk_Item *prevPtr;
+
+ if ((objc != 3) && (objc != 4)) {
+ Tcl_WrongNumArgs(interp, 2, objv, "tagOrId ?aboveThis?");
+ result = TCL_ERROR;
+ goto done;
+ }
+
+ /*
+ * First find the item just after which we'll insert the named items.
+ */
+
+ if (objc == 3) {
+ prevPtr = canvasPtr->lastItemPtr;
+ } else {
+ prevPtr = NULL;
+ FOR_EVERY_CANVAS_ITEM_MATCHING(objv[3], &searchPtr, goto done) {
+ prevPtr = itemPtr;
+ }
+ if (prevPtr == NULL) {
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "tagOrId \"%s\" doesn't match any items",
+ Tcl_GetString(objv[3])));
+ Tcl_SetErrorCode(interp, "TK", "CANVAS", "ITEM", NULL);
+ result = TCL_ERROR;
+ goto done;
+ }
+ }
+ RELINK_ITEMS(objv[2], prevPtr);
+ break;
+ }
+ case CANV_RCHARS: {
+ int first, last;
+ int x1,x2,y1,y2;
+
+ if (objc != 6) {
+ Tcl_WrongNumArgs(interp, 2, objv, "tagOrId first last string");
+ result = TCL_ERROR;
+ goto done;
+ }
+ FOR_EVERY_CANVAS_ITEM_MATCHING(objv[2], &searchPtr, goto done) {
+ if ((itemPtr->typePtr->indexProc == NULL)
+ || (itemPtr->typePtr->dCharsProc == NULL)
+ || (itemPtr->typePtr->insertProc == NULL)) {
+ continue;
+ }
+ result = ItemIndex(canvasPtr, itemPtr, objv[3], &first);
+ if (result != TCL_OK) {
+ goto done;
+ }
+ result = ItemIndex(canvasPtr, itemPtr, objv[4], &last);
+ if (result != TCL_OK) {
+ goto done;
+ }
+
+ /*
+ * Redraw both item's old and new areas: it's possible that a
+ * replace could result in a new area larger than the old area.
+ * Except if the dCharsProc or insertProc sets the
+ * TK_ITEM_DONT_REDRAW flag, nothing more needs to be done.
+ */
+
+ x1 = itemPtr->x1; y1 = itemPtr->y1;
+ x2 = itemPtr->x2; y2 = itemPtr->y2;
+ itemPtr->redraw_flags &= ~TK_ITEM_DONT_REDRAW;
+
+ ItemDelChars(canvasPtr, itemPtr, first, last);
+ ItemInsert(canvasPtr, itemPtr, first, objv[5]);
+
+ if (!(itemPtr->redraw_flags & TK_ITEM_DONT_REDRAW)) {
+ Tk_CanvasEventuallyRedraw((Tk_Canvas) canvasPtr,
+ x1, y1, x2, y2);
+ EventuallyRedrawItem(canvasPtr, itemPtr);
+ }
+ itemPtr->redraw_flags &= ~TK_ITEM_DONT_REDRAW;
+ }
+ break;
+ }
+ case CANV_SCALE: {
+ double xOrigin, yOrigin, xScale, yScale;
+
+ if (objc != 7) {
+ Tcl_WrongNumArgs(interp, 2, objv,
+ "tagOrId xOrigin yOrigin xScale yScale");
+ result = TCL_ERROR;
+ goto done;
+ }
+ if ((Tk_CanvasGetCoordFromObj(interp, (Tk_Canvas) canvasPtr,
+ objv[3], &xOrigin) != TCL_OK)
+ || (Tk_CanvasGetCoordFromObj(interp, (Tk_Canvas) canvasPtr,
+ objv[4], &yOrigin) != TCL_OK)
+ || (Tcl_GetDoubleFromObj(interp, objv[5], &xScale)!=TCL_OK)
+ || (Tcl_GetDoubleFromObj(interp, objv[6], &yScale)!=TCL_OK)) {
+ result = TCL_ERROR;
+ goto done;
+ }
+ if ((xScale == 0.0) || (yScale == 0.0)) {
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "scale factor cannot be zero", -1));
+ Tcl_SetErrorCode(interp, "TK", "CANVAS", "BAD_SCALE", NULL);
+ result = TCL_ERROR;
+ goto done;
+ }
+ FOR_EVERY_CANVAS_ITEM_MATCHING(objv[2], &searchPtr, goto done) {
+ EventuallyRedrawItem(canvasPtr, itemPtr);
+ ItemScale(canvasPtr, itemPtr, xOrigin, yOrigin, xScale, yScale);
+ EventuallyRedrawItem(canvasPtr, itemPtr);
+ canvasPtr->flags |= REPICK_NEEDED;
+ }
+ break;
+ }
+ case CANV_SCAN: {
+ int x, y, gain = 10;
+ static const char *const optionStrings[] = {
+ "mark", "dragto", NULL
+ };
+
+ if (objc < 5) {
+ Tcl_WrongNumArgs(interp, 2, objv, "mark|dragto x y ?dragGain?");
+ result = TCL_ERROR;
+ } else if (Tcl_GetIndexFromObj(interp, objv[2], optionStrings,
+ "scan option", 0, &index) != TCL_OK) {
+ result = TCL_ERROR;
+ } else if ((objc != 5) && (objc != 5+index)) {
+ Tcl_WrongNumArgs(interp, 3, objv, index?"x y ?gain?":"x y");
+ result = TCL_ERROR;
+ } else if ((Tcl_GetIntFromObj(interp, objv[3], &x) != TCL_OK)
+ || (Tcl_GetIntFromObj(interp, objv[4], &y) != TCL_OK)){
+ result = TCL_ERROR;
+ } else if ((objc == 6) &&
+ (Tcl_GetIntFromObj(interp, objv[5], &gain) != TCL_OK)) {
+ result = TCL_ERROR;
+ } else if (!index) {
+ canvasPtr->scanX = x;
+ canvasPtr->scanXOrigin = canvasPtr->xOrigin;
+ canvasPtr->scanY = y;
+ canvasPtr->scanYOrigin = canvasPtr->yOrigin;
+ } else {
+ int newXOrigin, newYOrigin, tmp;
+
+ /*
+ * Compute a new view origin for the canvas, amplifying the
+ * mouse motion.
+ */
+
+ tmp = canvasPtr->scanXOrigin - gain*(x - canvasPtr->scanX)
+ - canvasPtr->scrollX1;
+ newXOrigin = canvasPtr->scrollX1 + tmp;
+ tmp = canvasPtr->scanYOrigin - gain*(y - canvasPtr->scanY)
+ - canvasPtr->scrollY1;
+ newYOrigin = canvasPtr->scrollY1 + tmp;
+ CanvasSetOrigin(canvasPtr, newXOrigin, newYOrigin);
+ }
+ break;
+ }
+ case CANV_SELECT: {
+ int index, optionindex;
+ static const char *const optionStrings[] = {
+ "adjust", "clear", "from", "item", "to", NULL
+ };
+ enum options {
+ CANV_ADJUST, CANV_CLEAR, CANV_FROM, CANV_ITEM, CANV_TO
+ };
+
+ if (objc < 3) {
+ Tcl_WrongNumArgs(interp, 2, objv, "option ?tagOrId? ?arg?");
+ result = TCL_ERROR;
+ goto done;
+ }
+ if (objc >= 4) {
+ FOR_EVERY_CANVAS_ITEM_MATCHING(objv[3], &searchPtr, goto done) {
+ if ((itemPtr->typePtr->indexProc != NULL)
+ && (itemPtr->typePtr->selectionProc != NULL)){
+ break;
+ }
+ }
+ if (itemPtr == NULL) {
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "can't find an indexable and selectable item \"%s\"",
+ Tcl_GetString(objv[3])));
+ Tcl_SetErrorCode(interp, "TK", "CANVAS", "SELECTABLE_ITEM",
+ NULL);
+ result = TCL_ERROR;
+ goto done;
+ }
+ }
+ if (objc == 5) {
+ result = ItemIndex(canvasPtr, itemPtr, objv[4], &index);
+ if (result != TCL_OK) {
+ goto done;
+ }
+ }
+ if (Tcl_GetIndexFromObj(interp, objv[2], optionStrings,
+ "select option", 0, &optionindex) != TCL_OK) {
+ result = TCL_ERROR;
+ goto done;
+ }
+ switch ((enum options) optionindex) {
+ case CANV_ADJUST:
+ if (objc != 5) {
+ Tcl_WrongNumArgs(interp, 3, objv, "tagOrId index");
+ result = TCL_ERROR;
+ goto done;
+ }
+ if (canvasPtr->textInfo.selItemPtr == itemPtr) {
+ if (index < (canvasPtr->textInfo.selectFirst
+ + canvasPtr->textInfo.selectLast)/2) {
+ canvasPtr->textInfo.selectAnchor =
+ canvasPtr->textInfo.selectLast + 1;
+ } else {
+ canvasPtr->textInfo.selectAnchor =
+ canvasPtr->textInfo.selectFirst;
+ }
+ }
+ CanvasSelectTo(canvasPtr, itemPtr, index);
+ break;
+ case CANV_CLEAR:
+ if (objc != 3) {
+ Tcl_WrongNumArgs(interp, 3, objv, NULL);
+ result = TCL_ERROR;
+ goto done;
+ }
+ EventuallyRedrawItem(canvasPtr, canvasPtr->textInfo.selItemPtr);
+ canvasPtr->textInfo.selItemPtr = NULL;
+ break;
+ case CANV_FROM:
+ if (objc != 5) {
+ Tcl_WrongNumArgs(interp, 3, objv, "tagOrId index");
+ result = TCL_ERROR;
+ goto done;
+ }
+ canvasPtr->textInfo.anchorItemPtr = itemPtr;
+ canvasPtr->textInfo.selectAnchor = index;
+ break;
+ case CANV_ITEM:
+ if (objc != 3) {
+ Tcl_WrongNumArgs(interp, 3, objv, NULL);
+ result = TCL_ERROR;
+ goto done;
+ }
+ if (canvasPtr->textInfo.selItemPtr != NULL) {
+ Tcl_SetObjResult(interp,
+ Tcl_NewIntObj(canvasPtr->textInfo.selItemPtr->id));
+ }
+ break;
+ case CANV_TO:
+ if (objc != 5) {
+ Tcl_WrongNumArgs(interp, 2, objv, "tagOrId index");
+ result = TCL_ERROR;
+ goto done;
+ }
+ CanvasSelectTo(canvasPtr, itemPtr, index);
+ break;
+ }
+ break;
+ }
+ case CANV_TYPE:
+ if (objc != 3) {
+ Tcl_WrongNumArgs(interp, 2, objv, "tag");
+ result = TCL_ERROR;
+ goto done;
+ }
+ FIRST_CANVAS_ITEM_MATCHING(objv[2], &searchPtr, goto done);
+ if (itemPtr != NULL) {
+ Tcl_SetObjResult(interp,
+ Tcl_NewStringObj(itemPtr->typePtr->name, -1));
+ }
+ break;
+ case CANV_XVIEW: {
+ int count, type;
+ int newX = 0; /* Initialization needed only to prevent gcc
+ * warnings. */
+ double fraction;
+ const char **args;
+
+ if (objc == 2) {
+ Tcl_SetObjResult(interp, ScrollFractions(
+ canvasPtr->xOrigin + canvasPtr->inset,
+ canvasPtr->xOrigin + Tk_Width(canvasPtr->tkwin)
+ - canvasPtr->inset, canvasPtr->scrollX1,
+ canvasPtr->scrollX2));
+ break;
+ }
+
+ args = TkGetStringsFromObjs(objc, objv);
+ type = Tk_GetScrollInfo(interp, objc, args, &fraction, &count);
+ if (args != NULL) {
+ ckfree(args);
+ }
+ switch (type) {
+ case TK_SCROLL_ERROR:
+ result = TCL_ERROR;
+ goto done;
+ case TK_SCROLL_MOVETO:
+ newX = canvasPtr->scrollX1 - canvasPtr->inset
+ + (int) (fraction * (canvasPtr->scrollX2
+ - canvasPtr->scrollX1) + 0.5);
+ break;
+ case TK_SCROLL_PAGES:
+ newX = (int) (canvasPtr->xOrigin + count * .9
+ * (Tk_Width(canvasPtr->tkwin) - 2*canvasPtr->inset));
+ break;
+ case TK_SCROLL_UNITS:
+ if (canvasPtr->xScrollIncrement > 0) {
+ newX = canvasPtr->xOrigin + count*canvasPtr->xScrollIncrement;
+ } else {
+ newX = (int) (canvasPtr->xOrigin + count * .1
+ * (Tk_Width(canvasPtr->tkwin) - 2*canvasPtr->inset));
+ }
+ break;
+ }
+ CanvasSetOrigin(canvasPtr, newX, canvasPtr->yOrigin);
+ break;
+ }
+ case CANV_YVIEW: {
+ int count, type;
+ int newY = 0; /* Initialization needed only to prevent gcc
+ * warnings. */
+ double fraction;
+ const char **args;
+
+ if (objc == 2) {
+ Tcl_SetObjResult(interp, ScrollFractions(
+ canvasPtr->yOrigin + canvasPtr->inset,
+ canvasPtr->yOrigin + Tk_Height(canvasPtr->tkwin)
+ - canvasPtr->inset,
+ canvasPtr->scrollY1, canvasPtr->scrollY2));
+ break;
+ }
+
+ args = TkGetStringsFromObjs(objc, objv);
+ type = Tk_GetScrollInfo(interp, objc, args, &fraction, &count);
+ if (args != NULL) {
+ ckfree(args);
+ }
+ switch (type) {
+ case TK_SCROLL_ERROR:
+ result = TCL_ERROR;
+ goto done;
+ case TK_SCROLL_MOVETO:
+ newY = canvasPtr->scrollY1 - canvasPtr->inset + (int) (
+ fraction*(canvasPtr->scrollY2-canvasPtr->scrollY1) + 0.5);
+ break;
+ case TK_SCROLL_PAGES:
+ newY = (int) (canvasPtr->yOrigin + count * .9
+ * (Tk_Height(canvasPtr->tkwin) - 2*canvasPtr->inset));
+ break;
+ case TK_SCROLL_UNITS:
+ if (canvasPtr->yScrollIncrement > 0) {
+ newY = canvasPtr->yOrigin + count*canvasPtr->yScrollIncrement;
+ } else {
+ newY = (int) (canvasPtr->yOrigin + count * .1
+ * (Tk_Height(canvasPtr->tkwin) - 2*canvasPtr->inset));
+ }
+ break;
+ }
+ CanvasSetOrigin(canvasPtr, canvasPtr->xOrigin, newY);
+ break;
+ }
+ }
+
+ done:
+#ifndef USE_OLD_TAG_SEARCH
+ TagSearchDestroy(searchPtr);
+#endif /* not USE_OLD_TAG_SEARCH */
+ Tcl_Release(canvasPtr);
+ return result;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * DestroyCanvas --
+ *
+ * This function is invoked by Tcl_EventuallyFree or Tcl_Release to clean
+ * up the internal structure of a canvas at a safe time (when no-one is
+ * using it anymore).
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Everything associated with the canvas is freed up.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+DestroyCanvas(
+ char *memPtr) /* Info about canvas widget. */
+{
+ TkCanvas *canvasPtr = (TkCanvas *) memPtr;
+ Tk_Item *itemPtr;
+#ifndef USE_OLD_TAG_SEARCH
+ TagSearchExpr *expr, *next;
+#endif
+
+ /*
+ * Free up all of the items in the canvas.
+ */
+
+ for (itemPtr = canvasPtr->firstItemPtr; itemPtr != NULL;
+ itemPtr = canvasPtr->firstItemPtr) {
+ canvasPtr->firstItemPtr = itemPtr->nextPtr;
+ ItemDelete(canvasPtr, itemPtr);
+ if (itemPtr->tagPtr != itemPtr->staticTagSpace) {
+ ckfree(itemPtr->tagPtr);
+ }
+ ckfree(itemPtr);
+ }
+
+ /*
+ * Free up all the stuff that requires special handling, then let
+ * Tk_FreeOptions handle all the standard option-related stuff.
+ */
+
+ Tcl_DeleteHashTable(&canvasPtr->idTable);
+ if (canvasPtr->pixmapGC != None) {
+ Tk_FreeGC(canvasPtr->display, canvasPtr->pixmapGC);
+ }
+#ifndef USE_OLD_TAG_SEARCH
+ expr = canvasPtr->bindTagExprs;
+ while (expr) {
+ next = expr->next;
+ TagSearchExprDestroy(expr);
+ expr = next;
+ }
+#endif /* USE_OLD_TAG_SEARCH */
+ Tcl_DeleteTimerHandler(canvasPtr->insertBlinkHandler);
+ if (canvasPtr->bindingTable != NULL) {
+ Tk_DeleteBindingTable(canvasPtr->bindingTable);
+ }
+ Tk_FreeOptions(configSpecs, (char *) canvasPtr, canvasPtr->display, 0);
+ canvasPtr->tkwin = NULL;
+ ckfree(canvasPtr);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ConfigureCanvas --
+ *
+ * This function is called to process an objv/objc list, plus the Tk
+ * option database, in order to configure (or reconfigure) a canvas
+ * widget.
+ *
+ * Results:
+ * The return value is a standard Tcl result. If TCL_ERROR is returned,
+ * then the interp's result contains an error message.
+ *
+ * Side effects:
+ * Configuration information, such as colors, border width, etc. get set
+ * for canvasPtr; old resources get freed, if there were any.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+ConfigureCanvas(
+ Tcl_Interp *interp, /* Used for error reporting. */
+ TkCanvas *canvasPtr, /* Information about widget; may or may not
+ * already have values for some fields. */
+ int objc, /* Number of valid entries in objv. */
+ Tcl_Obj *const objv[], /* Argument objects. */
+ int flags) /* Flags to pass to Tk_ConfigureWidget. */
+{
+ XGCValues gcValues;
+ GC newGC;
+ Tk_State old_canvas_state=canvasPtr->canvas_state;
+
+ if (Tk_ConfigureWidget(interp, canvasPtr->tkwin, configSpecs,
+ objc, (const char **) objv, (char *) canvasPtr,
+ flags|TK_CONFIG_OBJS) != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ /*
+ * A few options need special processing, such as setting the background
+ * from a 3-D border and creating a GC for copying bits to the screen.
+ */
+
+ Tk_SetBackgroundFromBorder(canvasPtr->tkwin, canvasPtr->bgBorder);
+
+ if (canvasPtr->highlightWidth < 0) {
+ canvasPtr->highlightWidth = 0;
+ }
+ canvasPtr->inset = canvasPtr->borderWidth + canvasPtr->highlightWidth;
+
+ gcValues.function = GXcopy;
+ gcValues.graphics_exposures = False;
+ gcValues.foreground = Tk_3DBorderColor(canvasPtr->bgBorder)->pixel;
+ newGC = Tk_GetGC(canvasPtr->tkwin,
+ GCFunction|GCGraphicsExposures|GCForeground, &gcValues);
+ if (canvasPtr->pixmapGC != None) {
+ Tk_FreeGC(canvasPtr->display, canvasPtr->pixmapGC);
+ }
+ canvasPtr->pixmapGC = newGC;
+
+ /*
+ * Reconfigure items to reflect changed state disabled/normal.
+ */
+
+ if ( old_canvas_state != canvasPtr->canvas_state ) {
+ Tk_Item *itemPtr;
+ int result;
+
+ for ( itemPtr = canvasPtr->firstItemPtr; itemPtr != NULL;
+ itemPtr = itemPtr->nextPtr) {
+ if ( itemPtr->state == TK_STATE_NULL ) {
+ result = (*itemPtr->typePtr->configProc)(canvasPtr->interp,
+ (Tk_Canvas) canvasPtr, itemPtr, 0, NULL,
+ TK_CONFIG_ARGV_ONLY);
+ if (result != TCL_OK) {
+ Tcl_ResetResult(canvasPtr->interp);
+ }
+ }
+ }
+ }
+
+ /*
+ * Reset the desired dimensions for the window.
+ */
+
+ Tk_GeometryRequest(canvasPtr->tkwin, canvasPtr->width + 2*canvasPtr->inset,
+ canvasPtr->height + 2*canvasPtr->inset);
+
+ /*
+ * Restart the cursor timing sequence in case the on-time or off-time just
+ * changed.
+ */
+
+ if (canvasPtr->textInfo.gotFocus) {
+ CanvasFocusProc(canvasPtr, 1);
+ }
+
+ /*
+ * Recompute the scroll region.
+ */
+
+ canvasPtr->scrollX1 = 0;
+ canvasPtr->scrollY1 = 0;
+ canvasPtr->scrollX2 = 0;
+ canvasPtr->scrollY2 = 0;
+ if (canvasPtr->regionString != NULL) {
+ int argc2;
+ const char **argv2;
+
+ if (Tcl_SplitList(canvasPtr->interp, canvasPtr->regionString,
+ &argc2, &argv2) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (argc2 != 4) {
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "bad scrollRegion \"%s\"", canvasPtr->regionString));
+ Tcl_SetErrorCode(interp, "TK", "CANVAS", "SCROLL_REGION", NULL);
+ badRegion:
+ ckfree(canvasPtr->regionString);
+ ckfree(argv2);
+ canvasPtr->regionString = NULL;
+ return TCL_ERROR;
+ }
+ if ((Tk_GetPixels(canvasPtr->interp, canvasPtr->tkwin,
+ argv2[0], &canvasPtr->scrollX1) != TCL_OK)
+ || (Tk_GetPixels(canvasPtr->interp, canvasPtr->tkwin,
+ argv2[1], &canvasPtr->scrollY1) != TCL_OK)
+ || (Tk_GetPixels(canvasPtr->interp, canvasPtr->tkwin,
+ argv2[2], &canvasPtr->scrollX2) != TCL_OK)
+ || (Tk_GetPixels(canvasPtr->interp, canvasPtr->tkwin,
+ argv2[3], &canvasPtr->scrollY2) != TCL_OK)) {
+ goto badRegion;
+ }
+ ckfree(argv2);
+ }
+
+ flags = canvasPtr->tsoffset.flags;
+ if (flags & TK_OFFSET_LEFT) {
+ canvasPtr->tsoffset.xoffset = 0;
+ } else if (flags & TK_OFFSET_CENTER) {
+ canvasPtr->tsoffset.xoffset = canvasPtr->width/2;
+ } else if (flags & TK_OFFSET_RIGHT) {
+ canvasPtr->tsoffset.xoffset = canvasPtr->width;
+ }
+ if (flags & TK_OFFSET_TOP) {
+ canvasPtr->tsoffset.yoffset = 0;
+ } else if (flags & TK_OFFSET_MIDDLE) {
+ canvasPtr->tsoffset.yoffset = canvasPtr->height/2;
+ } else if (flags & TK_OFFSET_BOTTOM) {
+ canvasPtr->tsoffset.yoffset = canvasPtr->height;
+ }
+
+ /*
+ * Reset the canvas's origin (this is a no-op unless confine mode has just
+ * been turned on or the scroll region has changed).
+ */
+
+ CanvasSetOrigin(canvasPtr, canvasPtr->xOrigin, canvasPtr->yOrigin);
+ canvasPtr->flags |= UPDATE_SCROLLBARS|REDRAW_BORDERS;
+ Tk_CanvasEventuallyRedraw((Tk_Canvas) canvasPtr,
+ canvasPtr->xOrigin, canvasPtr->yOrigin,
+ canvasPtr->xOrigin + Tk_Width(canvasPtr->tkwin),
+ canvasPtr->yOrigin + Tk_Height(canvasPtr->tkwin));
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * CanvasWorldChanged --
+ *
+ * This function is called when the world has changed in some way and the
+ * widget needs to recompute all its graphics contexts and determine its
+ * new geometry.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Configures all items in the canvas with a empty argc/argv, for the
+ * side effect of causing all the items to recompute their geometry and
+ * to be redisplayed.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+CanvasWorldChanged(
+ ClientData instanceData) /* Information about widget. */
+{
+ TkCanvas *canvasPtr = instanceData;
+ Tk_Item *itemPtr;
+
+ itemPtr = canvasPtr->firstItemPtr;
+ for ( ; itemPtr != NULL; itemPtr = itemPtr->nextPtr) {
+ if (ItemConfigure(canvasPtr, itemPtr, 0, NULL) != TCL_OK) {
+ Tcl_ResetResult(canvasPtr->interp);
+ }
+ }
+ canvasPtr->flags |= REPICK_NEEDED;
+ Tk_CanvasEventuallyRedraw((Tk_Canvas) canvasPtr,
+ canvasPtr->xOrigin, canvasPtr->yOrigin,
+ canvasPtr->xOrigin + Tk_Width(canvasPtr->tkwin),
+ canvasPtr->yOrigin + Tk_Height(canvasPtr->tkwin));
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * DisplayCanvas --
+ *
+ * This function redraws the contents of a canvas window. It is invoked
+ * as a do-when-idle handler, so it only runs when there's nothing else
+ * for the application to do.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Information appears on the screen.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+DisplayCanvas(
+ ClientData clientData) /* Information about widget. */
+{
+ TkCanvas *canvasPtr = clientData;
+ Tk_Window tkwin = canvasPtr->tkwin;
+ Tk_Item *itemPtr;
+ Pixmap pixmap;
+ int screenX1, screenX2, screenY1, screenY2, width, height;
+
+ if (canvasPtr->tkwin == NULL) {
+ return;
+ }
+
+ if (!Tk_IsMapped(tkwin)) {
+ goto done;
+ }
+
+#ifdef MAC_OSX_TK
+ /*
+ * If drawing is disabled, all we need to do is
+ * clear the REDRAW_PENDING flag.
+ */
+ TkWindow *winPtr = (TkWindow *)(canvasPtr->tkwin);
+ MacDrawable *macWin = winPtr->privatePtr;
+ if (macWin && (macWin->flags & TK_DO_NOT_DRAW)){
+ canvasPtr->flags &= ~REDRAW_PENDING;
+ return;
+ }
+#endif
+
+ /*
+ * Choose a new current item if that is needed (this could cause event
+ * handlers to be invoked).
+ */
+
+ while (canvasPtr->flags & REPICK_NEEDED) {
+ Tcl_Preserve(canvasPtr);
+ canvasPtr->flags &= ~REPICK_NEEDED;
+ PickCurrentItem(canvasPtr, &canvasPtr->pickEvent);
+ tkwin = canvasPtr->tkwin;
+ Tcl_Release(canvasPtr);
+ if (tkwin == NULL) {
+ return;
+ }
+ }
+
+ /*
+ * Scan through the item list, registering the bounding box for all items
+ * that didn't do that for the final coordinates yet. This can be
+ * determined by the FORCE_REDRAW flag.
+ */
+
+ for (itemPtr = canvasPtr->firstItemPtr; itemPtr != NULL;
+ itemPtr = itemPtr->nextPtr) {
+ if (itemPtr->redraw_flags & FORCE_REDRAW) {
+ itemPtr->redraw_flags &= ~FORCE_REDRAW;
+ EventuallyRedrawItem(canvasPtr, itemPtr);
+ itemPtr->redraw_flags &= ~FORCE_REDRAW;
+ }
+ }
+
+ /*
+ * Compute the intersection between the area that needs redrawing and the
+ * area that's visible on the screen.
+ */
+
+ if ((canvasPtr->redrawX1 < canvasPtr->redrawX2)
+ && (canvasPtr->redrawY1 < canvasPtr->redrawY2)) {
+ screenX1 = canvasPtr->xOrigin + canvasPtr->inset;
+ screenY1 = canvasPtr->yOrigin + canvasPtr->inset;
+ screenX2 = canvasPtr->xOrigin + Tk_Width(tkwin) - canvasPtr->inset;
+ screenY2 = canvasPtr->yOrigin + Tk_Height(tkwin) - canvasPtr->inset;
+ if (canvasPtr->redrawX1 > screenX1) {
+ screenX1 = canvasPtr->redrawX1;
+ }
+ if (canvasPtr->redrawY1 > screenY1) {
+ screenY1 = canvasPtr->redrawY1;
+ }
+ if (canvasPtr->redrawX2 < screenX2) {
+ screenX2 = canvasPtr->redrawX2;
+ }
+ if (canvasPtr->redrawY2 < screenY2) {
+ screenY2 = canvasPtr->redrawY2;
+ }
+ if ((screenX1 >= screenX2) || (screenY1 >= screenY2)) {
+ goto borders;
+ }
+
+ width = screenX2 - screenX1;
+ height = screenY2 - screenY1;
+
+#ifndef TK_NO_DOUBLE_BUFFERING
+ /*
+ * Redrawing is done in a temporary pixmap that is allocated here and
+ * freed at the end of the function. All drawing is done to the
+ * pixmap, and the pixmap is copied to the screen at the end of the
+ * function. The temporary pixmap serves two purposes:
+ *
+ * 1. It provides a smoother visual effect (no clearing and gradual
+ * redraw will be visible to users).
+ * 2. It allows us to redraw only the objects that overlap the redraw
+ * area. Otherwise incorrect results could occur from redrawing
+ * things that stick outside of the redraw area (we'd have to
+ * redraw everything in order to make the overlaps look right).
+ *
+ * Some tricky points about the pixmap:
+ *
+ * 1. We only allocate a large enough pixmap to hold the area that has
+ * to be redisplayed. This saves time in in the X server for large
+ * objects that cover much more than the area being redisplayed:
+ * only the area of the pixmap will actually have to be redrawn.
+ * 2. Some X servers (e.g. the one for DECstations) have troubles with
+ * with characters that overlap an edge of the pixmap (on the DEC
+ * servers, as of 8/18/92, such characters are drawn one pixel too
+ * far to the right). To handle this problem, make the pixmap a bit
+ * larger than is absolutely needed so that for normal-sized fonts
+ * the characters that overlap the edge of the pixmap will be
+ * outside the area we care about.
+ */
+
+ canvasPtr->drawableXOrigin = screenX1 - 30;
+ canvasPtr->drawableYOrigin = screenY1 - 30;
+ pixmap = Tk_GetPixmap(Tk_Display(tkwin), Tk_WindowId(tkwin),
+ (screenX2 + 30 - canvasPtr->drawableXOrigin),
+ (screenY2 + 30 - canvasPtr->drawableYOrigin),
+ Tk_Depth(tkwin));
+#else
+ canvasPtr->drawableXOrigin = canvasPtr->xOrigin;
+ canvasPtr->drawableYOrigin = canvasPtr->yOrigin;
+ pixmap = Tk_WindowId(tkwin);
+ TkpClipDrawableToRect(Tk_Display(tkwin), pixmap,
+ screenX1 - canvasPtr->xOrigin, screenY1 - canvasPtr->yOrigin,
+ width, height);
+#endif /* TK_NO_DOUBLE_BUFFERING */
+
+ /*
+ * Clear the area to be redrawn.
+ */
+
+ XFillRectangle(Tk_Display(tkwin), pixmap, canvasPtr->pixmapGC,
+ screenX1 - canvasPtr->drawableXOrigin,
+ screenY1 - canvasPtr->drawableYOrigin, (unsigned int) width,
+ (unsigned int) height);
+
+ /*
+ * Scan through the item list, redrawing those items that need it. An
+ * item must be redraw if either (a) it intersects the smaller
+ * on-screen area or (b) it intersects the full canvas area and its
+ * type requests that it be redrawn always (e.g. so subwindows can be
+ * unmapped when they move off-screen).
+ */
+
+ for (itemPtr = canvasPtr->firstItemPtr; itemPtr != NULL;
+ itemPtr = itemPtr->nextPtr) {
+ if ((itemPtr->x1 >= screenX2)
+ || (itemPtr->y1 >= screenY2)
+ || (itemPtr->x2 < screenX1)
+ || (itemPtr->y2 < screenY1)) {
+ if (!AlwaysRedraw(itemPtr)
+ || (itemPtr->x1 >= canvasPtr->redrawX2)
+ || (itemPtr->y1 >= canvasPtr->redrawY2)
+ || (itemPtr->x2 < canvasPtr->redrawX1)
+ || (itemPtr->y2 < canvasPtr->redrawY1)) {
+ continue;
+ }
+ }
+ if (itemPtr->state == TK_STATE_HIDDEN ||
+ (itemPtr->state == TK_STATE_NULL &&
+ canvasPtr->canvas_state == TK_STATE_HIDDEN)) {
+ continue;
+ }
+ ItemDisplay(canvasPtr, itemPtr, pixmap, screenX1, screenY1, width,
+ height);
+ }
+
+#ifndef TK_NO_DOUBLE_BUFFERING
+ /*
+ * Copy from the temporary pixmap to the screen, then free up the
+ * temporary pixmap.
+ */
+
+ XCopyArea(Tk_Display(tkwin), pixmap, Tk_WindowId(tkwin),
+ canvasPtr->pixmapGC,
+ screenX1 - canvasPtr->drawableXOrigin,
+ screenY1 - canvasPtr->drawableYOrigin,
+ (unsigned int) width, (unsigned int) height,
+ screenX1 - canvasPtr->xOrigin, screenY1 - canvasPtr->yOrigin);
+ Tk_FreePixmap(Tk_Display(tkwin), pixmap);
+#else
+ TkpClipDrawableToRect(Tk_Display(tkwin), pixmap, 0, 0, -1, -1);
+#endif /* TK_NO_DOUBLE_BUFFERING */
+ }
+
+ /*
+ * Draw the window borders, if needed.
+ */
+
+ borders:
+ if (canvasPtr->flags & REDRAW_BORDERS) {
+ canvasPtr->flags &= ~REDRAW_BORDERS;
+ if (canvasPtr->borderWidth > 0) {
+ Tk_Draw3DRectangle(tkwin, Tk_WindowId(tkwin),
+ canvasPtr->bgBorder, canvasPtr->highlightWidth,
+ canvasPtr->highlightWidth,
+ Tk_Width(tkwin) - 2*canvasPtr->highlightWidth,
+ Tk_Height(tkwin) - 2*canvasPtr->highlightWidth,
+ canvasPtr->borderWidth, canvasPtr->relief);
+ }
+ if (canvasPtr->highlightWidth != 0) {
+ GC fgGC, bgGC;
+
+ bgGC = Tk_GCForColor(canvasPtr->highlightBgColorPtr,
+ Tk_WindowId(tkwin));
+ if (canvasPtr->textInfo.gotFocus) {
+ fgGC = Tk_GCForColor(canvasPtr->highlightColorPtr,
+ Tk_WindowId(tkwin));
+ TkpDrawHighlightBorder(tkwin, fgGC, bgGC,
+ canvasPtr->highlightWidth, Tk_WindowId(tkwin));
+ } else {
+ TkpDrawHighlightBorder(tkwin, bgGC, bgGC,
+ canvasPtr->highlightWidth, Tk_WindowId(tkwin));
+ }
+ }
+ }
+
+ done:
+ canvasPtr->flags &= ~(REDRAW_PENDING|BBOX_NOT_EMPTY);
+ canvasPtr->redrawX1 = canvasPtr->redrawX2 = 0;
+ canvasPtr->redrawY1 = canvasPtr->redrawY2 = 0;
+ if (canvasPtr->flags & UPDATE_SCROLLBARS) {
+ CanvasUpdateScrollbars(canvasPtr);
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * CanvasEventProc --
+ *
+ * This function is invoked by the Tk dispatcher for various events on
+ * canvases.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * When the window gets deleted, internal structures get cleaned up. When
+ * it gets exposed, it is redisplayed.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+CanvasEventProc(
+ ClientData clientData, /* Information about window. */
+ XEvent *eventPtr) /* Information about event. */
+{
+ TkCanvas *canvasPtr = clientData;
+
+ if (eventPtr->type == Expose) {
+ int x, y;
+
+ x = eventPtr->xexpose.x + canvasPtr->xOrigin;
+ y = eventPtr->xexpose.y + canvasPtr->yOrigin;
+ Tk_CanvasEventuallyRedraw((Tk_Canvas) canvasPtr, x, y,
+ x + eventPtr->xexpose.width,
+ y + eventPtr->xexpose.height);
+ if ((eventPtr->xexpose.x < canvasPtr->inset)
+ || (eventPtr->xexpose.y < canvasPtr->inset)
+ || ((eventPtr->xexpose.x + eventPtr->xexpose.width)
+ > (Tk_Width(canvasPtr->tkwin) - canvasPtr->inset))
+ || ((eventPtr->xexpose.y + eventPtr->xexpose.height)
+ > (Tk_Height(canvasPtr->tkwin) - canvasPtr->inset))) {
+ canvasPtr->flags |= REDRAW_BORDERS;
+ }
+ } else if (eventPtr->type == DestroyNotify) {
+ if (canvasPtr->tkwin != NULL) {
+ canvasPtr->tkwin = NULL;
+ Tcl_DeleteCommandFromToken(canvasPtr->interp,
+ canvasPtr->widgetCmd);
+ }
+ if (canvasPtr->flags & REDRAW_PENDING) {
+ Tcl_CancelIdleCall(DisplayCanvas, canvasPtr);
+ }
+ Tcl_EventuallyFree(canvasPtr, (Tcl_FreeProc *) DestroyCanvas);
+ } else if (eventPtr->type == ConfigureNotify) {
+ canvasPtr->flags |= UPDATE_SCROLLBARS;
+
+ /*
+ * The call below is needed in order to recenter the canvas if it's
+ * confined and its scroll region is smaller than the window.
+ */
+
+ CanvasSetOrigin(canvasPtr, canvasPtr->xOrigin, canvasPtr->yOrigin);
+ Tk_CanvasEventuallyRedraw((Tk_Canvas) canvasPtr, canvasPtr->xOrigin,
+ canvasPtr->yOrigin,
+ canvasPtr->xOrigin + Tk_Width(canvasPtr->tkwin),
+ canvasPtr->yOrigin + Tk_Height(canvasPtr->tkwin));
+ canvasPtr->flags |= REDRAW_BORDERS;
+ } else if (eventPtr->type == FocusIn) {
+ if (eventPtr->xfocus.detail != NotifyInferior) {
+ CanvasFocusProc(canvasPtr, 1);
+ }
+ } else if (eventPtr->type == FocusOut) {
+ if (eventPtr->xfocus.detail != NotifyInferior) {
+ CanvasFocusProc(canvasPtr, 0);
+ }
+ } else if (eventPtr->type == UnmapNotify) {
+ Tk_Item *itemPtr;
+
+ /*
+ * Special hack: if the canvas is unmapped, then must notify all items
+ * with "alwaysRedraw" set, so that they know that they are no longer
+ * displayed.
+ */
+
+ for (itemPtr = canvasPtr->firstItemPtr; itemPtr != NULL;
+ itemPtr = itemPtr->nextPtr) {
+ if (AlwaysRedraw(itemPtr)) {
+ ItemDisplay(canvasPtr, itemPtr, None, 0, 0, 0, 0);
+ }
+ }
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * CanvasCmdDeletedProc --
+ *
+ * This function is invoked when a widget command is deleted. If the
+ * widget isn't already in the process of being destroyed, this command
+ * destroys it.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The widget is destroyed.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+CanvasCmdDeletedProc(
+ ClientData clientData) /* Pointer to widget record for widget. */
+{
+ TkCanvas *canvasPtr = clientData;
+ Tk_Window tkwin = canvasPtr->tkwin;
+
+ /*
+ * This function 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 function destroys the
+ * widget.
+ */
+
+ if (tkwin != NULL) {
+ canvasPtr->tkwin = NULL;
+ Tk_DestroyWindow(tkwin);
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_CanvasEventuallyRedraw --
+ *
+ * Arrange for part or all of a canvas widget to redrawn at some
+ * convenient time in the future.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The screen will eventually be refreshed.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tk_CanvasEventuallyRedraw(
+ Tk_Canvas canvas, /* Information about widget. */
+ int x1, int y1, /* Upper left corner of area to redraw. Pixels
+ * on edge are redrawn. */
+ int x2, int y2) /* Lower right corner of area to redraw.
+ * Pixels on edge are not redrawn. */
+{
+ TkCanvas *canvasPtr = Canvas(canvas);
+
+ /*
+ * If tkwin is NULL, the canvas has been destroyed, so we can't really
+ * redraw it.
+ */
+
+ if (canvasPtr->tkwin == NULL) {
+ return;
+ }
+
+ if ((x1 >= x2) || (y1 >= y2) ||
+ (x2 < canvasPtr->xOrigin) || (y2 < canvasPtr->yOrigin) ||
+ (x1 >= canvasPtr->xOrigin + Tk_Width(canvasPtr->tkwin)) ||
+ (y1 >= canvasPtr->yOrigin + Tk_Height(canvasPtr->tkwin))) {
+ return;
+ }
+ if (canvasPtr->flags & BBOX_NOT_EMPTY) {
+ if (x1 <= canvasPtr->redrawX1) {
+ canvasPtr->redrawX1 = x1;
+ }
+ if (y1 <= canvasPtr->redrawY1) {
+ canvasPtr->redrawY1 = y1;
+ }
+ if (x2 >= canvasPtr->redrawX2) {
+ canvasPtr->redrawX2 = x2;
+ }
+ if (y2 >= canvasPtr->redrawY2) {
+ canvasPtr->redrawY2 = y2;
+ }
+ } else {
+ canvasPtr->redrawX1 = x1;
+ canvasPtr->redrawY1 = y1;
+ canvasPtr->redrawX2 = x2;
+ canvasPtr->redrawY2 = y2;
+ canvasPtr->flags |= BBOX_NOT_EMPTY;
+ }
+ if (!(canvasPtr->flags & REDRAW_PENDING)) {
+ Tcl_DoWhenIdle(DisplayCanvas, 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(
+ TkCanvas *canvasPtr, /* Information about widget. */
+ Tk_Item *itemPtr) /* Item to be redrawn. May be NULL, in which
+ * case nothing happens. */
+{
+ if (itemPtr == NULL) {
+ return;
+ }
+ 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 (!AlwaysRedraw(itemPtr)) {
+ 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, canvasPtr);
+ canvasPtr->flags |= REDRAW_PENDING;
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_CreateItemType --
+ *
+ * This function may be invoked to add a new kind of canvas element to
+ * the core item types supported by Tk.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * From now on, the new item type will be useable in canvas widgets
+ * (e.g. typePtr->name can be used as the item type in "create" widget
+ * commands). If there was already a type with the same name as in
+ * typePtr, it is replaced with the new type.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tk_CreateItemType(
+ Tk_ItemType *typePtr) /* Information about item type; storage must
+ * be statically allocated (must live
+ * forever). */
+{
+ Tk_ItemType *typePtr2, *prevPtr;
+
+ if (typeList == NULL) {
+ InitCanvas();
+ }
+
+ /*
+ * If there's already an item type with the given name, remove it.
+ */
+
+ Tcl_MutexLock(&typeListMutex);
+ for (typePtr2 = typeList, prevPtr = NULL; typePtr2 != NULL;
+ prevPtr = typePtr2, typePtr2 = typePtr2->nextPtr) {
+ if (strcmp(typePtr2->name, typePtr->name) == 0) {
+ if (prevPtr == NULL) {
+ typeList = typePtr2->nextPtr;
+ } else {
+ prevPtr->nextPtr = typePtr2->nextPtr;
+ }
+ break;
+ }
+ }
+ typePtr->nextPtr = typeList;
+ typeList = typePtr;
+ Tcl_MutexUnlock(&typeListMutex);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_GetItemTypes --
+ *
+ * This function returns a pointer to the list of all item types. Note
+ * that this is inherently thread-unsafe, but since item types are only
+ * ever registered very rarely this is unlikely to be a problem in
+ * practice.
+ *
+ * Results:
+ * The return value is a pointer to the first in the list of item types
+ * currently supported by canvases.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+Tk_ItemType *
+Tk_GetItemTypes(void)
+{
+ if (typeList == NULL) {
+ InitCanvas();
+ }
+ return typeList;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * InitCanvas --
+ *
+ * This function is invoked to perform once-only-ever initialization for
+ * the module, such as setting up the type table.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+InitCanvas(void)
+{
+ Tcl_MutexLock(&typeListMutex);
+ if (typeList != NULL) {
+ Tcl_MutexUnlock(&typeListMutex);
+ return;
+ }
+ typeList = &tkRectangleType;
+ tkRectangleType.nextPtr = &tkTextType;
+ tkTextType.nextPtr = &tkLineType;
+ tkLineType.nextPtr = &tkPolygonType;
+ tkPolygonType.nextPtr = &tkImageType;
+ tkImageType.nextPtr = &tkOvalType;
+ tkOvalType.nextPtr = &tkBitmapType;
+ tkBitmapType.nextPtr = &tkArcType;
+ tkArcType.nextPtr = &tkWindowType;
+ tkWindowType.nextPtr = NULL;
+ Tcl_MutexUnlock(&typeListMutex);
+}
+
+#ifdef USE_OLD_TAG_SEARCH
+/*
+ *--------------------------------------------------------------
+ *
+ * StartTagSearch --
+ *
+ * This function is called to initiate an enumeration of all items in a
+ * given canvas that contain a given tag.
+ *
+ * Results:
+ * The return value is a pointer to the first item in canvasPtr that
+ * matches tag, or NULL if there is no such item. The information at
+ * *searchPtr is initialized such that successive calls to NextItem will
+ * return successive items that match tag.
+ *
+ * Side effects:
+ * SearchPtr is linked into a list of searches in progress on canvasPtr,
+ * so that elements can safely be deleted while the search is in
+ * progress. EndTagSearch must be called at the end of the search to
+ * unlink searchPtr from this list.
+ *
+ *--------------------------------------------------------------
+ */
+
+static Tk_Item *
+StartTagSearch(
+ TkCanvas *canvasPtr, /* Canvas whose items are to be searched. */
+ Tcl_Obj *tagObj, /* Object giving tag value. */
+ TagSearch *searchPtr) /* Record describing tag search; will be
+ * initialized here. */
+{
+ int id;
+ Tk_Item *itemPtr, *lastPtr;
+ Tk_Uid *tagPtr;
+ Tk_Uid uid;
+ char *tag = Tcl_GetString(tagObj);
+ int count;
+ TkWindow *tkwin = (TkWindow *) canvasPtr->tkwin;
+ TkDisplay *dispPtr = tkwin->dispPtr;
+
+ /*
+ * Initialize the search.
+ */
+
+ searchPtr->canvasPtr = canvasPtr;
+ searchPtr->searchOver = 0;
+
+ /*
+ * Find the first matching item in one of several ways. If the tag is a
+ * number then it selects the single item with the matching identifier.
+ * In this case see if the item being requested is the hot item, in which
+ * case the search can be skipped.
+ */
+
+ if (isdigit(UCHAR(*tag))) {
+ char *end;
+ Tcl_HashEntry *entryPtr;
+
+ dispPtr->numIdSearches++;
+ id = strtoul(tag, &end, 0);
+ if (*end == 0) {
+ itemPtr = canvasPtr->hotPtr;
+ lastPtr = canvasPtr->hotPrevPtr;
+ if ((itemPtr == NULL) || (itemPtr->id != id) || (lastPtr == NULL)
+ || (lastPtr->nextPtr != itemPtr)) {
+ dispPtr->numSlowSearches++;
+ entryPtr = Tcl_FindHashEntry(&canvasPtr->idTable, (char*) id);
+ if (entryPtr != NULL) {
+ itemPtr = Tcl_GetHashValue(entryPtr);
+ lastPtr = itemPtr->prevPtr;
+ } else {
+ lastPtr = itemPtr = NULL;
+ }
+ }
+ searchPtr->lastPtr = lastPtr;
+ searchPtr->searchOver = 1;
+ canvasPtr->hotPtr = itemPtr;
+ canvasPtr->hotPrevPtr = lastPtr;
+ return itemPtr;
+ }
+ }
+
+ searchPtr->tag = uid = Tk_GetUid(tag);
+ if (uid == Tk_GetUid("all")) {
+ /*
+ * All items match.
+ */
+
+ searchPtr->tag = NULL;
+ searchPtr->lastPtr = NULL;
+ searchPtr->currentPtr = canvasPtr->firstItemPtr;
+ return canvasPtr->firstItemPtr;
+ }
+
+ /*
+ * None of the above. Search for an item with a matching tag.
+ */
+
+ for (lastPtr = NULL, itemPtr = canvasPtr->firstItemPtr; itemPtr != NULL;
+ lastPtr = itemPtr, itemPtr = itemPtr->nextPtr) {
+ for (tagPtr = itemPtr->tagPtr, count = itemPtr->numTags;
+ count > 0; tagPtr++, count--) {
+ if (*tagPtr == uid) {
+ searchPtr->lastPtr = lastPtr;
+ searchPtr->currentPtr = itemPtr;
+ return itemPtr;
+ }
+ }
+ }
+ searchPtr->lastPtr = lastPtr;
+ searchPtr->searchOver = 1;
+ return NULL;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * NextItem --
+ *
+ * This function returns successive items that match a given tag; it
+ * should be called only after StartTagSearch has been used to begin a
+ * search.
+ *
+ * Results:
+ * The return value is a pointer to the next item that matches the tag
+ * specified to StartTagSearch, or NULL if no such item exists.
+ * *SearchPtr is updated so that the next call to this function will
+ * return the next item.
+ *
+ * Side effects:
+ * None.
+ *
+ *--------------------------------------------------------------
+ */
+
+static Tk_Item *
+NextItem(
+ TagSearch *searchPtr) /* Record describing search in progress. */
+{
+ Tk_Item *itemPtr, *lastPtr;
+ int count;
+ Tk_Uid uid;
+ Tk_Uid *tagPtr;
+
+ /*
+ * Find next item in list (this may not actually be a suitable one to
+ * return), and return if there are no items left.
+ */
+
+ lastPtr = searchPtr->lastPtr;
+ if (lastPtr == NULL) {
+ itemPtr = searchPtr->canvasPtr->firstItemPtr;
+ } else {
+ itemPtr = lastPtr->nextPtr;
+ }
+ if ((itemPtr == NULL) || (searchPtr->searchOver)) {
+ searchPtr->searchOver = 1;
+ return NULL;
+ }
+ if (itemPtr != searchPtr->currentPtr) {
+ /*
+ * The structure of the list has changed. Probably the previously-
+ * returned item was removed from the list. In this case, don't
+ * advance lastPtr; just return its new successor (i.e. do nothing
+ * here).
+ */
+ } else {
+ lastPtr = itemPtr;
+ itemPtr = lastPtr->nextPtr;
+ }
+
+ /*
+ * Handle special case of "all" search by returning next item.
+ */
+
+ uid = searchPtr->tag;
+ if (uid == NULL) {
+ searchPtr->lastPtr = lastPtr;
+ searchPtr->currentPtr = itemPtr;
+ return itemPtr;
+ }
+
+ /*
+ * Look for an item with a particular tag.
+ */
+
+ for ( ; itemPtr != NULL; lastPtr = itemPtr, itemPtr = itemPtr->nextPtr) {
+ for (tagPtr = itemPtr->tagPtr, count = itemPtr->numTags;
+ count > 0; tagPtr++, count--) {
+ if (*tagPtr == uid) {
+ searchPtr->lastPtr = lastPtr;
+ searchPtr->currentPtr = itemPtr;
+ return itemPtr;
+ }
+ }
+ }
+ searchPtr->lastPtr = lastPtr;
+ searchPtr->searchOver = 1;
+ return NULL;
+}
+
+#else /* !USE_OLD_TAG_SEARCH */
+/*
+ *----------------------------------------------------------------------
+ *
+ * GetStaticUids --
+ *
+ * This function is invoked to return a structure filled with the Uids
+ * used when doing tag searching. If it was never before called in the
+ * current thread, it initializes the structure for that thread (uids are
+ * only ever local to one thread [Bug 1114977]).
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static SearchUids *
+GetStaticUids(void)
+{
+ SearchUids *searchUids =
+ Tcl_GetThreadData(&dataKey, sizeof(SearchUids));
+
+ if (searchUids->allUid == NULL) {
+ searchUids->allUid = Tk_GetUid("all");
+ searchUids->currentUid = Tk_GetUid("current");
+ searchUids->andUid = Tk_GetUid("&&");
+ searchUids->orUid = Tk_GetUid("||");
+ searchUids->xorUid = Tk_GetUid("^");
+ searchUids->parenUid = Tk_GetUid("(");
+ searchUids->endparenUid = Tk_GetUid(")");
+ searchUids->negparenUid = Tk_GetUid("!(");
+ searchUids->tagvalUid = Tk_GetUid("!!");
+ searchUids->negtagvalUid = Tk_GetUid("!");
+ }
+ return searchUids;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * TagSearchExprInit --
+ *
+ * This function allocates and initializes one TagSearchExpr struct.
+ *
+ * Results:
+ *
+ * Side effects:
+ *
+ *--------------------------------------------------------------
+ */
+
+static void
+TagSearchExprInit(
+ TagSearchExpr **exprPtrPtr)
+{
+ TagSearchExpr *expr = *exprPtrPtr;
+
+ if (expr == NULL) {
+ expr = 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 function destroys one TagSearchExpr structure.
+ *
+ * Results:
+ *
+ * Side effects:
+ *
+ *--------------------------------------------------------------
+ */
+
+static void
+TagSearchExprDestroy(
+ TagSearchExpr *expr)
+{
+ if (expr != NULL) {
+ if (expr->uids) {
+ ckfree(expr->uids);
+ }
+ ckfree(expr);
+ }
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * TagSearchScan --
+ *
+ * This function 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(
+ 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. */
+{
+ const char *tag = Tcl_GetString(tagObj);
+ int i;
+ TagSearch *searchPtr;
+
+ /*
+ * Initialize the search.
+ */
+
+ if (*searchPtrPtr != NULL) {
+ searchPtr = *searchPtrPtr;
+ } else {
+ /*
+ * Allocate primary search struct on first call.
+ */
+
+ *searchPtrPtr = searchPtr = 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) 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 = SEARCH_TYPE_EMPTY;
+
+ /*
+ * 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 = SEARCH_TYPE_ID;
+ 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 = SEARCH_TYPE_EXPR;
+ break;
+ }
+ }
+
+ searchPtr->string = tag;
+ searchPtr->stringIndex = 0;
+ if (searchPtr->type == SEARCH_TYPE_EXPR) {
+ /*
+ * 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. The result message was set by
+ * TagSearchScanExpr.
+ */
+
+ return TCL_ERROR;
+ }
+ searchPtr->expr->length = searchPtr->expr->index;
+ } else if (searchPtr->expr->uid == GetStaticUids()->allUid) {
+ /*
+ * All items match.
+ */
+
+ searchPtr->type = SEARCH_TYPE_ALL;
+ } else {
+ /*
+ * Optimized single-tag search
+ */
+
+ searchPtr->type = SEARCH_TYPE_TAG;
+ }
+ return TCL_OK;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * TagSearchDestroy --
+ *
+ * This function destroys any dynamic structures that may have been
+ * allocated by TagSearchScan.
+ *
+ * Results:
+ * None
+ *
+ * Side effects:
+ * Deallocates memory.
+ *
+ *--------------------------------------------------------------
+ */
+
+static void
+TagSearchDestroy(
+ TagSearch *searchPtr) /* Record describing tag search. */
+{
+ if (searchPtr) {
+ TagSearchExprDestroy(searchPtr->expr);
+ ckfree(searchPtr->rewritebuffer);
+ ckfree(searchPtr);
+ }
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * TagSearchScanExpr --
+ *
+ * This recursive function 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(
+ 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;
+ SearchUids *searchUids; /* Collection of uids for basic search
+ * expression terms. */
+
+ searchUids = GetStaticUids();
+ negate_result = 0;
+ found_tag = 0;
+ looking_for_tag = 1;
+ while (searchPtr->stringIndex < searchPtr->stringLength) {
+ c = searchPtr->string[searchPtr->stringIndex++];
+
+ /*
+ * Need two slots free at this point, not one. [Bug 2931374]
+ */
+
+ if (expr->index >= expr->allocated-1) {
+ expr->allocated += 15;
+ if (expr->uids) {
+ expr->uids = ckrealloc(expr->uids,
+ expr->allocated * sizeof(Tk_Uid));
+ } else {
+ expr->uids = 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_SetObjResult(interp, Tcl_NewStringObj(
+ "too many '!' in tag search expression", -1));
+ Tcl_SetErrorCode(interp, "TK", "CANVAS", "SEARCH",
+ "COMPLEXITY", NULL);
+ return TCL_ERROR;
+ }
+ looking_for_tag++;
+ negate_result = 1;
+ break;
+
+ case '(': /* Scan (negated) subexpr recursively */
+ if (negate_result) {
+ expr->uids[expr->index++] = searchUids->negparenUid;
+ negate_result = 0;
+ } else {
+ expr->uids[expr->index++] = searchUids->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++] = searchUids->negtagvalUid;
+ negate_result = 0;
+ } else {
+ expr->uids[expr->index++] = searchUids->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_SetObjResult(interp, Tcl_NewStringObj(
+ "missing endquote in tag search expression", -1));
+ Tcl_SetErrorCode(interp, "TK", "CANVAS", "SEARCH",
+ "ENDQUOTE", NULL);
+ return TCL_ERROR;
+ }
+ if (!(tag - searchPtr->rewritebuffer)) {
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "null quoted tag string in tag search expression",
+ -1));
+ Tcl_SetErrorCode(interp, "TK", "CANVAS", "SEARCH",
+ "EMPTY", 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_SetObjResult(interp, Tcl_NewStringObj(
+ "unexpected operator in tag search expression", -1));
+ Tcl_SetErrorCode(interp, "TK", "CANVAS", "SEARCH",
+ "UNEXPECTED", NULL);
+ return TCL_ERROR;
+
+ default: /* Unquoted tag string */
+ if (negate_result) {
+ expr->uids[expr->index++] = searchUids->negtagvalUid;
+ negate_result = 0;
+ } else {
+ expr->uids[expr->index++] = searchUids->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_SetObjResult(interp, Tcl_NewStringObj(
+ "singleton '&' in tag search expression", -1));
+ Tcl_SetErrorCode(interp, "TK", "CANVAS", "SEARCH",
+ "INCOMPLETE_OP", NULL);
+ return TCL_ERROR;
+ }
+ expr->uids[expr->index++] = searchUids->andUid;
+ looking_for_tag = 1;
+ break;
+
+ case '|': /* OR operator */
+ c = searchPtr->string[searchPtr->stringIndex++];
+ if (c != '|') {
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "singleton '|' in tag search expression", -1));
+ Tcl_SetErrorCode(interp, "TK", "CANVAS", "SEARCH",
+ "INCOMPLETE_OP", NULL);
+ return TCL_ERROR;
+ }
+ expr->uids[expr->index++] = searchUids->orUid;
+ looking_for_tag = 1;
+ break;
+
+ case '^': /* XOR operator */
+ expr->uids[expr->index++] = searchUids->xorUid;
+ looking_for_tag = 1;
+ break;
+
+ case ')': /* End subexpression */
+ expr->uids[expr->index++] = searchUids->endparenUid;
+ goto breakwhile;
+
+ default: /* syntax error */
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "invalid boolean operator in tag search expression",
+ -1));
+ Tcl_SetErrorCode(interp, "TK", "CANVAS", "SEARCH", "BAD_OP",
+ NULL);
+ return TCL_ERROR;
+ }
+ }
+ }
+
+ breakwhile:
+ if (found_tag && !looking_for_tag) {
+ return TCL_OK;
+ }
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "missing tag in tag search expression", -1));
+ Tcl_SetErrorCode(interp, "TK", "CANVAS", "SEARCH", "NO_TAG", NULL);
+ return TCL_ERROR;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * TagSearchEvalExpr --
+ *
+ * This recursive function 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(
+ 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;
+ SearchUids *searchUids; /* Collection of uids for basic search
+ * expression terms. */
+
+ searchUids = GetStaticUids();
+ 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 == searchUids->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 == searchUids->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 == searchUids->parenUid) {
+ /*
+ * Evaluate subexpressions with recursion.
+ */
+
+ result = TagSearchEvalExpr(expr, itemPtr);
+
+ } else if (uid == searchUids->negparenUid) {
+ negate_result = !negate_result;
+
+ /*
+ * Evaluate subexpressions with recursion.
+ */
+
+ result = TagSearchEvalExpr(expr, itemPtr);
+ }
+ if (negate_result) {
+ result = ! result;
+ negate_result = 0;
+ }
+ looking_for_tag = 0;
+ } else { /* ! looking_for_tag */
+ if (((uid == searchUids->andUid) && (!result)) ||
+ ((uid == searchUids->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 == searchUids->tagvalUid ||
+ uid == searchUids->negtagvalUid) {
+ expr->index++;
+ continue;
+ }
+ if (uid == searchUids->parenUid ||
+ uid == searchUids->negparenUid) {
+ parendepth++;
+ continue;
+ }
+ if (uid == searchUids->endparenUid) {
+ parendepth--;
+ if (parendepth < 0) {
+ break;
+ }
+ }
+ }
+ return result;
+
+ } else if (uid == searchUids->xorUid) {
+ /*
+ * If the previous result was 1 then negate the next result.
+ */
+
+ negate_result = result;
+
+ } else if (uid == searchUids->endparenUid) {
+ return result;
+ }
+ looking_for_tag = 1;
+ }
+ }
+/*
+ * assert(!looking_for_tag);
+ */
+ return result;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * TagSearchFirst --
+ *
+ * This function 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(
+ 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 == SEARCH_TYPE_ID) {
+ 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 *) INT2PTR(searchPtr->id));
+ if (entryPtr != NULL) {
+ itemPtr = 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 == SEARCH_TYPE_ALL) {
+ /*
+ * All items match.
+ */
+
+ searchPtr->lastPtr = NULL;
+ searchPtr->currentPtr = searchPtr->canvasPtr->firstItemPtr;
+ return searchPtr->canvasPtr->firstItemPtr;
+ }
+
+ if (searchPtr->type == SEARCH_TYPE_TAG) {
+ /*
+ * 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 function 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 function will
+ * return the next item.
+ *
+ * Side effects:
+ * None.
+ *
+ *--------------------------------------------------------------
+ */
+
+static Tk_Item *
+TagSearchNext(
+ 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 == SEARCH_TYPE_ALL) {
+ /*
+ * All items match.
+ */
+
+ searchPtr->lastPtr = lastPtr;
+ searchPtr->currentPtr = itemPtr;
+ return itemPtr;
+ }
+
+ if (searchPtr->type == SEARCH_TYPE_TAG) {
+ /*
+ * Optimized single-tag search
+ */
+
+ uid = searchPtr->expr->uid;
+ for (; itemPtr != NULL; lastPtr = itemPtr, itemPtr = itemPtr->nextPtr) {
+ for (tagPtr = itemPtr->tagPtr, count = itemPtr->numTags;
+ count > 0; tagPtr++, count--) {
+ if (*tagPtr == uid) {
+ searchPtr->lastPtr = lastPtr;
+ searchPtr->currentPtr = itemPtr;
+ return itemPtr;
+ }
+ }
+ }
+ searchPtr->lastPtr = lastPtr;
+ searchPtr->searchOver = 1;
+ return NULL;
+ }
+
+ /*
+ * Else.... evaluate tag expression
+ */
+
+ for ( ; itemPtr != NULL; lastPtr = itemPtr, itemPtr = itemPtr->nextPtr) {
+ searchPtr->expr->index = 0;
+ if (TagSearchEvalExpr(searchPtr->expr, itemPtr)) {
+ searchPtr->lastPtr = lastPtr;
+ searchPtr->currentPtr = itemPtr;
+ return itemPtr;
+ }
+ }
+ searchPtr->lastPtr = lastPtr;
+ searchPtr->searchOver = 1;
+ return NULL;
+}
+#endif /* USE_OLD_TAG_SEARCH */
+
+/*
+ *--------------------------------------------------------------
+ *
+ * DoItem --
+ *
+ * This is a utility function called by FindItems. It either adds
+ * itemPtr's id to the list being constructed, or it adds a new tag to
+ * itemPtr, depending on the value of tag.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * If tag is NULL then itemPtr's id is added as an element to the
+ * supplied object; otherwise tag is added to itemPtr's list of tags.
+ *
+ *--------------------------------------------------------------
+ */
+
+static void
+DoItem(
+ Tcl_Obj *accumObj, /* Object in which to (possibly) record item
+ * id. */
+ Tk_Item *itemPtr, /* Item to (possibly) modify. */
+ Tk_Uid tag) /* Tag to add to those already present for
+ * item, or NULL. */
+{
+ Tk_Uid *tagPtr;
+ int count;
+
+ /*
+ * Handle the "add-to-result" case and return, if appropriate.
+ */
+
+ if (tag == NULL) {
+ Tcl_ListObjAppendElement(NULL, accumObj, Tcl_NewIntObj(itemPtr->id));
+ return;
+ }
+
+ for (tagPtr = itemPtr->tagPtr, count = itemPtr->numTags;
+ count > 0; tagPtr++, count--) {
+ if (tag == *tagPtr) {
+ return;
+ }
+ }
+
+ /*
+ * Grow the tag space if there's no more room left in the current block.
+ */
+
+ if (itemPtr->tagSpace == itemPtr->numTags) {
+ Tk_Uid *newTagPtr;
+
+ itemPtr->tagSpace += 5;
+ newTagPtr = ckalloc(itemPtr->tagSpace * sizeof(Tk_Uid));
+ memcpy((void *) newTagPtr, itemPtr->tagPtr,
+ itemPtr->numTags * sizeof(Tk_Uid));
+ if (itemPtr->tagPtr != itemPtr->staticTagSpace) {
+ ckfree(itemPtr->tagPtr);
+ }
+ itemPtr->tagPtr = newTagPtr;
+ tagPtr = &itemPtr->tagPtr[itemPtr->numTags];
+ }
+
+ /*
+ * Add in the new tag.
+ */
+
+ *tagPtr = tag;
+ itemPtr->numTags++;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * FindItems --
+ *
+ * This function does all the work of implementing the "find" and
+ * "addtag" options of the canvas widget command, which locate items that
+ * have certain features (location, tags, position in display list, etc.)
+ *
+ * Results:
+ * A standard Tcl return value. If newTag is NULL, then a list of ids
+ * from all the items that match objc/objv is returned in the interp's
+ * result. If newTag is NULL, then the normal the interp's result is an
+ * empty string. If an error occurs, then the interp's result will hold
+ * an error message.
+ *
+ * Side effects:
+ * If newTag is non-NULL, then all the items that match the information
+ * in objc/objv have that tag added to their lists of tags.
+ *
+ *--------------------------------------------------------------
+ */
+
+static int
+FindItems(
+ Tcl_Interp *interp, /* Interpreter for error reporting. */
+ TkCanvas *canvasPtr, /* Canvas whose items are to be searched. */
+ int objc, /* Number of entries in argv. Must be greater
+ * than zero. */
+ Tcl_Obj *const *objv, /* Arguments that describe what items to
+ * search for (see user doc on "find" and
+ * "addtag" options). */
+ Tcl_Obj *newTag, /* If non-NULL, gives new tag to set on all
+ * found items; if NULL, then ids of found
+ * items are returned in the interp's
+ * result. */
+ int first /* For error messages: gives number of
+ * elements of objv which are already
+ * handled. */
+#ifndef USE_OLD_TAG_SEARCH
+ ,TagSearch **searchPtrPtr /* From CanvasWidgetCmd local vars*/
+#endif /* not USE_OLD_TAG_SEARCH */
+ )
+{
+#ifdef USE_OLD_TAG_SEARCH
+ TagSearch search;
+#endif /* USE_OLD_TAG_SEARCH */
+ Tk_Item *itemPtr;
+ Tk_Uid uid;
+ int index, result;
+ Tcl_Obj *resultObj;
+ static const char *const optionStrings[] = {
+ "above", "all", "below", "closest",
+ "enclosed", "overlapping", "withtag", NULL
+ };
+ enum options {
+ CANV_ABOVE, CANV_ALL, CANV_BELOW, CANV_CLOSEST,
+ CANV_ENCLOSED, CANV_OVERLAPPING, CANV_WITHTAG
+ };
+
+ if (newTag != NULL) {
+ uid = Tk_GetUid(Tcl_GetString(newTag));
+ } else {
+ uid = NULL;
+ }
+ if (Tcl_GetIndexFromObj(interp, objv[first], optionStrings,
+ "search command", 0, &index) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ switch ((enum options) index) {
+ case CANV_ABOVE: {
+ Tk_Item *lastPtr = NULL;
+
+ if (objc != first+2) {
+ Tcl_WrongNumArgs(interp, first+1, objv, "tagOrId");
+ return TCL_ERROR;
+ }
+ FOR_EVERY_CANVAS_ITEM_MATCHING(objv[first+1], searchPtrPtr,
+ return TCL_ERROR) {
+ lastPtr = itemPtr;
+ }
+ if ((lastPtr != NULL) && (lastPtr->nextPtr != NULL)) {
+ resultObj = Tcl_NewObj();
+ DoItem(resultObj, lastPtr->nextPtr, uid);
+ Tcl_SetObjResult(interp, resultObj);
+ }
+ break;
+ }
+ case CANV_ALL:
+ if (objc != first+1) {
+ Tcl_WrongNumArgs(interp, first+1, objv, NULL);
+ return TCL_ERROR;
+ }
+
+ resultObj = Tcl_NewObj();
+ for (itemPtr = canvasPtr->firstItemPtr; itemPtr != NULL;
+ itemPtr = itemPtr->nextPtr) {
+ DoItem(resultObj, itemPtr, uid);
+ }
+ Tcl_SetObjResult(interp, resultObj);
+ break;
+
+ case CANV_BELOW:
+ if (objc != first+2) {
+ Tcl_WrongNumArgs(interp, first+1, objv, "tagOrId");
+ return TCL_ERROR;
+ }
+ FIRST_CANVAS_ITEM_MATCHING(objv[first+1], searchPtrPtr,
+ return TCL_ERROR);
+ if ((itemPtr != NULL) && (itemPtr->prevPtr != NULL)) {
+ resultObj = Tcl_NewObj();
+ DoItem(resultObj, itemPtr->prevPtr, uid);
+ Tcl_SetObjResult(interp, resultObj);
+ }
+ break;
+ case CANV_CLOSEST: {
+ double closestDist;
+ Tk_Item *startPtr, *closestPtr;
+ double coords[2], halo;
+ int x1, y1, x2, y2;
+
+ if ((objc < first+3) || (objc > first+5)) {
+ Tcl_WrongNumArgs(interp, first+1, objv, "x y ?halo? ?start?");
+ return TCL_ERROR;
+ }
+ if (Tk_CanvasGetCoordFromObj(interp, (Tk_Canvas) canvasPtr,
+ objv[first+1], &coords[0]) != TCL_OK
+ || Tk_CanvasGetCoordFromObj(interp, (Tk_Canvas) canvasPtr,
+ objv[first+2], &coords[1]) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (objc > first+3) {
+ if (Tk_CanvasGetCoordFromObj(interp, (Tk_Canvas) canvasPtr,
+ objv[first+3], &halo) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (halo < 0.0) {
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "can't have negative halo value \"%f\"", halo));
+ return TCL_ERROR;
+ }
+ } else {
+ halo = 0.0;
+ }
+
+ /*
+ * Find the item at which to start the search.
+ */
+
+ startPtr = canvasPtr->firstItemPtr;
+ if (objc == first+5) {
+ FIRST_CANVAS_ITEM_MATCHING(objv[first+4], searchPtrPtr,
+ return TCL_ERROR);
+ if (itemPtr != NULL) {
+ startPtr = itemPtr;
+ }
+ }
+
+ /*
+ * The code below is optimized so that it can eliminate most items
+ * without having to call their item-specific functions. This is done
+ * by keeping a bounding box (x1, y1, x2, y2) that an item's bbox must
+ * overlap if the item is to have any chance of being closer than the
+ * closest so far.
+ */
+
+ itemPtr = startPtr;
+ while(itemPtr && (itemPtr->state == TK_STATE_HIDDEN ||
+ (itemPtr->state == TK_STATE_NULL &&
+ canvasPtr->canvas_state == TK_STATE_HIDDEN))) {
+ itemPtr = itemPtr->nextPtr;
+ }
+ if (itemPtr == NULL) {
+ return TCL_OK;
+ }
+ closestDist = ItemPoint(canvasPtr, itemPtr, coords, halo);
+ while (1) {
+ double newDist;
+
+ /*
+ * Update the bounding box using itemPtr, which is the new closest
+ * item.
+ */
+
+ x1 = (int) (coords[0] - closestDist - halo - 1);
+ y1 = (int) (coords[1] - closestDist - halo - 1);
+ x2 = (int) (coords[0] + closestDist + halo + 1);
+ y2 = (int) (coords[1] + closestDist + halo + 1);
+ closestPtr = itemPtr;
+
+ /*
+ * Search for an item that beats the current closest one. Work
+ * circularly through the canvas's item list until getting back to
+ * the starting item.
+ */
+
+ while (1) {
+ itemPtr = itemPtr->nextPtr;
+ if (itemPtr == NULL) {
+ itemPtr = canvasPtr->firstItemPtr;
+ }
+ if (itemPtr == startPtr) {
+ resultObj = Tcl_NewObj();
+ DoItem(resultObj, closestPtr, uid);
+ Tcl_SetObjResult(interp, resultObj);
+ return TCL_OK;
+ }
+ if (itemPtr->state == TK_STATE_HIDDEN ||
+ (itemPtr->state == TK_STATE_NULL &&
+ canvasPtr->canvas_state == TK_STATE_HIDDEN)) {
+ continue;
+ }
+ if ((itemPtr->x1 >= x2) || (itemPtr->x2 <= x1)
+ || (itemPtr->y1 >= y2) || (itemPtr->y2 <= y1)) {
+ continue;
+ }
+ newDist = ItemPoint(canvasPtr, itemPtr, coords, halo);
+ if (newDist <= closestDist) {
+ closestDist = newDist;
+ break;
+ }
+ }
+ }
+ break;
+ }
+ case CANV_ENCLOSED:
+ if (objc != first+5) {
+ Tcl_WrongNumArgs(interp, first+1, objv, "x1 y1 x2 y2");
+ return TCL_ERROR;
+ }
+ return FindArea(interp, canvasPtr, objv+first+1, uid, 1);
+ case CANV_OVERLAPPING:
+ if (objc != first+5) {
+ Tcl_WrongNumArgs(interp, first+1, objv, "x1 y1 x2 y2");
+ return TCL_ERROR;
+ }
+ return FindArea(interp, canvasPtr, objv+first+1, uid, 0);
+ case CANV_WITHTAG:
+ if (objc != first+2) {
+ Tcl_WrongNumArgs(interp, first+1, objv, "tagOrId");
+ return TCL_ERROR;
+ }
+ resultObj = Tcl_NewObj();
+ FOR_EVERY_CANVAS_ITEM_MATCHING(objv[first+1], searchPtrPtr,
+ goto badWithTagSearch) {
+ DoItem(resultObj, itemPtr, uid);
+ }
+ Tcl_SetObjResult(interp, resultObj);
+ return TCL_OK;
+ badWithTagSearch:
+ Tcl_DecrRefCount(resultObj);
+ return TCL_ERROR;
+ }
+ return TCL_OK;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * FindArea --
+ *
+ * This function implements area searches for the "find" and "addtag"
+ * options.
+ *
+ * Results:
+ * A standard Tcl return value. If newTag is NULL, then a list of ids
+ * from all the items overlapping or enclosed by the rectangle given by
+ * objc is returned in the interp's result. If newTag is NULL, then the
+ * normal the interp's result is an empty string. If an error occurs,
+ * then the interp's result will hold an error message.
+ *
+ * Side effects:
+ * If uid is non-NULL, then all the items overlapping or enclosed by the
+ * area in objv have that tag added to their lists of tags.
+ *
+ *--------------------------------------------------------------
+ */
+
+static int
+FindArea(
+ Tcl_Interp *interp, /* Interpreter for error reporting and result
+ * storing. */
+ TkCanvas *canvasPtr, /* Canvas whose items are to be searched. */
+ Tcl_Obj *const *objv, /* Array of four arguments that give the
+ * coordinates of the rectangular area to
+ * search. */
+ Tk_Uid uid, /* If non-NULL, gives new tag to set on all
+ * found items; if NULL, then ids of found
+ * items are returned in the interp's
+ * result. */
+ int enclosed) /* 0 means overlapping or enclosed items are
+ * OK, 1 means only enclosed items are OK. */
+{
+ double rect[4], tmp;
+ int x1, y1, x2, y2;
+ Tk_Item *itemPtr;
+ Tcl_Obj *resultObj;
+
+ if ((Tk_CanvasGetCoordFromObj(interp, (Tk_Canvas) canvasPtr, objv[0],
+ &rect[0]) != TCL_OK)
+ || (Tk_CanvasGetCoordFromObj(interp,(Tk_Canvas)canvasPtr,objv[1],
+ &rect[1]) != TCL_OK)
+ || (Tk_CanvasGetCoordFromObj(interp,(Tk_Canvas)canvasPtr,objv[2],
+ &rect[2]) != TCL_OK)
+ || (Tk_CanvasGetCoordFromObj(interp,(Tk_Canvas)canvasPtr,objv[3],
+ &rect[3]) != TCL_OK)) {
+ return TCL_ERROR;
+ }
+ if (rect[0] > rect[2]) {
+ tmp = rect[0]; rect[0] = rect[2]; rect[2] = tmp;
+ }
+ if (rect[1] > rect[3]) {
+ tmp = rect[1]; rect[1] = rect[3]; rect[3] = tmp;
+ }
+
+ /*
+ * Use an integer bounding box for a quick test, to avoid calling
+ * item-specific code except for items that are close.
+ */
+
+ x1 = (int) (rect[0] - 1.0);
+ y1 = (int) (rect[1] - 1.0);
+ x2 = (int) (rect[2] + 1.0);
+ y2 = (int) (rect[3] + 1.0);
+ resultObj = Tcl_NewObj();
+ for (itemPtr = canvasPtr->firstItemPtr; itemPtr != NULL;
+ itemPtr = itemPtr->nextPtr) {
+ if (itemPtr->state == TK_STATE_HIDDEN ||
+ (itemPtr->state == TK_STATE_NULL
+ && canvasPtr->canvas_state == TK_STATE_HIDDEN)) {
+ continue;
+ }
+ if ((itemPtr->x1 >= x2) || (itemPtr->x2 <= x1)
+ || (itemPtr->y1 >= y2) || (itemPtr->y2 <= y1)) {
+ continue;
+ }
+ if (ItemOverlap(canvasPtr, itemPtr, rect) >= enclosed) {
+ DoItem(resultObj, itemPtr, uid);
+ }
+ }
+ Tcl_SetObjResult(interp, resultObj);
+ return TCL_OK;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * RelinkItems --
+ *
+ * Move one or more items to a different place in the display order for a
+ * canvas.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The items identified by "tag" are moved so that they are all together
+ * in the display list and immediately after prevPtr. The order of the
+ * moved items relative to each other is not changed.
+ *
+ *--------------------------------------------------------------
+ */
+
+#ifdef USE_OLD_TAG_SEARCH
+static void
+RelinkItems(
+ TkCanvas *canvasPtr, /* Canvas to be modified. */
+ Tcl_Obj *tag, /* Tag identifying items to be moved in the
+ * redisplay list. */
+ Tk_Item *prevPtr) /* Reposition the items so that they go just
+ * after this item (NULL means put at
+ * beginning of list). */
+#else /* USE_OLD_TAG_SEARCH */
+static int
+RelinkItems(
+ TkCanvas *canvasPtr, /* Canvas to be modified. */
+ Tcl_Obj *tag, /* Tag identifying items to be moved in the
+ * redisplay list. */
+ Tk_Item *prevPtr, /* Reposition the items so that they go just
+ * after this item (NULL means put at
+ * beginning of list). */
+ TagSearch **searchPtrPtr) /* From CanvasWidgetCmd local vars */
+#endif /* USE_OLD_TAG_SEARCH */
+{
+ Tk_Item *itemPtr;
+#ifdef USE_OLD_TAG_SEARCH
+ TagSearch search;
+#endif /* USE_OLD_TAG_SEARCH */
+ Tk_Item *firstMovePtr, *lastMovePtr;
+ int result;
+
+ /*
+ * Find all of the items to be moved and remove them from the list, making
+ * an auxiliary list running from firstMovePtr to lastMovePtr. Record
+ * their areas for redisplay.
+ */
+
+ firstMovePtr = lastMovePtr = NULL;
+ FOR_EVERY_CANVAS_ITEM_MATCHING(tag, searchPtrPtr, return TCL_ERROR) {
+ if (itemPtr == prevPtr) {
+ /*
+ * Item after which insertion is to occur is being moved! Switch
+ * to insert after its predecessor.
+ */
+
+ prevPtr = prevPtr->prevPtr;
+ }
+ if (itemPtr->prevPtr == NULL) {
+ if (itemPtr->nextPtr != NULL) {
+ itemPtr->nextPtr->prevPtr = NULL;
+ }
+ canvasPtr->firstItemPtr = itemPtr->nextPtr;
+ } else {
+ if (itemPtr->nextPtr != NULL) {
+ itemPtr->nextPtr->prevPtr = itemPtr->prevPtr;
+ }
+ itemPtr->prevPtr->nextPtr = itemPtr->nextPtr;
+ }
+ if (canvasPtr->lastItemPtr == itemPtr) {
+ canvasPtr->lastItemPtr = itemPtr->prevPtr;
+ }
+ if (firstMovePtr == NULL) {
+ itemPtr->prevPtr = NULL;
+ firstMovePtr = itemPtr;
+ } else {
+ itemPtr->prevPtr = lastMovePtr;
+ lastMovePtr->nextPtr = itemPtr;
+ }
+ lastMovePtr = itemPtr;
+ EventuallyRedrawItem(canvasPtr, itemPtr);
+ canvasPtr->flags |= REPICK_NEEDED;
+ }
+
+ /*
+ * Insert the list of to-be-moved items back into the canvas's at the
+ * desired position.
+ */
+
+ if (firstMovePtr == NULL) {
+#ifdef USE_OLD_TAG_SEARCH
+ return;
+#else /* USE_OLD_TAG_SEARCH */
+ return TCL_OK;
+#endif /* USE_OLD_TAG_SEARCH */
+ }
+ if (prevPtr == NULL) {
+ if (canvasPtr->firstItemPtr != NULL) {
+ canvasPtr->firstItemPtr->prevPtr = lastMovePtr;
+ }
+ lastMovePtr->nextPtr = canvasPtr->firstItemPtr;
+ canvasPtr->firstItemPtr = firstMovePtr;
+ } else {
+ if (prevPtr->nextPtr != NULL) {
+ prevPtr->nextPtr->prevPtr = lastMovePtr;
+ }
+ lastMovePtr->nextPtr = prevPtr->nextPtr;
+ if (firstMovePtr != NULL) {
+ firstMovePtr->prevPtr = prevPtr;
+ }
+ prevPtr->nextPtr = firstMovePtr;
+ }
+ if (canvasPtr->lastItemPtr == prevPtr) {
+ canvasPtr->lastItemPtr = lastMovePtr;
+ }
+#ifndef USE_OLD_TAG_SEARCH
+ return TCL_OK;
+#endif /* not USE_OLD_TAG_SEARCH */
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * CanvasBindProc --
+ *
+ * This function is invoked by the Tk dispatcher to handle events
+ * associated with bindings on items.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Depends on the command invoked as part of the binding (if there was
+ * any).
+ *
+ *--------------------------------------------------------------
+ */
+
+static void
+CanvasBindProc(
+ ClientData clientData, /* Pointer to canvas structure. */
+ XEvent *eventPtr) /* Pointer to X event that just happened. */
+{
+ TkCanvas *canvasPtr = clientData;
+ int mask;
+
+ Tcl_Preserve(canvasPtr);
+
+ /*
+ * This code below keeps track of the current modifier state in
+ * canvasPtr>state. This information is used to defer repicks of the
+ * current item while buttons are down.
+ */
+
+ switch (eventPtr->type) {
+ case ButtonPress:
+ case ButtonRelease:
+ switch (eventPtr->xbutton.button) {
+ case Button1:
+ mask = Button1Mask;
+ break;
+ case Button2:
+ mask = Button2Mask;
+ break;
+ case Button3:
+ mask = Button3Mask;
+ break;
+ case Button4:
+ mask = Button4Mask;
+ break;
+ case Button5:
+ mask = Button5Mask;
+ break;
+ default:
+ mask = 0;
+ break;
+ }
+
+ /*
+ * For button press events, repick the current item using the button
+ * state before the event, then process the event. For button release
+ * events, first process the event, then repick the current item using
+ * the button state *after* the event (the button has logically gone
+ * up before we change the current item).
+ */
+
+ if (eventPtr->type == ButtonPress) {
+ /*
+ * On a button press, first repick the current item using the
+ * button state before the event, the process the event.
+ */
+
+ canvasPtr->state = eventPtr->xbutton.state;
+ PickCurrentItem(canvasPtr, eventPtr);
+ canvasPtr->state ^= mask;
+ CanvasDoEvent(canvasPtr, eventPtr);
+ } else {
+ /*
+ * Button release: first process the event, with the button still
+ * considered to be down. Then repick the current item under the
+ * assumption that the button is no longer down.
+ */
+
+ canvasPtr->state = eventPtr->xbutton.state;
+ CanvasDoEvent(canvasPtr, eventPtr);
+ eventPtr->xbutton.state ^= mask;
+ canvasPtr->state = eventPtr->xbutton.state;
+ PickCurrentItem(canvasPtr, eventPtr);
+ eventPtr->xbutton.state ^= mask;
+ }
+ break;
+ case EnterNotify:
+ case LeaveNotify:
+ canvasPtr->state = eventPtr->xcrossing.state;
+ PickCurrentItem(canvasPtr, eventPtr);
+ break;
+ case MotionNotify:
+ canvasPtr->state = eventPtr->xmotion.state;
+ PickCurrentItem(canvasPtr, eventPtr);
+ /* fallthrough */
+ default:
+ CanvasDoEvent(canvasPtr, eventPtr);
+ }
+
+ Tcl_Release(canvasPtr);
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * PickCurrentItem --
+ *
+ * Find the topmost item in a canvas that contains a given location and
+ * mark the the current item. If the current item has changed, generate a
+ * fake exit event on the old current item, a fake enter event on the new
+ * current item item and force a redraw of the two items. Canvas items
+ * that are hidden or disabled are ignored.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The current item for canvasPtr may change. If it does, then the
+ * commands associated with item entry and exit could do just about
+ * anything. A binding script could delete the canvas, so callers should
+ * protect themselves with Tcl_Preserve and Tcl_Release.
+ *
+ *--------------------------------------------------------------
+ */
+
+static void
+PickCurrentItem(
+ TkCanvas *canvasPtr, /* Canvas widget in which to select current
+ * item. */
+ XEvent *eventPtr) /* Event describing location of mouse cursor.
+ * Must be EnterWindow, LeaveWindow,
+ * ButtonRelease, or MotionNotify. */
+{
+ double coords[2];
+ int buttonDown;
+ Tk_Item *prevItemPtr;
+#ifndef USE_OLD_TAG_SEARCH
+ SearchUids *searchUids = GetStaticUids();
+#endif
+
+ /*
+ * Check whether or not a button is down. If so, we'll log entry and exit
+ * into and out of the current item, but not entry into any other item.
+ * This implements a form of grabbing equivalent to what the X server does
+ * for windows.
+ */
+
+ buttonDown = canvasPtr->state
+ & (Button1Mask|Button2Mask|Button3Mask|Button4Mask|Button5Mask);
+
+ /*
+ * Save information about this event in the canvas. The event in the
+ * canvas is used for two purposes:
+ *
+ * 1. Event bindings: if the current item changes, fake events are
+ * generated to allow item-enter and item-leave bindings to trigger.
+ * 2. Reselection: if the current item gets deleted, can use the saved
+ * event to find a new current item.
+ *
+ * Translate MotionNotify events into EnterNotify events, since that's
+ * what gets reported to item handlers.
+ */
+
+ if (eventPtr != &canvasPtr->pickEvent) {
+ if ((eventPtr->type == MotionNotify)
+ || (eventPtr->type == ButtonRelease)) {
+ canvasPtr->pickEvent.xcrossing.type = EnterNotify;
+ canvasPtr->pickEvent.xcrossing.serial = eventPtr->xmotion.serial;
+ canvasPtr->pickEvent.xcrossing.send_event
+ = eventPtr->xmotion.send_event;
+ canvasPtr->pickEvent.xcrossing.display = eventPtr->xmotion.display;
+ canvasPtr->pickEvent.xcrossing.window = eventPtr->xmotion.window;
+ canvasPtr->pickEvent.xcrossing.root = eventPtr->xmotion.root;
+ canvasPtr->pickEvent.xcrossing.subwindow = None;
+ canvasPtr->pickEvent.xcrossing.time = eventPtr->xmotion.time;
+ canvasPtr->pickEvent.xcrossing.x = eventPtr->xmotion.x;
+ canvasPtr->pickEvent.xcrossing.y = eventPtr->xmotion.y;
+ canvasPtr->pickEvent.xcrossing.x_root = eventPtr->xmotion.x_root;
+ canvasPtr->pickEvent.xcrossing.y_root = eventPtr->xmotion.y_root;
+ canvasPtr->pickEvent.xcrossing.mode = NotifyNormal;
+ canvasPtr->pickEvent.xcrossing.detail = NotifyNonlinear;
+ canvasPtr->pickEvent.xcrossing.same_screen =
+ eventPtr->xmotion.same_screen;
+ canvasPtr->pickEvent.xcrossing.focus = False;
+ canvasPtr->pickEvent.xcrossing.state = eventPtr->xmotion.state;
+ } else {
+ canvasPtr->pickEvent = *eventPtr;
+ }
+ }
+
+ /*
+ * If this is a recursive call (there's already a partially completed call
+ * pending on the stack; it's in the middle of processing a Leave event
+ * handler for the old current item) then just return; the pending call
+ * will do everything that's needed.
+ */
+
+ if (canvasPtr->flags & REPICK_IN_PROGRESS) {
+ return;
+ }
+
+ /*
+ * A LeaveNotify event automatically means that there's no current object,
+ * so the check for closest item can be skipped.
+ */
+
+ coords[0] = canvasPtr->pickEvent.xcrossing.x + canvasPtr->xOrigin;
+ coords[1] = canvasPtr->pickEvent.xcrossing.y + canvasPtr->yOrigin;
+ if (canvasPtr->pickEvent.type != LeaveNotify) {
+ canvasPtr->newCurrentPtr = CanvasFindClosest(canvasPtr, coords);
+ } else {
+ canvasPtr->newCurrentPtr = NULL;
+ }
+
+ if ((canvasPtr->newCurrentPtr == canvasPtr->currentItemPtr)
+ && !(canvasPtr->flags & LEFT_GRABBED_ITEM)) {
+ /*
+ * Nothing to do: the current item hasn't changed.
+ */
+
+ return;
+ }
+
+ if (!buttonDown) {
+ canvasPtr->flags &= ~LEFT_GRABBED_ITEM;
+ }
+
+ /*
+ * Simulate a LeaveNotify event on the previous current item and an
+ * EnterNotify event on the new current item. Remove the "current" tag
+ * from the previous current item and place it on the new current item.
+ */
+
+ if ((canvasPtr->newCurrentPtr != canvasPtr->currentItemPtr)
+ && (canvasPtr->currentItemPtr != NULL)
+ && !(canvasPtr->flags & LEFT_GRABBED_ITEM)) {
+ XEvent event;
+ Tk_Item *itemPtr = canvasPtr->currentItemPtr;
+ int i;
+
+ event = canvasPtr->pickEvent;
+ event.type = LeaveNotify;
+
+ /*
+ * If the event's detail happens to be NotifyInferior the binding
+ * mechanism will discard the event. To be consistent, always use
+ * NotifyAncestor.
+ */
+
+ event.xcrossing.detail = NotifyAncestor;
+ canvasPtr->flags |= REPICK_IN_PROGRESS;
+ CanvasDoEvent(canvasPtr, &event);
+ canvasPtr->flags &= ~REPICK_IN_PROGRESS;
+
+ /*
+ * The check below is needed because there could be an event handler
+ * for <LeaveNotify> that deletes the current item.
+ */
+
+ if ((itemPtr == canvasPtr->currentItemPtr) && !buttonDown) {
+ for (i = itemPtr->numTags-1; i >= 0; i--) {
+#ifdef USE_OLD_TAG_SEARCH
+ if (itemPtr->tagPtr[i] == Tk_GetUid("current"))
+#else /* USE_OLD_TAG_SEARCH */
+ if (itemPtr->tagPtr[i] == searchUids->currentUid)
+#endif /* USE_OLD_TAG_SEARCH */
+ /* then */ {
+ itemPtr->tagPtr[i] = itemPtr->tagPtr[itemPtr->numTags-1];
+ itemPtr->numTags--;
+ break;
+ }
+ }
+ }
+
+ /*
+ * Note: during CanvasDoEvent above, it's possible that
+ * canvasPtr->newCurrentPtr got reset to NULL because the item was
+ * deleted.
+ */
+ }
+ if ((canvasPtr->newCurrentPtr!=canvasPtr->currentItemPtr) && buttonDown) {
+ canvasPtr->flags |= LEFT_GRABBED_ITEM;
+ return;
+ }
+
+ /*
+ * Special note: it's possible that canvasPtr->newCurrentPtr ==
+ * canvasPtr->currentItemPtr here. This can happen, for example, if
+ * LEFT_GRABBED_ITEM was set.
+ */
+
+ prevItemPtr = canvasPtr->currentItemPtr;
+ canvasPtr->flags &= ~LEFT_GRABBED_ITEM;
+ canvasPtr->currentItemPtr = canvasPtr->newCurrentPtr;
+ if (prevItemPtr != NULL && prevItemPtr != canvasPtr->currentItemPtr &&
+ (prevItemPtr->redraw_flags & TK_ITEM_STATE_DEPENDANT)) {
+ EventuallyRedrawItem(canvasPtr, prevItemPtr);
+ ItemConfigure(canvasPtr, prevItemPtr, 0, NULL);
+ }
+ if (canvasPtr->currentItemPtr != NULL) {
+ XEvent event;
+
+#ifdef USE_OLD_TAG_SEARCH
+ DoItem(NULL, canvasPtr->currentItemPtr, Tk_GetUid("current"));
+#else /* USE_OLD_TAG_SEARCH */
+ DoItem(NULL, canvasPtr->currentItemPtr, searchUids->currentUid);
+#endif /* USE_OLD_TAG_SEARCH */
+ if ((canvasPtr->currentItemPtr->redraw_flags & TK_ITEM_STATE_DEPENDANT
+ && prevItemPtr != canvasPtr->currentItemPtr)) {
+ ItemConfigure(canvasPtr, canvasPtr->currentItemPtr, 0, NULL);
+ EventuallyRedrawItem(canvasPtr, canvasPtr->currentItemPtr);
+ }
+ event = canvasPtr->pickEvent;
+ event.type = EnterNotify;
+ event.xcrossing.detail = NotifyAncestor;
+ CanvasDoEvent(canvasPtr, &event);
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * CanvasFindClosest --
+ *
+ * Given x and y coordinates, find the topmost canvas item that is
+ * "close" to the coordinates. Canvas items that are hidden or disabled
+ * are ignored.
+ *
+ * Results:
+ * The return value is a pointer to the topmost item that is close to
+ * (x,y), or NULL if no item is close.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static Tk_Item *
+CanvasFindClosest(
+ TkCanvas *canvasPtr, /* Canvas widget to search. */
+ double coords[2]) /* Desired x,y position in canvas, not screen,
+ * coordinates.) */
+{
+ Tk_Item *itemPtr;
+ Tk_Item *bestPtr;
+ int x1, y1, x2, y2;
+
+ x1 = (int) (coords[0] - canvasPtr->closeEnough);
+ y1 = (int) (coords[1] - canvasPtr->closeEnough);
+ x2 = (int) (coords[0] + canvasPtr->closeEnough);
+ y2 = (int) (coords[1] + canvasPtr->closeEnough);
+
+ bestPtr = NULL;
+ for (itemPtr = canvasPtr->firstItemPtr; itemPtr != NULL;
+ itemPtr = itemPtr->nextPtr) {
+ if (itemPtr->state == TK_STATE_HIDDEN ||
+ itemPtr->state==TK_STATE_DISABLED ||
+ (itemPtr->state == TK_STATE_NULL &&
+ (canvasPtr->canvas_state == TK_STATE_HIDDEN ||
+ canvasPtr->canvas_state == TK_STATE_DISABLED))) {
+ continue;
+ }
+ if ((itemPtr->x1 > x2) || (itemPtr->x2 < x1)
+ || (itemPtr->y1 > y2) || (itemPtr->y2 < y1)) {
+ continue;
+ }
+ if (ItemPoint(canvasPtr,itemPtr,coords,0) <= canvasPtr->closeEnough) {
+ bestPtr = itemPtr;
+ }
+ }
+ return bestPtr;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * CanvasDoEvent --
+ *
+ * This function is called to invoke binding processing for a new event
+ * that is associated with the current item for a canvas.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Depends on the bindings for the canvas. A binding script could delete
+ * the canvas, so callers should protect themselves with Tcl_Preserve and
+ * Tcl_Release.
+ *
+ *--------------------------------------------------------------
+ */
+
+static void
+CanvasDoEvent(
+ TkCanvas *canvasPtr, /* Canvas widget in which event occurred. */
+ XEvent *eventPtr) /* Real or simulated X event that is to be
+ * processed. */
+{
+#define NUM_STATIC 3
+ ClientData staticObjects[NUM_STATIC];
+ ClientData *objectPtr;
+ int numObjects, i;
+ Tk_Item *itemPtr;
+#ifndef USE_OLD_TAG_SEARCH
+ TagSearchExpr *expr;
+ int numExprs;
+ SearchUids *searchUids = GetStaticUids();
+#endif /* not USE_OLD_TAG_SEARCH */
+
+ if (canvasPtr->bindingTable == NULL) {
+ return;
+ }
+
+ itemPtr = canvasPtr->currentItemPtr;
+ if ((eventPtr->type == KeyPress) || (eventPtr->type == KeyRelease)) {
+ itemPtr = canvasPtr->textInfo.focusItemPtr;
+ }
+ if (itemPtr == NULL) {
+ return;
+ }
+
+#ifdef USE_OLD_TAG_SEARCH
+ /*
+ * Set up an array with all the relevant objects for processing this
+ * event. The relevant objects are (a) the event's item, (b) the tags
+ * associated with the event's item, and (c) the tag "all". If there are a
+ * lot of tags then malloc an array to hold all of the objects.
+ */
+
+ numObjects = itemPtr->numTags + 2;
+#else /* USE_OLD_TAG_SEARCH */
+ /*
+ * Set up an array with all the relevant objects for processing this
+ * event. The relevant objects are:
+ * (a) the event's item,
+ * (b) the tags associated with the event's item,
+ * (c) the expressions that are true for the event's item's tags, and
+ * (d) the tag "all".
+ *
+ * If there are a lot of tags then malloc an array to hold all of the
+ * objects.
+ */
+
+ /*
+ * Flag and count all expressions that match item's tags.
+ */
+
+ numExprs = 0;
+ expr = canvasPtr->bindTagExprs;
+ while (expr) {
+ expr->index = 0;
+ expr->match = TagSearchEvalExpr(expr, itemPtr);
+ if (expr->match) {
+ numExprs++;
+ }
+ expr = expr->next;
+ }
+
+ numObjects = itemPtr->numTags + numExprs + 2;
+#endif /* not USE_OLD_TAG_SEARCH */
+ if (numObjects <= NUM_STATIC) {
+ objectPtr = staticObjects;
+ } else {
+ objectPtr = ckalloc(numObjects * sizeof(ClientData));
+ }
+#ifdef USE_OLD_TAG_SEARCH
+ objectPtr[0] = (ClientData) Tk_GetUid("all");
+#else /* USE_OLD_TAG_SEARCH */
+ objectPtr[0] = (ClientData) searchUids->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] = itemPtr;
+
+#ifndef USE_OLD_TAG_SEARCH
+ /*
+ * Copy uids of matching expressions into object array
+ */
+
+ i = itemPtr->numTags+2;
+ expr = canvasPtr->bindTagExprs;
+ while (expr) {
+ if (expr->match) {
+ objectPtr[i++] = (int *) expr->uid;
+ }
+ expr = expr->next;
+ }
+#endif /* not USE_OLD_TAG_SEARCH */
+
+ /*
+ * Invoke the binding system, then free up the object array if it was
+ * malloc-ed.
+ */
+
+ if (canvasPtr->tkwin != NULL) {
+ Tk_BindEvent(canvasPtr->bindingTable, eventPtr, canvasPtr->tkwin,
+ numObjects, objectPtr);
+ }
+ if (objectPtr != staticObjects) {
+ ckfree(objectPtr);
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * CanvasBlinkProc --
+ *
+ * This function is called as a timer handler to blink the insertion
+ * cursor off and on.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The cursor gets turned on or off, redisplay gets invoked, and this
+ * function reschedules itself.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+CanvasBlinkProc(
+ ClientData clientData) /* Pointer to record describing entry. */
+{
+ TkCanvas *canvasPtr = clientData;
+
+ if (!canvasPtr->textInfo.gotFocus || (canvasPtr->insertOffTime == 0)) {
+ return;
+ }
+ if (canvasPtr->textInfo.cursorOn) {
+ canvasPtr->textInfo.cursorOn = 0;
+ canvasPtr->insertBlinkHandler = Tcl_CreateTimerHandler(
+ canvasPtr->insertOffTime, CanvasBlinkProc, canvasPtr);
+ } else {
+ canvasPtr->textInfo.cursorOn = 1;
+ canvasPtr->insertBlinkHandler = Tcl_CreateTimerHandler(
+ canvasPtr->insertOnTime, CanvasBlinkProc, canvasPtr);
+ }
+ EventuallyRedrawItem(canvasPtr, canvasPtr->textInfo.focusItemPtr);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * CanvasFocusProc --
+ *
+ * This function is called whenever a canvas gets or loses the input
+ * focus. It's also called whenever the window is reconfigured while it
+ * has the focus.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The cursor gets turned on or off.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+CanvasFocusProc(
+ TkCanvas *canvasPtr, /* Canvas that just got or lost focus. */
+ int gotFocus) /* 1 means window is getting focus, 0 means
+ * it's losing it. */
+{
+ Tcl_DeleteTimerHandler(canvasPtr->insertBlinkHandler);
+ if (gotFocus) {
+ canvasPtr->textInfo.gotFocus = 1;
+ canvasPtr->textInfo.cursorOn = 1;
+ if (canvasPtr->insertOffTime != 0) {
+ canvasPtr->insertBlinkHandler = Tcl_CreateTimerHandler(
+ canvasPtr->insertOffTime, CanvasBlinkProc, canvasPtr);
+ }
+ } else {
+ canvasPtr->textInfo.gotFocus = 0;
+ canvasPtr->textInfo.cursorOn = 0;
+ canvasPtr->insertBlinkHandler = (Tcl_TimerToken) NULL;
+ }
+ EventuallyRedrawItem(canvasPtr, canvasPtr->textInfo.focusItemPtr);
+ if (canvasPtr->highlightWidth > 0) {
+ canvasPtr->flags |= REDRAW_BORDERS;
+ if (!(canvasPtr->flags & REDRAW_PENDING)) {
+ Tcl_DoWhenIdle(DisplayCanvas, canvasPtr);
+ canvasPtr->flags |= REDRAW_PENDING;
+ }
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * CanvasSelectTo --
+ *
+ * Modify the selection by moving its un-anchored end. This could make
+ * the selection either larger or smaller.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The selection changes.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+CanvasSelectTo(
+ TkCanvas *canvasPtr, /* Information about widget. */
+ Tk_Item *itemPtr, /* Item that is to hold selection. */
+ int index) /* Index of element that is to become the
+ * "other" end of the selection. */
+{
+ int oldFirst, oldLast;
+ Tk_Item *oldSelPtr;
+
+ oldFirst = canvasPtr->textInfo.selectFirst;
+ oldLast = canvasPtr->textInfo.selectLast;
+ oldSelPtr = canvasPtr->textInfo.selItemPtr;
+
+ /*
+ * Grab the selection if we don't own it already.
+ */
+
+ if (canvasPtr->textInfo.selItemPtr == NULL) {
+ Tk_OwnSelection(canvasPtr->tkwin, XA_PRIMARY, CanvasLostSelection,
+ canvasPtr);
+ } else if (canvasPtr->textInfo.selItemPtr != itemPtr) {
+ EventuallyRedrawItem(canvasPtr, canvasPtr->textInfo.selItemPtr);
+ }
+ canvasPtr->textInfo.selItemPtr = itemPtr;
+
+ if (canvasPtr->textInfo.anchorItemPtr != itemPtr) {
+ canvasPtr->textInfo.anchorItemPtr = itemPtr;
+ canvasPtr->textInfo.selectAnchor = index;
+ }
+ if (canvasPtr->textInfo.selectAnchor <= index) {
+ canvasPtr->textInfo.selectFirst = canvasPtr->textInfo.selectAnchor;
+ canvasPtr->textInfo.selectLast = index;
+ } else {
+ canvasPtr->textInfo.selectFirst = index;
+ canvasPtr->textInfo.selectLast = canvasPtr->textInfo.selectAnchor - 1;
+ }
+ if ((canvasPtr->textInfo.selectFirst != oldFirst)
+ || (canvasPtr->textInfo.selectLast != oldLast)
+ || (itemPtr != oldSelPtr)) {
+ EventuallyRedrawItem(canvasPtr, itemPtr);
+ }
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * CanvasFetchSelection --
+ *
+ * This function is invoked by Tk to return part or all of the selection,
+ * when the selection is in a canvas widget. This function always returns
+ * the selection as a STRING.
+ *
+ * Results:
+ * The return value is the number of non-NULL bytes stored at buffer.
+ * Buffer is filled (or partially filled) with a NULL-terminated string
+ * containing part or all of the selection, as given by offset and
+ * maxBytes.
+ *
+ * Side effects:
+ * None.
+ *
+ *--------------------------------------------------------------
+ */
+
+static int
+CanvasFetchSelection(
+ ClientData clientData, /* Information about canvas widget. */
+ int offset, /* Offset within selection of first character
+ * to be returned. */
+ char *buffer, /* Location in which to place selection. */
+ int maxBytes) /* Maximum number of bytes to place at buffer,
+ * not including terminating NULL
+ * character. */
+{
+ TkCanvas *canvasPtr = clientData;
+
+ return ItemSelection(canvasPtr, canvasPtr->textInfo.selItemPtr, offset,
+ buffer, maxBytes);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * CanvasLostSelection --
+ *
+ * This function is called back by Tk when the selection is grabbed away
+ * from a canvas widget.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The existing selection is unhighlighted, and the window is marked as
+ * not containing a selection.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+CanvasLostSelection(
+ ClientData clientData) /* Information about entry widget. */
+{
+ TkCanvas *canvasPtr = clientData;
+
+ EventuallyRedrawItem(canvasPtr, canvasPtr->textInfo.selItemPtr);
+ canvasPtr->textInfo.selItemPtr = NULL;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * GridAlign --
+ *
+ * Given a coordinate and a grid spacing, this function computes the
+ * location of the nearest grid line to the coordinate.
+ *
+ * Results:
+ * The return value is the location of the grid line nearest to coord.
+ *
+ * Side effects:
+ * None.
+ *
+ *--------------------------------------------------------------
+ */
+
+static double
+GridAlign(
+ double coord, /* Coordinate to grid-align. */
+ double spacing) /* Spacing between grid lines. If <= 0 then no
+ * alignment is done. */
+{
+ if (spacing <= 0.0) {
+ return coord;
+ }
+ if (coord < 0) {
+ return -((int) ((-coord)/spacing + 0.5)) * spacing;
+ }
+ return ((int) (coord/spacing + 0.5)) * spacing;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ScrollFractions --
+ *
+ * Given the range that's visible in the window and the "100% range" for
+ * what's in the canvas, return a list of two doubles representing the
+ * scroll fractions. This function is used for both x and y scrolling.
+ *
+ * Results:
+ * A List Tcl_Obj with two real numbers (Double Tcl_Objs) containing the
+ * scroll fractions (between 0 and 1) corresponding to the other
+ * arguments.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static Tcl_Obj *
+ScrollFractions(
+ int screen1, /* Lowest coordinate visible in the window. */
+ int screen2, /* Highest coordinate visible in the window. */
+ int object1, /* Lowest coordinate in the object. */
+ int object2) /* Highest coordinate in the object. */
+{
+ Tcl_Obj *buffer[2];
+ double range, f1, f2;
+
+ range = object2 - object1;
+ if (range <= 0) {
+ f1 = 0;
+ f2 = 1.0;
+ } else {
+ f1 = (screen1 - object1)/range;
+ if (f1 < 0) {
+ f1 = 0.0;
+ }
+ f2 = (screen2 - object1)/range;
+ if (f2 > 1.0) {
+ f2 = 1.0;
+ }
+ if (f2 < f1) {
+ f2 = f1;
+ }
+ }
+ buffer[0] = Tcl_NewDoubleObj(f1);
+ buffer[1] = Tcl_NewDoubleObj(f2);
+ return Tcl_NewListObj(2, buffer);
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * CanvasUpdateScrollbars --
+ *
+ * This function is invoked whenever a canvas has changed in a way that
+ * requires scrollbars to be redisplayed (e.g. the view in the canvas has
+ * changed).
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * If there are scrollbars associated with the canvas, then their
+ * scrolling commands are invoked to cause them to redisplay. If errors
+ * occur, additional Tcl commands may be invoked to process the errors.
+ *
+ *--------------------------------------------------------------
+ */
+
+static void
+CanvasUpdateScrollbars(
+ TkCanvas *canvasPtr) /* Information about canvas. */
+{
+ int result;
+ Tcl_Interp *interp;
+ int xOrigin, yOrigin, inset, width, height;
+ int scrollX1, scrollX2, scrollY1, scrollY2;
+ char *xScrollCmd, *yScrollCmd;
+ Tcl_DString buf;
+
+ /*
+ * Save all the relevant values from the canvasPtr, because it might be
+ * deleted as part of either of the two calls to Tcl_VarEval below.
+ */
+
+ interp = canvasPtr->interp;
+ Tcl_Preserve(interp);
+ xScrollCmd = canvasPtr->xScrollCmd;
+ if (xScrollCmd != NULL) {
+ Tcl_Preserve(xScrollCmd);
+ }
+ yScrollCmd = canvasPtr->yScrollCmd;
+ if (yScrollCmd != NULL) {
+ Tcl_Preserve(yScrollCmd);
+ }
+ xOrigin = canvasPtr->xOrigin;
+ yOrigin = canvasPtr->yOrigin;
+ inset = canvasPtr->inset;
+ width = Tk_Width(canvasPtr->tkwin);
+ height = Tk_Height(canvasPtr->tkwin);
+ scrollX1 = canvasPtr->scrollX1;
+ scrollX2 = canvasPtr->scrollX2;
+ scrollY1 = canvasPtr->scrollY1;
+ scrollY2 = canvasPtr->scrollY2;
+ canvasPtr->flags &= ~UPDATE_SCROLLBARS;
+ if (canvasPtr->xScrollCmd != NULL) {
+ Tcl_Obj *fractions = ScrollFractions(xOrigin + inset,
+ xOrigin + width - inset, scrollX1, scrollX2);
+
+ Tcl_DStringInit(&buf);
+ Tcl_DStringAppend(&buf, xScrollCmd, -1);
+ Tcl_DStringAppend(&buf, " ", -1);
+ Tcl_DStringAppend(&buf, Tcl_GetString(fractions), -1);
+ result = Tcl_EvalEx(interp, Tcl_DStringValue(&buf), -1, 0);
+ Tcl_DStringFree(&buf);
+ Tcl_DecrRefCount(fractions);
+ if (result != TCL_OK) {
+ Tcl_BackgroundException(interp, result);
+ }
+ Tcl_ResetResult(interp);
+ Tcl_Release(xScrollCmd);
+ }
+
+ if (yScrollCmd != NULL) {
+ Tcl_Obj *fractions = ScrollFractions(yOrigin + inset,
+ yOrigin + height - inset, scrollY1, scrollY2);
+
+ Tcl_DStringInit(&buf);
+ Tcl_DStringAppend(&buf, yScrollCmd, -1);
+ Tcl_DStringAppend(&buf, " ", -1);
+ Tcl_DStringAppend(&buf, Tcl_GetString(fractions), -1);
+ result = Tcl_EvalEx(interp, Tcl_DStringValue(&buf), -1, 0);
+ Tcl_DStringFree(&buf);
+ Tcl_DecrRefCount(fractions);
+ if (result != TCL_OK) {
+ Tcl_BackgroundException(interp, result);
+ }
+ Tcl_ResetResult(interp);
+ Tcl_Release(yScrollCmd);
+ }
+ Tcl_Release(interp);
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * CanvasSetOrigin --
+ *
+ * This function is invoked to change the mapping between canvas
+ * coordinates and screen coordinates in the canvas window.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The canvas will be redisplayed to reflect the change in view. In
+ * addition, scrollbars will be updated if there are any.
+ *
+ *--------------------------------------------------------------
+ */
+
+static void
+CanvasSetOrigin(
+ TkCanvas *canvasPtr, /* Information about canvas. */
+ int xOrigin, /* New X origin for canvas (canvas x-coord
+ * corresponding to left edge of canvas
+ * window). */
+ int yOrigin) /* New Y origin for canvas (canvas y-coord
+ * corresponding to top edge of canvas
+ * window). */
+{
+ int left, right, top, bottom, delta;
+
+ /*
+ * If scroll increments have been set, round the window origin to the
+ * nearest multiple of the increments. Remember, the origin is the place
+ * just inside the borders, not the upper left corner.
+ */
+
+ if (canvasPtr->xScrollIncrement > 0) {
+ if (xOrigin >= 0) {
+ xOrigin += canvasPtr->xScrollIncrement/2;
+ xOrigin -= (xOrigin + canvasPtr->inset)
+ % canvasPtr->xScrollIncrement;
+ } else {
+ xOrigin = (-xOrigin) + canvasPtr->xScrollIncrement/2;
+ xOrigin = -(xOrigin - (xOrigin - canvasPtr->inset)
+ % canvasPtr->xScrollIncrement);
+ }
+ }
+ if (canvasPtr->yScrollIncrement > 0) {
+ if (yOrigin >= 0) {
+ yOrigin += canvasPtr->yScrollIncrement/2;
+ yOrigin -= (yOrigin + canvasPtr->inset)
+ % canvasPtr->yScrollIncrement;
+ } else {
+ yOrigin = (-yOrigin) + canvasPtr->yScrollIncrement/2;
+ yOrigin = -(yOrigin - (yOrigin - canvasPtr->inset)
+ % canvasPtr->yScrollIncrement);
+ }
+ }
+
+ /*
+ * Adjust the origin if necessary to keep as much as possible of the
+ * canvas in the view. The variables left, right, etc. keep track of how
+ * much extra space there is on each side of the view before it will stick
+ * out past the scroll region. If one side sticks out past the edge of the
+ * scroll region, adjust the view to bring that side back to the edge of
+ * the scrollregion (but don't move it so much that the other side sticks
+ * out now). If scroll increments are in effect, be sure to adjust only by
+ * full increments.
+ */
+
+ if ((canvasPtr->confine) && (canvasPtr->regionString != NULL)) {
+ left = xOrigin + canvasPtr->inset - canvasPtr->scrollX1;
+ right = canvasPtr->scrollX2
+ - (xOrigin + Tk_Width(canvasPtr->tkwin) - canvasPtr->inset);
+ top = yOrigin + canvasPtr->inset - canvasPtr->scrollY1;
+ bottom = canvasPtr->scrollY2
+ - (yOrigin + Tk_Height(canvasPtr->tkwin) - canvasPtr->inset);
+ if ((left < 0) && (right > 0)) {
+ delta = (right > -left) ? -left : right;
+ if (canvasPtr->xScrollIncrement > 0) {
+ delta -= delta % canvasPtr->xScrollIncrement;
+ }
+ xOrigin += delta;
+ } else if ((right < 0) && (left > 0)) {
+ delta = (left > -right) ? -right : left;
+ if (canvasPtr->xScrollIncrement > 0) {
+ delta -= delta % canvasPtr->xScrollIncrement;
+ }
+ xOrigin -= delta;
+ }
+ if ((top < 0) && (bottom > 0)) {
+ delta = (bottom > -top) ? -top : bottom;
+ if (canvasPtr->yScrollIncrement > 0) {
+ delta -= delta % canvasPtr->yScrollIncrement;
+ }
+ yOrigin += delta;
+ } else if ((bottom < 0) && (top > 0)) {
+ delta = (top > -bottom) ? -bottom : top;
+ if (canvasPtr->yScrollIncrement > 0) {
+ delta -= delta % canvasPtr->yScrollIncrement;
+ }
+ yOrigin -= delta;
+ }
+ }
+
+ if ((xOrigin == canvasPtr->xOrigin) && (yOrigin == canvasPtr->yOrigin)) {
+ return;
+ }
+
+ /*
+ * Tricky point: must redisplay not only everything that's visible in the
+ * window's final configuration, but also everything that was visible in
+ * the initial configuration. This is needed because some item types, like
+ * windows, need to know when they move off-screen so they can explicitly
+ * undisplay themselves.
+ */
+
+ Tk_CanvasEventuallyRedraw((Tk_Canvas) canvasPtr,
+ canvasPtr->xOrigin, canvasPtr->yOrigin,
+ canvasPtr->xOrigin + Tk_Width(canvasPtr->tkwin),
+ canvasPtr->yOrigin + Tk_Height(canvasPtr->tkwin));
+ canvasPtr->xOrigin = xOrigin;
+ canvasPtr->yOrigin = yOrigin;
+ canvasPtr->flags |= UPDATE_SCROLLBARS;
+ Tk_CanvasEventuallyRedraw((Tk_Canvas) canvasPtr,
+ canvasPtr->xOrigin, canvasPtr->yOrigin,
+ canvasPtr->xOrigin + Tk_Width(canvasPtr->tkwin),
+ canvasPtr->yOrigin + Tk_Height(canvasPtr->tkwin));
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkGetStringsFromObjs --
+ *
+ * Results:
+ * Converts object list into string list.
+ *
+ * Side effects:
+ * Memory is allocated for the objv array, which must be freed using
+ * ckfree() when no longer needed.
+ *
+ *----------------------------------------------------------------------
+ */
+
+/* ARGSUSED */
+static const char **
+TkGetStringsFromObjs(
+ int objc,
+ Tcl_Obj *const objv[])
+{
+ register int i;
+ const char **argv;
+
+ if (objc <= 0) {
+ return NULL;
+ }
+ argv = ckalloc((objc+1) * sizeof(char *));
+ for (i = 0; i < objc; i++) {
+ argv[i] = Tcl_GetString(objv[i]);
+ }
+ argv[objc] = 0;
+ return argv;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * Tk_CanvasPsColor --
+ *
+ * This function is called by individual canvas items when they want to
+ * set a color value for output. Given information about an X color, this
+ * function 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(
+ 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, Canvas(canvas)->psInfo, colorPtr);
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * Tk_CanvasPsFont --
+ *
+ * This function is called by individual canvas items when they want to
+ * output text. Given information about an X font, this function 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(
+ 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, Canvas(canvas)->psInfo, tkfont);
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * Tk_CanvasPsBitmap --
+ *
+ * This function 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(
+ 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, int startY, /* Coordinates of upper-left corner of
+ * rectangular region to output. */
+ int width, int height) /* Size of rectangular region. */
+{
+ return Tk_PostscriptBitmap(interp, Canvas(canvas)->tkwin,
+ Canvas(canvas)->psInfo, bitmap, startX, startY, width, height);
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * Tk_CanvasPsStipple --
+ *
+ * This function 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 function 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(
+ 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, Canvas(canvas)->tkwin,
+ Canvas(canvas)->psInfo, bitmap);
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * Tk_CanvasPsY --
+ *
+ * Given a y-coordinate in canvas coordinates, this function returns a
+ * y-coordinate to use for Postscript output.
+ *
+ * Results:
+ * Returns the Postscript coordinate that corresponds to "y".
+ *
+ * Side effects:
+ * None.
+ *
+ *--------------------------------------------------------------
+ */
+
+double
+Tk_CanvasPsY(
+ Tk_Canvas canvas, /* Token for canvas on whose behalf Postscript
+ * is being generated. */
+ double y) /* Y-coordinate in canvas coords. */
+{
+ return Tk_PostscriptY(y, Canvas(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(
+ 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, Canvas(canvas)->psInfo, coordPtr, numPoints);
+}
+
+/*
+ * Local Variables:
+ * mode: c
+ * c-basic-offset: 4
+ * fill-column: 78
+ * End:
+ */
diff --git a/tk8.6/generic/tkCanvas.h b/tk8.6/generic/tkCanvas.h
new file mode 100644
index 0000000..b8b1b46
--- /dev/null
+++ b/tk8.6/generic/tkCanvas.h
@@ -0,0 +1,312 @@
+/*
+ * tkCanvas.h --
+ *
+ * Declarations shared among all the files that implement canvas widgets.
+ *
+ * Copyright (c) 1991-1994 The Regents of the University of California.
+ * Copyright (c) 1994-1995 Sun Microsystems, Inc.
+ * Copyright (c) 1998 by Scriptics Corporation.
+ *
+ * See the file "license.terms" for information on usage and redistribution of
+ * this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ */
+
+#ifndef _TKCANVAS
+#define _TKCANVAS
+
+#ifndef _TK
+#include "tk.h"
+#endif
+
+#ifndef USE_OLD_TAG_SEARCH
+typedef struct TagSearchExpr_s TagSearchExpr;
+
+struct TagSearchExpr_s {
+ TagSearchExpr *next; /* For linked lists of expressions - used in
+ * bindings. */
+ Tk_Uid uid; /* The uid of the whole expression. */
+ Tk_Uid *uids; /* Expresion compiled to an array of uids. */
+ int allocated; /* Available space for array of uids. */
+ int length; /* Length of expression. */
+ int index; /* Current position in expression
+ * evaluation. */
+ int match; /* This expression matches event's item's
+ * tags. */
+};
+#endif /* not USE_OLD_TAG_SEARCH */
+
+/*
+ * The record below describes a canvas widget. It is made available to the
+ * item functions so they can access certain shared fields such as the overall
+ * displacement and scale factor for the canvas.
+ */
+
+typedef struct TkCanvas {
+ Tk_Window tkwin; /* Window that embodies the canvas. NULL means
+ * that the window has been destroyed but the
+ * data structures haven't yet been cleaned
+ * up.*/
+ Display *display; /* Display containing widget; needed, among
+ * other things, to release resources after
+ * tkwin has already gone away. */
+ Tcl_Interp *interp; /* Interpreter associated with canvas. */
+ Tcl_Command widgetCmd; /* Token for canvas's widget command. */
+ Tk_Item *firstItemPtr; /* First in list of all items in canvas, or
+ * NULL if canvas empty. */
+ Tk_Item *lastItemPtr; /* Last in list of all items in canvas, or
+ * NULL if canvas empty. */
+
+ /*
+ * Information used when displaying widget:
+ */
+
+ int borderWidth; /* Width of 3-D border around window. */
+ Tk_3DBorder bgBorder; /* Used for canvas background. */
+ int relief; /* Indicates whether window as a whole is
+ * raised, sunken, or flat. */
+ int highlightWidth; /* Width in pixels of highlight to draw around
+ * widget when it has the focus. <= 0 means
+ * don't draw a highlight. */
+ XColor *highlightBgColorPtr;
+ /* Color for drawing traversal highlight area
+ * when highlight is off. */
+ XColor *highlightColorPtr; /* Color for drawing traversal highlight. */
+ int inset; /* Total width of all borders, including
+ * traversal highlight and 3-D border.
+ * Indicates how much interior stuff must be
+ * offset from outside edges to leave room for
+ * borders. */
+ GC pixmapGC; /* Used to copy bits from a pixmap to the
+ * screen and also to clear the pixmap. */
+ int width, height; /* Dimensions to request for canvas window,
+ * specified in pixels. */
+ int redrawX1, redrawY1; /* Upper left corner of area to redraw, in
+ * pixel coordinates. Border pixels are
+ * included. Only valid if REDRAW_PENDING flag
+ * is set. */
+ int redrawX2, redrawY2; /* Lower right corner of area to redraw, in
+ * integer canvas coordinates. Border pixels
+ * will *not* be redrawn. */
+ int confine; /* Non-zero means constrain view to keep as
+ * much of canvas visible as possible. */
+
+ /*
+ * Information used to manage the selection and insertion cursor:
+ */
+
+ Tk_CanvasTextInfo textInfo; /* Contains lots of fields; see tk.h for
+ * details. This structure is shared with the
+ * code that implements individual items. */
+ int insertOnTime; /* Number of milliseconds cursor should spend
+ * in "on" state for each blink. */
+ int insertOffTime; /* Number of milliseconds cursor should spend
+ * in "off" state for each blink. */
+ Tcl_TimerToken insertBlinkHandler;
+ /* Timer handler used to blink cursor on and
+ * off. */
+
+ /*
+ * Transformation applied to canvas as a whole: to compute screen
+ * coordinates (X,Y) from canvas coordinates (x,y), do the following:
+ *
+ * X = x - xOrigin;
+ * Y = y - yOrigin;
+ */
+
+ int xOrigin, yOrigin; /* Canvas coordinates corresponding to
+ * upper-left corner of window, given in
+ * canvas pixel units. */
+ int drawableXOrigin, drawableYOrigin;
+ /* During redisplay, these fields give the
+ * canvas coordinates corresponding to the
+ * upper-left corner of the drawable where
+ * items are actually being drawn (typically a
+ * pixmap smaller than the whole window). */
+
+ /*
+ * Information used for event bindings associated with items.
+ */
+
+ Tk_BindingTable bindingTable;
+ /* Table of all bindings currently defined for
+ * this canvas. NULL means that no bindings
+ * exist, so the table hasn't been created.
+ * Each "object" used for this table is either
+ * a Tk_Uid for a tag or the address of an
+ * item named by id. */
+ Tk_Item *currentItemPtr; /* The item currently containing the mouse
+ * pointer, or NULL if none. */
+ Tk_Item *newCurrentPtr; /* The item that is about to become the
+ * current one, or NULL. This field is used to
+ * detect deletions of the new current item
+ * pointer that occur during Leave processing
+ * of the previous current item. */
+ double closeEnough; /* The mouse is assumed to be inside an item
+ * if it is this close to it. */
+ XEvent pickEvent; /* The event upon which the current choice of
+ * currentItem is based. Must be saved so that
+ * if the currentItem is deleted, can pick
+ * another. */
+ int state; /* Last known modifier state. Used to defer
+ * picking a new current object while buttons
+ * are down. */
+
+ /*
+ * Information used for managing scrollbars:
+ */
+
+ char *xScrollCmd; /* Command prefix for communicating with
+ * horizontal scrollbar. NULL means no
+ * horizontal scrollbar. Malloc'ed. */
+ char *yScrollCmd; /* Command prefix for communicating with
+ * vertical scrollbar. NULL means no vertical
+ * scrollbar. Malloc'ed. */
+ int scrollX1, scrollY1, scrollX2, scrollY2;
+ /* These four coordinates define the region
+ * that is the 100% area for scrolling (i.e.
+ * these numbers determine the size and
+ * location of the sliders on scrollbars).
+ * Units are pixels in canvas coords. */
+ char *regionString; /* The option string from which scrollX1 etc.
+ * are derived. Malloc'ed. */
+ int xScrollIncrement; /* If >0, defines a grid for horizontal
+ * scrolling. This is the size of the "unit",
+ * and the left edge of the screen will always
+ * lie on an even unit boundary. */
+ int yScrollIncrement; /* If >0, defines a grid for horizontal
+ * scrolling. This is the size of the "unit",
+ * and the left edge of the screen will always
+ * lie on an even unit boundary. */
+
+ /*
+ * Information used for scanning:
+ */
+
+ int scanX; /* X-position at which scan started (e.g.
+ * button was pressed here). */
+ int scanXOrigin; /* Value of xOrigin field when scan started. */
+ int scanY; /* Y-position at which scan started (e.g.
+ * button was pressed here). */
+ int scanYOrigin; /* Value of yOrigin field when scan started. */
+
+ /*
+ * Information used to speed up searches by remembering the last item
+ * created or found with an item id search.
+ */
+
+ Tk_Item *hotPtr; /* Pointer to "hot" item (one that's been
+ * recently used. NULL means there's no hot
+ * item. */
+ Tk_Item *hotPrevPtr; /* Pointer to predecessor to hotPtr (NULL
+ * means item is first in list). This is only
+ * a hint and may not really be hotPtr's
+ * predecessor. */
+
+ /*
+ * Miscellaneous information:
+ */
+
+ Tk_Cursor cursor; /* Current cursor for window, or None. */
+ char *takeFocus; /* Value of -takefocus option; not used in the
+ * C code, but used by keyboard traversal
+ * scripts. Malloc'ed, but may be NULL. */
+ double pixelsPerMM; /* Scale factor between MM and pixels; used
+ * when converting coordinates. */
+ int flags; /* Various flags; see below for
+ * definitions. */
+ int nextId; /* Number to use as id for next item created
+ * in widget. */
+ Tk_PostscriptInfo psInfo; /* Pointer to information used for generating
+ * Postscript for the canvas. NULL means no
+ * Postscript is currently being generated. */
+ Tcl_HashTable idTable; /* Table of integer indices. */
+
+ /*
+ * Additional information, added by the 'dash'-patch
+ */
+
+ void *reserved1;
+ Tk_State canvas_state; /* State of canvas. */
+ void *reserved2;
+ void *reserved3;
+ Tk_TSOffset tsoffset;
+#ifndef USE_OLD_TAG_SEARCH
+ TagSearchExpr *bindTagExprs;/* Linked list of tag expressions used in
+ * bindings. */
+#endif
+} TkCanvas;
+
+/*
+ * Flag bits for canvases:
+ *
+ * REDRAW_PENDING - 1 means a DoWhenIdle handler has already been
+ * created to redraw some or all of the canvas.
+ * REDRAW_BORDERS - 1 means that the borders need to be redrawn
+ * during the next redisplay operation.
+ * REPICK_NEEDED - 1 means DisplayCanvas should pick a new
+ * current item before redrawing the canvas.
+ * GOT_FOCUS - 1 means the focus is currently in this widget,
+ * so should draw the insertion cursor and
+ * traversal highlight.
+ * CURSOR_ON - 1 means the insertion cursor is in the "on"
+ * phase of its blink cycle. 0 means either we
+ * don't have the focus or the cursor is in the
+ * "off" phase of its cycle.
+ * UPDATE_SCROLLBARS - 1 means the scrollbars should get updated as
+ * part of the next display operation.
+ * LEFT_GRABBED_ITEM - 1 means that the mouse left the current item
+ * while a grab was in effect, so we didn't
+ * change canvasPtr->currentItemPtr.
+ * REPICK_IN_PROGRESS - 1 means PickCurrentItem is currently
+ * executing. If it should be called recursively,
+ * it should simply return immediately.
+ * BBOX_NOT_EMPTY - 1 means that the bounding box of the area that
+ * should be redrawn is not empty.
+ */
+
+#define REDRAW_PENDING 1
+#define REDRAW_BORDERS 2
+#define REPICK_NEEDED 4
+#define GOT_FOCUS 8
+#define CURSOR_ON 0x10
+#define UPDATE_SCROLLBARS 0x20
+#define LEFT_GRABBED_ITEM 0x40
+#define REPICK_IN_PROGRESS 0x100
+#define BBOX_NOT_EMPTY 0x200
+
+/*
+ * Flag bits for canvas items (redraw_flags):
+ *
+ * FORCE_REDRAW - 1 means that the new coordinates of some item
+ * are not yet registered using
+ * Tk_CanvasEventuallyRedraw(). It should still
+ * be done by the general canvas code.
+ */
+
+#define FORCE_REDRAW 8
+
+/*
+ * Canvas-related functions that are shared among Tk modules but not exported
+ * to the outside world:
+ */
+
+MODULE_SCOPE int TkCanvPostscriptCmd(TkCanvas *canvasPtr,
+ Tcl_Interp *interp, int argc, const char **argv);
+MODULE_SCOPE int TkCanvTranslatePath(TkCanvas *canvPtr,
+ int numVertex, double *coordPtr, int closed,
+ XPoint *outPtr);
+/*
+ * Standard item types provided by Tk:
+ */
+
+MODULE_SCOPE Tk_ItemType tkArcType, tkBitmapType, tkImageType, tkLineType;
+MODULE_SCOPE Tk_ItemType tkOvalType, tkPolygonType;
+MODULE_SCOPE Tk_ItemType tkRectangleType, tkTextType, tkWindowType;
+
+/*
+ * Convenience macro.
+ */
+
+#define Canvas(canvas) ((TkCanvas *) (canvas))
+
+#endif /* _TKCANVAS */
diff --git a/tk8.6/generic/tkClipboard.c b/tk8.6/generic/tkClipboard.c
new file mode 100644
index 0000000..b902625
--- /dev/null
+++ b/tk8.6/generic/tkClipboard.c
@@ -0,0 +1,721 @@
+/*
+ * tkClipboard.c --
+ *
+ * This file manages the clipboard for the Tk toolkit, maintaining a
+ * collection of data buffers that will be supplied on demand to
+ * requesting applications.
+ *
+ * Copyright (c) 1994 The Regents of the University of California.
+ * Copyright (c) 1994-1997 Sun Microsystems, Inc.
+ *
+ * See the file "license.terms" for information on usage and redistribution of
+ * this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ */
+
+#include "tkInt.h"
+#include "tkSelect.h"
+
+/*
+ * Prototypes for functions used only in this file:
+ */
+
+static int ClipboardAppHandler(ClientData clientData,
+ int offset, char *buffer, int maxBytes);
+static int ClipboardHandler(ClientData clientData,
+ int offset, char *buffer, int maxBytes);
+static int ClipboardWindowHandler(ClientData clientData,
+ int offset, char *buffer, int maxBytes);
+static void ClipboardLostSel(ClientData clientData);
+static int ClipboardGetProc(ClientData clientData,
+ Tcl_Interp *interp, const char *portion);
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ClipboardHandler --
+ *
+ * This function acts as selection handler for the clipboard manager. It
+ * extracts the required chunk of data from the buffer chain for a given
+ * selection target.
+ *
+ * Results:
+ * The return value is a count of the number of bytes actually stored at
+ * buffer.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+ClipboardHandler(
+ ClientData clientData, /* Information about data to fetch. */
+ int offset, /* Return selection bytes starting at this
+ * offset. */
+ char *buffer, /* Place to store converted selection. */
+ int maxBytes) /* Maximum # of bytes to store at buffer. */
+{
+ TkClipboardTarget *targetPtr = clientData;
+ TkClipboardBuffer *cbPtr;
+ char *srcPtr, *destPtr;
+ size_t count = 0;
+ int scanned = 0;
+ size_t length, freeCount;
+
+ /*
+ * Skip to buffer containing offset byte
+ */
+
+ for (cbPtr = targetPtr->firstBufferPtr; ; cbPtr = cbPtr->nextPtr) {
+ if (cbPtr == NULL) {
+ return 0;
+ }
+ if (scanned + cbPtr->length > offset) {
+ break;
+ }
+ scanned += cbPtr->length;
+ }
+
+ /*
+ * Copy up to maxBytes or end of list, switching buffers as needed.
+ */
+
+ freeCount = maxBytes;
+ srcPtr = cbPtr->buffer + (offset - scanned);
+ destPtr = buffer;
+ length = cbPtr->length - (offset - scanned);
+ while (1) {
+ if (length > freeCount) {
+ strncpy(destPtr, srcPtr, freeCount);
+ return maxBytes;
+ } else {
+ strncpy(destPtr, srcPtr, length);
+ destPtr += length;
+ count += length;
+ freeCount -= length;
+ }
+ cbPtr = cbPtr->nextPtr;
+ if (cbPtr == NULL) {
+ break;
+ }
+ srcPtr = cbPtr->buffer;
+ length = cbPtr->length;
+ }
+ return (int)count;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ClipboardAppHandler --
+ *
+ * This function acts as selection handler for retrievals of type
+ * TK_APPLICATION. It returns the name of the application that owns the
+ * clipboard. Note: we can't use the default Tk selection handler for
+ * this selection type, because the clipboard window isn't a "real"
+ * window and doesn't have the necessary information.
+ *
+ * Results:
+ * The return value is a count of the number of bytes actually stored at
+ * buffer.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+ClipboardAppHandler(
+ ClientData clientData, /* Pointer to TkDisplay structure. */
+ int offset, /* Return selection bytes starting at this
+ * offset. */
+ char *buffer, /* Place to store converted selection. */
+ int maxBytes) /* Maximum # of bytes to store at buffer. */
+{
+ TkDisplay *dispPtr = clientData;
+ size_t length;
+ const char *p;
+
+ p = dispPtr->clipboardAppPtr->winPtr->nameUid;
+ length = strlen(p);
+ length -= offset;
+ if (length <= 0) {
+ return 0;
+ }
+ if (length > (size_t) maxBytes) {
+ length = maxBytes;
+ }
+ strncpy(buffer, p, length);
+ return (int)length;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ClipboardWindowHandler --
+ *
+ * This function acts as selection handler for retrievals of type
+ * TK_WINDOW. Since the clipboard doesn't correspond to any particular
+ * window, we just return ".". We can't use Tk's default handler for this
+ * selection type, because the clipboard window isn't a valid window.
+ *
+ * Results:
+ * The return value is 1, the number of non-null bytes stored at buffer.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+ClipboardWindowHandler(
+ ClientData clientData, /* Not used. */
+ int offset, /* Return selection bytes starting at this
+ * offset. */
+ char *buffer, /* Place to store converted selection. */
+ int maxBytes) /* Maximum # of bytes to store at buffer. */
+{
+ buffer[0] = '.';
+ buffer[1] = 0;
+ return 1;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ClipboardLostSel --
+ *
+ * This function is invoked whenever clipboard ownership is claimed by
+ * another window. It just sets a flag so that we know the clipboard was
+ * taken away.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The clipboard is marked as inactive.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+ClipboardLostSel(
+ ClientData clientData) /* Pointer to TkDisplay structure. */
+{
+ TkDisplay *dispPtr = clientData;
+
+ dispPtr->clipboardActive = 0;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_ClipboardClear --
+ *
+ * Take control of the clipboard and clear out the previous contents.
+ * This function must be invoked before any calls to Tk_ClipboardAppend.
+ *
+ * Results:
+ * A standard Tcl result. If an error occurs, an error message is left in
+ * the interp's result.
+ *
+ * Side effects:
+ * From now on, requests for the CLIPBOARD selection will be directed to
+ * the clipboard manager routines associated with clipWindow for the
+ * display of tkwin. In order to guarantee atomicity, no event handling
+ * should occur between Tk_ClipboardClear and the following
+ * Tk_ClipboardAppend calls. This function may cause a user-defined
+ * LostSel command to be invoked when the CLIPBOARD is claimed, so any
+ * calling function should be reentrant at the point Tk_ClipboardClear is
+ * invoked.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tk_ClipboardClear(
+ Tcl_Interp *interp, /* Interpreter to use for error reporting. */
+ Tk_Window tkwin) /* Window in application that is clearing
+ * clipboard; identifies application and
+ * display. */
+{
+ TkWindow *winPtr = (TkWindow *) tkwin;
+ TkDisplay *dispPtr = winPtr->dispPtr;
+ TkClipboardTarget *targetPtr, *nextTargetPtr;
+ TkClipboardBuffer *cbPtr, *nextCbPtr;
+
+ if (dispPtr->clipWindow == NULL) {
+ int result;
+
+ result = TkClipInit(interp, dispPtr);
+ if (result != TCL_OK) {
+ return result;
+ }
+ }
+
+ /*
+ * Discard any existing clipboard data and delete the selection handler(s)
+ * associated with that data.
+ */
+
+ for (targetPtr = dispPtr->clipTargetPtr; targetPtr != NULL;
+ targetPtr = nextTargetPtr) {
+ for (cbPtr = targetPtr->firstBufferPtr; cbPtr != NULL;
+ cbPtr = nextCbPtr) {
+ ckfree(cbPtr->buffer);
+ nextCbPtr = cbPtr->nextPtr;
+ ckfree(cbPtr);
+ }
+ nextTargetPtr = targetPtr->nextPtr;
+ Tk_DeleteSelHandler(dispPtr->clipWindow, dispPtr->clipboardAtom,
+ targetPtr->type);
+ ckfree(targetPtr);
+ }
+ dispPtr->clipTargetPtr = NULL;
+
+ /*
+ * Reclaim the clipboard selection if we lost it.
+ */
+
+ if (!dispPtr->clipboardActive) {
+ Tk_OwnSelection(dispPtr->clipWindow, dispPtr->clipboardAtom,
+ ClipboardLostSel, dispPtr);
+ dispPtr->clipboardActive = 1;
+ }
+ dispPtr->clipboardAppPtr = winPtr->mainPtr;
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_ClipboardAppend --
+ *
+ * Append a buffer of data to the clipboard. The first buffer of a given
+ * type determines the format for that type. Any successive appends to
+ * that type must have the same format or an error will be returned.
+ * Tk_ClipboardClear must be called before a sequence of
+ * Tk_ClipboardAppend calls can be issued. In order to guarantee
+ * atomicity, no event handling should occur between Tk_ClipboardClear
+ * and the following Tk_ClipboardAppend calls.
+ *
+ * Results:
+ * A standard Tcl result. If an error is returned, an error message is
+ * left in the interp's result.
+ *
+ * Side effects:
+ * The specified buffer will be copied onto the end of the clipboard.
+ * The clipboard maintains a list of buffers which will be used to supply
+ * the data for a selection get request. The first time a given type is
+ * appended, Tk_ClipboardAppend will register a selection handler of the
+ * appropriate type.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tk_ClipboardAppend(
+ Tcl_Interp *interp, /* Used for error reporting. */
+ Tk_Window tkwin, /* Window that selects a display. */
+ Atom type, /* The desired conversion type for this
+ * clipboard item, e.g. STRING or LENGTH. */
+ Atom format, /* Format in which the selection information
+ * should be returned to the requestor. */
+ const char *buffer) /* NULL terminated string containing the data
+ * to be added to the clipboard. */
+{
+ TkWindow *winPtr = (TkWindow *) tkwin;
+ TkDisplay *dispPtr = winPtr->dispPtr;
+ TkClipboardTarget *targetPtr;
+ TkClipboardBuffer *cbPtr;
+
+ /*
+ * If this application doesn't already own the clipboard, clear the
+ * clipboard. If we don't own the clipboard selection, claim it.
+ */
+
+ if (dispPtr->clipboardAppPtr != winPtr->mainPtr) {
+ Tk_ClipboardClear(interp, tkwin);
+ } else if (!dispPtr->clipboardActive) {
+ Tk_OwnSelection(dispPtr->clipWindow, dispPtr->clipboardAtom,
+ ClipboardLostSel, dispPtr);
+ dispPtr->clipboardActive = 1;
+ }
+
+ /*
+ * Check to see if the specified target is already present on the
+ * clipboard. If it isn't, we need to create a new target; otherwise, we
+ * just append the new buffer to the clipboard list.
+ */
+
+ for (targetPtr = dispPtr->clipTargetPtr; targetPtr != NULL;
+ targetPtr = targetPtr->nextPtr) {
+ if (targetPtr->type == type) {
+ break;
+ }
+ }
+ if (targetPtr == NULL) {
+ targetPtr = ckalloc(sizeof(TkClipboardTarget));
+ targetPtr->type = type;
+ targetPtr->format = format;
+ targetPtr->firstBufferPtr = targetPtr->lastBufferPtr = NULL;
+ targetPtr->nextPtr = dispPtr->clipTargetPtr;
+ dispPtr->clipTargetPtr = targetPtr;
+ Tk_CreateSelHandler(dispPtr->clipWindow, dispPtr->clipboardAtom,
+ type, ClipboardHandler, targetPtr, format);
+ } else if (targetPtr->format != format) {
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "format \"%s\" does not match current format \"%s\" for %s",
+ Tk_GetAtomName(tkwin, format),
+ Tk_GetAtomName(tkwin, targetPtr->format),
+ Tk_GetAtomName(tkwin, type)));
+ Tcl_SetErrorCode(interp, "TK", "CLIPBOARD", "FORMAT_MISMATCH", NULL);
+ return TCL_ERROR;
+ }
+
+ /*
+ * Append a new buffer to the buffer chain.
+ */
+
+ cbPtr = ckalloc(sizeof(TkClipboardBuffer));
+ cbPtr->nextPtr = NULL;
+ if (targetPtr->lastBufferPtr != NULL) {
+ targetPtr->lastBufferPtr->nextPtr = cbPtr;
+ } else {
+ targetPtr->firstBufferPtr = cbPtr;
+ }
+ targetPtr->lastBufferPtr = cbPtr;
+
+ cbPtr->length = strlen(buffer);
+ cbPtr->buffer = ckalloc(cbPtr->length + 1);
+ strcpy(cbPtr->buffer, buffer);
+
+ TkSelUpdateClipboard((TkWindow *) dispPtr->clipWindow, targetPtr);
+
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_ClipboardObjCmd --
+ *
+ * This function is invoked to process the "clipboard" Tcl command. See
+ * the user documentation for details on what it does.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * See the user documentation.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tk_ClipboardObjCmd(
+ ClientData clientData, /* Main window associated with interpreter. */
+ Tcl_Interp *interp, /* Current interpreter. */
+ int objc, /* Number of arguments. */
+ Tcl_Obj *const objv[]) /* Argument strings. */
+{
+ Tk_Window tkwin = (Tk_Window) clientData;
+ const char *path = NULL;
+ Atom selection;
+ static const char *const optionStrings[] = { "append", "clear", "get", NULL };
+ enum options { CLIPBOARD_APPEND, CLIPBOARD_CLEAR, CLIPBOARD_GET };
+ int index, i;
+
+ if (objc < 2) {
+ Tcl_WrongNumArgs(interp, 1, objv, "option ?arg ...?");
+ return TCL_ERROR;
+ }
+
+ if (Tcl_GetIndexFromObj(interp, objv[1], optionStrings, "option", 0,
+ &index) != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ switch ((enum options) index) {
+ case CLIPBOARD_APPEND: {
+ Atom target, format;
+ const char *targetName = NULL;
+ const char *formatName = NULL;
+ const char *string;
+ static const char *const appendOptionStrings[] = {
+ "-displayof", "-format", "-type", NULL
+ };
+ enum appendOptions { APPEND_DISPLAYOF, APPEND_FORMAT, APPEND_TYPE };
+ int subIndex, length;
+
+ for (i = 2; i < objc - 1; i++) {
+ string = Tcl_GetStringFromObj(objv[i], &length);
+ if (string[0] != '-') {
+ break;
+ }
+
+ /*
+ * If the argument is "--", it signifies the end of arguments.
+ */
+ if (string[1] == '-' && length == 2) {
+ i++;
+ break;
+ }
+ if (Tcl_GetIndexFromObj(interp, objv[i], appendOptionStrings,
+ "option", 0, &subIndex) != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ /*
+ * Increment i so that it points to the value for the flag instead
+ * of the flag itself.
+ */
+
+ i++;
+ if (i >= objc) {
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "value for \"%s\" missing", string));
+ Tcl_SetErrorCode(interp, "TK", "CLIPBOARD", "VALUE", NULL);
+ return TCL_ERROR;
+ }
+ switch ((enum appendOptions) subIndex) {
+ case APPEND_DISPLAYOF:
+ path = Tcl_GetString(objv[i]);
+ break;
+ case APPEND_FORMAT:
+ formatName = Tcl_GetString(objv[i]);
+ break;
+ case APPEND_TYPE:
+ targetName = Tcl_GetString(objv[i]);
+ break;
+ }
+ }
+ if (objc - i != 1) {
+ Tcl_WrongNumArgs(interp, 2, objv, "?-option value ...? data");
+ return TCL_ERROR;
+ }
+ if (path != NULL) {
+ tkwin = Tk_NameToWindow(interp, path, tkwin);
+ }
+ if (tkwin == NULL) {
+ return TCL_ERROR;
+ }
+ if (targetName != NULL) {
+ target = Tk_InternAtom(tkwin, targetName);
+ } else {
+ target = XA_STRING;
+ }
+ if (formatName != NULL) {
+ format = Tk_InternAtom(tkwin, formatName);
+ } else {
+ format = XA_STRING;
+ }
+ return Tk_ClipboardAppend(interp, tkwin, target, format,
+ Tcl_GetString(objv[i]));
+ }
+ case CLIPBOARD_CLEAR: {
+ static const char *const clearOptionStrings[] = { "-displayof", NULL };
+ enum clearOptions { CLEAR_DISPLAYOF };
+ int subIndex;
+
+ if (objc != 2 && objc != 4) {
+ Tcl_WrongNumArgs(interp, 2, objv, "?-displayof window?");
+ return TCL_ERROR;
+ }
+
+ if (objc == 4) {
+ if (Tcl_GetIndexFromObj(interp, objv[2], clearOptionStrings,
+ "option", 0, &subIndex) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if ((enum clearOptions) subIndex == CLEAR_DISPLAYOF) {
+ path = Tcl_GetString(objv[3]);
+ }
+ }
+ if (path != NULL) {
+ tkwin = Tk_NameToWindow(interp, path, tkwin);
+ }
+ if (tkwin == NULL) {
+ return TCL_ERROR;
+ }
+ return Tk_ClipboardClear(interp, tkwin);
+ }
+ case CLIPBOARD_GET: {
+ Atom target;
+ const char *targetName = NULL;
+ Tcl_DString selBytes;
+ int result;
+ const char *string;
+ static const char *const getOptionStrings[] = {
+ "-displayof", "-type", NULL
+ };
+ enum getOptions { APPEND_DISPLAYOF, APPEND_TYPE };
+ int subIndex;
+
+ for (i = 2; i < objc; i++) {
+ string = Tcl_GetString(objv[i]);
+ if (string[0] != '-') {
+ break;
+ }
+ if (Tcl_GetIndexFromObj(interp, objv[i], getOptionStrings,
+ "option", 0, &subIndex) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ i++;
+ if (i >= objc) {
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "value for \"%s\" missing", string));
+ Tcl_SetErrorCode(interp, "TK", "CLIPBOARD", "VALUE", NULL);
+ return TCL_ERROR;
+ }
+ switch ((enum getOptions) subIndex) {
+ case APPEND_DISPLAYOF:
+ path = Tcl_GetString(objv[i]);
+ break;
+ case APPEND_TYPE:
+ targetName = Tcl_GetString(objv[i]);
+ break;
+ }
+ }
+ if (path != NULL) {
+ tkwin = Tk_NameToWindow(interp, path, tkwin);
+ }
+ if (tkwin == NULL) {
+ return TCL_ERROR;
+ }
+ selection = Tk_InternAtom(tkwin, "CLIPBOARD");
+
+ if (objc - i > 1) {
+ Tcl_WrongNumArgs(interp, 2, objv, "?-option value ...?");
+ return TCL_ERROR;
+ } else if (objc - i == 1) {
+ target = Tk_InternAtom(tkwin, Tcl_GetString(objv[i]));
+ } else if (targetName != NULL) {
+ target = Tk_InternAtom(tkwin, targetName);
+ } else {
+ target = XA_STRING;
+ }
+
+ Tcl_DStringInit(&selBytes);
+ result = Tk_GetSelection(interp, tkwin, selection, target,
+ ClipboardGetProc, &selBytes);
+ if (result == TCL_OK) {
+ Tcl_DStringResult(interp, &selBytes);
+ } else {
+ Tcl_DStringFree(&selBytes);
+ }
+ return result;
+ }
+ }
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkClipInit --
+ *
+ * This function is called to initialize the window for claiming
+ * clipboard ownership and for receiving selection get results. This
+ * function is called from tkSelect.c as well as tkClipboard.c.
+ *
+ * Results:
+ * The result is a standard Tcl return value, which is normally TCL_OK.
+ * If an error occurs then an error message is left in the interp's
+ * result and TCL_ERROR is returned.
+ *
+ * Side effects:
+ * Sets up the clipWindow and related data structures.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TkClipInit(
+ Tcl_Interp *interp, /* Interpreter to use for error reporting. */
+ register TkDisplay *dispPtr)/* Display to initialize. */
+{
+ XSetWindowAttributes atts;
+
+ dispPtr->clipTargetPtr = NULL;
+ dispPtr->clipboardActive = 0;
+ dispPtr->clipboardAppPtr = NULL;
+
+ /*
+ * Create the window used for clipboard ownership and selection retrieval,
+ * and set up an event handler for it.
+ */
+
+ dispPtr->clipWindow = (Tk_Window) TkAllocWindow(dispPtr,
+ DefaultScreen(dispPtr->display), NULL);
+ Tcl_Preserve(dispPtr->clipWindow);
+ ((TkWindow *) dispPtr->clipWindow)->flags |=
+ TK_TOP_HIERARCHY|TK_TOP_LEVEL|TK_HAS_WRAPPER|TK_WIN_MANAGED;
+ TkWmNewWindow((TkWindow *) dispPtr->clipWindow);
+ atts.override_redirect = True;
+ Tk_ChangeWindowAttributes(dispPtr->clipWindow, CWOverrideRedirect, &atts);
+ Tk_MakeWindowExist(dispPtr->clipWindow);
+
+ if (dispPtr->multipleAtom == None) {
+ /*
+ * Need to invoke selection initialization to make sure that atoms we
+ * depend on below are defined.
+ */
+
+ TkSelInit(dispPtr->clipWindow);
+ }
+
+ /*
+ * Create selection handlers for types TK_APPLICATION and TK_WINDOW on
+ * this window. Can't use the default handlers for these types because
+ * this isn't a full-fledged window.
+ */
+
+ Tk_CreateSelHandler(dispPtr->clipWindow, dispPtr->clipboardAtom,
+ dispPtr->applicationAtom, ClipboardAppHandler, dispPtr,XA_STRING);
+ Tk_CreateSelHandler(dispPtr->clipWindow, dispPtr->clipboardAtom,
+ dispPtr->windowAtom, ClipboardWindowHandler, dispPtr, XA_STRING);
+ return TCL_OK;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * ClipboardGetProc --
+ *
+ * This function is invoked to process pieces of the selection as they
+ * arrive during "clipboard get" commands.
+ *
+ * Results:
+ * Always returns TCL_OK.
+ *
+ * Side effects:
+ * Bytes get appended to the dynamic string pointed to by the clientData
+ * argument.
+ *
+ *--------------------------------------------------------------
+ */
+
+ /* ARGSUSED */
+static int
+ClipboardGetProc(
+ ClientData clientData, /* Dynamic string holding partially assembled
+ * selection. */
+ Tcl_Interp *interp, /* Interpreter used for error reporting (not
+ * used). */
+ const char *portion) /* New information to be appended. */
+{
+ Tcl_DStringAppend((Tcl_DString *) clientData, portion, -1);
+ return TCL_OK;
+}
+
+/*
+ * Local Variables:
+ * mode: c
+ * c-basic-offset: 4
+ * fill-column: 78
+ * End:
+ */
diff --git a/tk8.6/generic/tkCmds.c b/tk8.6/generic/tkCmds.c
new file mode 100644
index 0000000..6196b17
--- /dev/null
+++ b/tk8.6/generic/tkCmds.c
@@ -0,0 +1,2163 @@
+/*
+ * tkCmds.c --
+ *
+ * This file contains a collection of Tk-related Tcl commands that didn't
+ * fit in any particular file of the toolkit.
+ *
+ * Copyright (c) 1990-1994 The Regents of the University of California.
+ * Copyright (c) 1994-1997 Sun Microsystems, Inc.
+ * Copyright (c) 2000 Scriptics Corporation.
+ *
+ * See the file "license.terms" for information on usage and redistribution of
+ * this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ */
+
+#include "tkInt.h"
+
+#if defined(_WIN32)
+#include "tkWinInt.h"
+#elif defined(MAC_OSX_TK)
+#include "tkMacOSXInt.h"
+#else
+#include "tkUnixInt.h"
+#endif
+
+/*
+ * Forward declarations for functions defined later in this file:
+ */
+
+static TkWindow * GetTopHierarchy(Tk_Window tkwin);
+static char * WaitVariableProc(ClientData clientData,
+ Tcl_Interp *interp, const char *name1,
+ const char *name2, int flags);
+static void WaitVisibilityProc(ClientData clientData,
+ XEvent *eventPtr);
+static void WaitWindowProc(ClientData clientData,
+ XEvent *eventPtr);
+static int AppnameCmd(ClientData dummy, Tcl_Interp *interp,
+ int objc, Tcl_Obj *const *objv);
+static int CaretCmd(ClientData dummy, Tcl_Interp *interp,
+ int objc, Tcl_Obj *const *objv);
+static int InactiveCmd(ClientData dummy, Tcl_Interp *interp,
+ int objc, Tcl_Obj *const *objv);
+static int ScalingCmd(ClientData dummy, Tcl_Interp *interp,
+ int objc, Tcl_Obj *const *objv);
+static int UseinputmethodsCmd(ClientData dummy,
+ Tcl_Interp *interp, int objc,
+ Tcl_Obj *const *objv);
+static int WindowingsystemCmd(ClientData dummy,
+ Tcl_Interp *interp, int objc,
+ Tcl_Obj *const *objv);
+
+#if defined(_WIN32) || defined(MAC_OSX_TK)
+MODULE_SCOPE const TkEnsemble tkFontchooserEnsemble[];
+#else
+#define tkFontchooserEnsemble NULL
+#endif
+
+/*
+ * Table of tk subcommand names and implementations.
+ */
+
+static const TkEnsemble tkCmdMap[] = {
+ {"appname", AppnameCmd, NULL },
+ {"busy", Tk_BusyObjCmd, NULL },
+ {"caret", CaretCmd, NULL },
+ {"inactive", InactiveCmd, NULL },
+ {"scaling", ScalingCmd, NULL },
+ {"useinputmethods", UseinputmethodsCmd, NULL },
+ {"windowingsystem", WindowingsystemCmd, NULL },
+ {"fontchooser", NULL, tkFontchooserEnsemble},
+ {NULL, NULL, NULL}
+};
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_BellObjCmd --
+ *
+ * This function is invoked to process the "bell" Tcl command. See the
+ * user documentation for details on what it does.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * See the user documentation.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tk_BellObjCmd(
+ ClientData clientData, /* Main window associated with interpreter. */
+ Tcl_Interp *interp, /* Current interpreter. */
+ int objc, /* Number of arguments. */
+ Tcl_Obj *const objv[]) /* Argument objects. */
+{
+ static const char *const bellOptions[] = {
+ "-displayof", "-nice", NULL
+ };
+ enum options { TK_BELL_DISPLAYOF, TK_BELL_NICE };
+ Tk_Window tkwin = clientData;
+ int i, index, nice = 0;
+
+ if (objc > 4) {
+ wrongArgs:
+ Tcl_WrongNumArgs(interp, 1, objv, "?-displayof window? ?-nice?");
+ return TCL_ERROR;
+ }
+
+ for (i = 1; i < objc; i++) {
+ if (Tcl_GetIndexFromObjStruct(interp, objv[i], bellOptions,
+ sizeof(char *), "option", 0, &index) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ switch ((enum options) index) {
+ case TK_BELL_DISPLAYOF:
+ if (++i >= objc) {
+ goto wrongArgs;
+ }
+ tkwin = Tk_NameToWindow(interp, Tcl_GetString(objv[i]), tkwin);
+ if (tkwin == NULL) {
+ return TCL_ERROR;
+ }
+ break;
+ case TK_BELL_NICE:
+ nice = 1;
+ break;
+ }
+ }
+ XBell(Tk_Display(tkwin), 0);
+ if (!nice) {
+ XForceScreenSaver(Tk_Display(tkwin), ScreenSaverReset);
+ }
+ XFlush(Tk_Display(tkwin));
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_BindObjCmd --
+ *
+ * This function is invoked to process the "bind" Tcl command. See the
+ * user documentation for details on what it does.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * See the user documentation.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tk_BindObjCmd(
+ ClientData 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 = clientData;
+ TkWindow *winPtr;
+ ClientData object;
+ const char *string;
+
+ if ((objc < 2) || (objc > 4)) {
+ Tcl_WrongNumArgs(interp, 1, objv, "window ?pattern? ?command?");
+ return TCL_ERROR;
+ }
+ string = Tcl_GetString(objv[1]);
+
+ /*
+ * Bind tags either a window name or a tag name for the first argument.
+ * If the argument starts with ".", assume it is a window; otherwise, it
+ * is a tag.
+ */
+
+ if (string[0] == '.') {
+ winPtr = (TkWindow *) Tk_NameToWindow(interp, string, tkwin);
+ if (winPtr == NULL) {
+ return TCL_ERROR;
+ }
+ object = (ClientData) winPtr->pathName;
+ } else {
+ winPtr = clientData;
+ object = (ClientData) Tk_GetUid(string);
+ }
+
+ /*
+ * If there are four arguments, the command is modifying a binding. If
+ * there are three arguments, the command is querying a binding. If there
+ * are only two arguments, the command is querying all the bindings for
+ * the given tag/window.
+ */
+
+ if (objc == 4) {
+ int append = 0;
+ unsigned long mask;
+ const char *sequence = Tcl_GetString(objv[2]);
+ const char *script = Tcl_GetString(objv[3]);
+
+ /*
+ * If the script is null, just delete the binding.
+ */
+
+ if (script[0] == 0) {
+ return Tk_DeleteBinding(interp, winPtr->mainPtr->bindingTable,
+ object, sequence);
+ }
+
+ /*
+ * If the script begins with "+", append this script to the existing
+ * binding.
+ */
+
+ if (script[0] == '+') {
+ script++;
+ append = 1;
+ }
+ mask = Tk_CreateBinding(interp, winPtr->mainPtr->bindingTable,
+ object, sequence, script, append);
+ if (mask == 0) {
+ return TCL_ERROR;
+ }
+ } else if (objc == 3) {
+ const char *command;
+
+ command = Tk_GetBinding(interp, winPtr->mainPtr->bindingTable,
+ object, Tcl_GetString(objv[2]));
+ if (command == NULL) {
+ Tcl_ResetResult(interp);
+ return TCL_OK;
+ }
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(command, -1));
+ } else {
+ Tk_GetAllBindings(interp, winPtr->mainPtr->bindingTable, object);
+ }
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkBindEventProc --
+ *
+ * This function is invoked by Tk_HandleEvent for each event; it causes
+ * any appropriate bindings for that event to be invoked.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Depends on what bindings have been established with the "bind"
+ * command.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TkBindEventProc(
+ TkWindow *winPtr, /* Pointer to info about window. */
+ XEvent *eventPtr) /* Information about event. */
+{
+#define MAX_OBJS 20
+ ClientData objects[MAX_OBJS], *objPtr;
+ TkWindow *topLevPtr;
+ int i, count;
+ const char *p;
+ Tcl_HashEntry *hPtr;
+
+ if ((winPtr->mainPtr == NULL) || (winPtr->mainPtr->bindingTable == NULL)) {
+ return;
+ }
+
+ objPtr = objects;
+ if (winPtr->numTags != 0) {
+ /*
+ * Make a copy of the tags for the window, replacing window names with
+ * pointers to the pathName from the appropriate window.
+ */
+
+ if (winPtr->numTags > MAX_OBJS) {
+ objPtr = ckalloc(winPtr->numTags * sizeof(ClientData));
+ }
+ for (i = 0; i < winPtr->numTags; i++) {
+ p = winPtr->tagPtr[i];
+ if (*p == '.') {
+ hPtr = Tcl_FindHashEntry(&winPtr->mainPtr->nameTable, p);
+ if (hPtr != NULL) {
+ p = ((TkWindow *) Tcl_GetHashValue(hPtr))->pathName;
+ } else {
+ p = NULL;
+ }
+ }
+ objPtr[i] = (ClientData) p;
+ }
+ count = winPtr->numTags;
+ } else {
+ objPtr[0] = (ClientData) winPtr->pathName;
+ objPtr[1] = (ClientData) winPtr->classUid;
+ for (topLevPtr = winPtr;
+ (topLevPtr != NULL) && !(topLevPtr->flags & TK_TOP_HIERARCHY);
+ topLevPtr = topLevPtr->parentPtr) {
+ /* Empty loop body. */
+ }
+ if ((winPtr != topLevPtr) && (topLevPtr != NULL)) {
+ count = 4;
+ objPtr[2] = (ClientData) topLevPtr->pathName;
+ } else {
+ count = 3;
+ }
+ objPtr[count-1] = (ClientData) Tk_GetUid("all");
+ }
+ Tk_BindEvent(winPtr->mainPtr->bindingTable, eventPtr, (Tk_Window) winPtr,
+ count, objPtr);
+ if (objPtr != objects) {
+ ckfree(objPtr);
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_BindtagsObjCmd --
+ *
+ * This function is invoked to process the "bindtags" Tcl command. See
+ * the user documentation for details on what it does.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * See the user documentation.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tk_BindtagsObjCmd(
+ ClientData 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 = clientData;
+ TkWindow *winPtr, *winPtr2;
+ int i, length;
+ const char *p;
+ Tcl_Obj *listPtr, **tags;
+
+ if ((objc < 2) || (objc > 3)) {
+ Tcl_WrongNumArgs(interp, 1, objv, "window ?taglist?");
+ return TCL_ERROR;
+ }
+ winPtr = (TkWindow *) Tk_NameToWindow(interp, Tcl_GetString(objv[1]),
+ tkwin);
+ if (winPtr == NULL) {
+ return TCL_ERROR;
+ }
+ if (objc == 2) {
+ listPtr = Tcl_NewObj();
+ if (winPtr->numTags == 0) {
+ Tcl_ListObjAppendElement(NULL, listPtr,
+ Tcl_NewStringObj(winPtr->pathName, -1));
+ Tcl_ListObjAppendElement(NULL, listPtr,
+ Tcl_NewStringObj(winPtr->classUid, -1));
+ winPtr2 = winPtr;
+ while ((winPtr2 != NULL) && !(Tk_TopWinHierarchy(winPtr2))) {
+ winPtr2 = winPtr2->parentPtr;
+ }
+ if ((winPtr != winPtr2) && (winPtr2 != NULL)) {
+ Tcl_ListObjAppendElement(NULL, listPtr,
+ Tcl_NewStringObj(winPtr2->pathName, -1));
+ }
+ Tcl_ListObjAppendElement(NULL, listPtr,
+ Tcl_NewStringObj("all", -1));
+ } else {
+ for (i = 0; i < winPtr->numTags; i++) {
+ Tcl_ListObjAppendElement(NULL, listPtr,
+ Tcl_NewStringObj((char *) winPtr->tagPtr[i], -1));
+ }
+ }
+ Tcl_SetObjResult(interp, listPtr);
+ return TCL_OK;
+ }
+ if (winPtr->tagPtr != NULL) {
+ TkFreeBindingTags(winPtr);
+ }
+ if (Tcl_ListObjGetElements(interp, objv[2], &length, &tags) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (length == 0) {
+ return TCL_OK;
+ }
+
+ winPtr->numTags = length;
+ winPtr->tagPtr = ckalloc(length * sizeof(ClientData));
+ for (i = 0; i < length; i++) {
+ p = Tcl_GetString(tags[i]);
+ if (p[0] == '.') {
+ char *copy;
+
+ /*
+ * Handle names starting with "." specially: store a malloc'ed
+ * string, rather than a Uid; at event time we'll look up the name
+ * in the window table and use the corresponding window, if there
+ * is one.
+ */
+
+ copy = ckalloc(strlen(p) + 1);
+ strcpy(copy, p);
+ winPtr->tagPtr[i] = (ClientData) copy;
+ } else {
+ winPtr->tagPtr[i] = (ClientData) Tk_GetUid(p);
+ }
+ }
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkFreeBindingTags --
+ *
+ * This function is called to free all of the binding tags associated
+ * with a window; typically it is only invoked where there are
+ * window-specific tags.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Any binding tags for winPtr are freed.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TkFreeBindingTags(
+ TkWindow *winPtr) /* Window whose tags are to be released. */
+{
+ int i;
+ const char *p;
+
+ for (i = 0; i < winPtr->numTags; i++) {
+ p = winPtr->tagPtr[i];
+ if (*p == '.') {
+ /*
+ * Names starting with "." are malloced rather than Uids, so they
+ * have to be freed.
+ */
+
+ ckfree((char *)p);
+ }
+ }
+ ckfree(winPtr->tagPtr);
+ winPtr->numTags = 0;
+ winPtr->tagPtr = NULL;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_DestroyObjCmd --
+ *
+ * This function is invoked to process the "destroy" Tcl command. See the
+ * user documentation for details on what it does.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * See the user documentation.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tk_DestroyObjCmd(
+ ClientData clientData, /* Main window associated with interpreter. */
+ Tcl_Interp *interp, /* Current interpreter. */
+ int objc, /* Number of arguments. */
+ Tcl_Obj *const objv[]) /* Argument objects. */
+{
+ Tk_Window window;
+ Tk_Window tkwin = clientData;
+ int i;
+
+ for (i = 1; i < objc; i++) {
+ window = Tk_NameToWindow(interp, Tcl_GetString(objv[i]), tkwin);
+ if (window == NULL) {
+ Tcl_ResetResult(interp);
+ continue;
+ }
+ Tk_DestroyWindow(window);
+ if (window == tkwin) {
+ /*
+ * We just deleted the main window for the application! This makes
+ * it impossible to do anything more (tkwin isn't valid anymore).
+ */
+
+ break;
+ }
+ }
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_LowerObjCmd --
+ *
+ * This function is invoked to process the "lower" Tcl command. See the
+ * user documentation for details on what it does.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * See the user documentation.
+ *
+ *----------------------------------------------------------------------
+ */
+
+ /* ARGSUSED */
+int
+Tk_LowerObjCmd(
+ ClientData clientData, /* Main window associated with interpreter. */
+ Tcl_Interp *interp, /* Current interpreter. */
+ int objc, /* Number of arguments. */
+ Tcl_Obj *const objv[]) /* Argument objects. */
+{
+ Tk_Window mainwin = clientData;
+ Tk_Window tkwin, other;
+
+ if ((objc != 2) && (objc != 3)) {
+ Tcl_WrongNumArgs(interp, 1, objv, "window ?belowThis?");
+ return TCL_ERROR;
+ }
+
+ tkwin = Tk_NameToWindow(interp, Tcl_GetString(objv[1]), mainwin);
+ if (tkwin == NULL) {
+ return TCL_ERROR;
+ }
+ if (objc == 2) {
+ other = NULL;
+ } else {
+ other = Tk_NameToWindow(interp, Tcl_GetString(objv[2]), mainwin);
+ if (other == NULL) {
+ return TCL_ERROR;
+ }
+ }
+ if (Tk_RestackWindow(tkwin, Below, other) != TCL_OK) {
+ if (other) {
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "can't lower \"%s\" below \"%s\"",
+ Tcl_GetString(objv[1]), Tcl_GetString(objv[2])));
+ } else {
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "can't lower \"%s\" to bottom", Tcl_GetString(objv[1])));
+ }
+ Tcl_SetErrorCode(interp, "TK", "RESTACK", "LOWER", NULL);
+ return TCL_ERROR;
+ }
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_RaiseObjCmd --
+ *
+ * This function is invoked to process the "raise" Tcl command. See the
+ * user documentation for details on what it does.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * See the user documentation.
+ *
+ *----------------------------------------------------------------------
+ */
+
+ /* ARGSUSED */
+int
+Tk_RaiseObjCmd(
+ ClientData clientData, /* Main window associated with interpreter. */
+ Tcl_Interp *interp, /* Current interpreter. */
+ int objc, /* Number of arguments. */
+ Tcl_Obj *const objv[]) /* Argument objects. */
+{
+ Tk_Window mainwin = clientData;
+ Tk_Window tkwin, other;
+
+ if ((objc != 2) && (objc != 3)) {
+ Tcl_WrongNumArgs(interp, 1, objv, "window ?aboveThis?");
+ return TCL_ERROR;
+ }
+
+ tkwin = Tk_NameToWindow(interp, Tcl_GetString(objv[1]), mainwin);
+ if (tkwin == NULL) {
+ return TCL_ERROR;
+ }
+ if (objc == 2) {
+ other = NULL;
+ } else {
+ other = Tk_NameToWindow(interp, Tcl_GetString(objv[2]), mainwin);
+ if (other == NULL) {
+ return TCL_ERROR;
+ }
+ }
+ if (Tk_RestackWindow(tkwin, Above, other) != TCL_OK) {
+ if (other) {
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "can't raise \"%s\" above \"%s\"",
+ Tcl_GetString(objv[1]), Tcl_GetString(objv[2])));
+ } else {
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "can't raise \"%s\" to top", Tcl_GetString(objv[1])));
+ }
+ Tcl_SetErrorCode(interp, "TK", "RESTACK", "RAISE", NULL);
+ return TCL_ERROR;
+ }
+ return TCL_OK;
+}
+
+/*
+ * ----------------------------------------------------------------------
+ *
+ * TkInitTkCmd --
+ *
+ * Set up the tk ensemble.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * None.
+ *
+ * ----------------------------------------------------------------------
+ */
+
+int
+TkInitTkCmd(
+ Tcl_Interp *interp,
+ ClientData clientData)
+{
+ TkMakeEnsemble(interp, "::", "tk", clientData, tkCmdMap);
+#if defined(_WIN32) || defined(MAC_OSX_TK)
+ TkInitFontchooser(interp, clientData);
+#endif
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * AppnameCmd, CaretCmd, ScalingCmd, UseinputmethodsCmd,
+ * WindowingsystemCmd, InactiveCmd --
+ *
+ * These functions are invoked to process the "tk" ensemble subcommands.
+ * See the user documentation for details on what they do.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * See the user documentation.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+AppnameCmd(
+ 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 = clientData;
+ TkWindow *winPtr;
+ const char *string;
+
+ if (Tcl_IsSafe(interp)) {
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "appname not accessible in a safe interpreter", -1));
+ Tcl_SetErrorCode(interp, "TK", "SAFE", "APPLICATION", NULL);
+ return TCL_ERROR;
+ }
+
+ winPtr = (TkWindow *) tkwin;
+
+ if (objc > 2) {
+ Tcl_WrongNumArgs(interp, 1, objv, "?newName?");
+ return TCL_ERROR;
+ }
+ if (objc == 2) {
+ string = Tcl_GetString(objv[1]);
+ winPtr->nameUid = Tk_GetUid(Tk_SetAppName(tkwin, string));
+ }
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(winPtr->nameUid, -1));
+ return TCL_OK;
+}
+
+int
+CaretCmd(
+ 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 = clientData;
+ int index;
+ Tcl_Obj *objPtr;
+ TkCaret *caretPtr;
+ Tk_Window window;
+ static const char *const caretStrings[] = {
+ "-x", "-y", "-height", NULL
+ };
+ enum caretOptions {
+ TK_CARET_X, TK_CARET_Y, TK_CARET_HEIGHT
+ };
+
+ if ((objc < 2) || ((objc > 3) && !!(objc & 1))) {
+ Tcl_WrongNumArgs(interp, 1, objv,
+ "window ?-x x? ?-y y? ?-height height?");
+ return TCL_ERROR;
+ }
+ window = Tk_NameToWindow(interp, Tcl_GetString(objv[1]), tkwin);
+ if (window == NULL) {
+ return TCL_ERROR;
+ }
+ caretPtr = &(((TkWindow *) window)->dispPtr->caret);
+ if (objc == 2) {
+ /*
+ * Return all the current values
+ */
+
+ objPtr = Tcl_NewObj();
+ Tcl_ListObjAppendElement(interp, objPtr,
+ Tcl_NewStringObj("-height", 7));
+ Tcl_ListObjAppendElement(interp, objPtr,
+ Tcl_NewIntObj(caretPtr->height));
+ Tcl_ListObjAppendElement(interp, objPtr,
+ Tcl_NewStringObj("-x", 2));
+ Tcl_ListObjAppendElement(interp, objPtr,
+ Tcl_NewIntObj(caretPtr->x));
+ Tcl_ListObjAppendElement(interp, objPtr,
+ Tcl_NewStringObj("-y", 2));
+ Tcl_ListObjAppendElement(interp, objPtr,
+ Tcl_NewIntObj(caretPtr->y));
+ Tcl_SetObjResult(interp, objPtr);
+ } else if (objc == 3) {
+ int value;
+
+ /*
+ * Return the current value of the selected option
+ */
+
+ if (Tcl_GetIndexFromObj(interp, objv[2], caretStrings,
+ "caret option", 0, &index) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (index == TK_CARET_X) {
+ value = caretPtr->x;
+ } else if (index == TK_CARET_Y) {
+ value = caretPtr->y;
+ } else /* if (index == TK_CARET_HEIGHT) -- last case */ {
+ value = caretPtr->height;
+ }
+ Tcl_SetObjResult(interp, Tcl_NewIntObj(value));
+ } else {
+ int i, value, x = 0, y = 0, height = -1;
+
+ for (i = 2; i < objc; i += 2) {
+ if ((Tcl_GetIndexFromObj(interp, objv[i], caretStrings,
+ "caret option", 0, &index) != TCL_OK) ||
+ Tcl_GetIntFromObj(interp,objv[i+1],&value) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (index == TK_CARET_X) {
+ x = value;
+ } else if (index == TK_CARET_Y) {
+ y = value;
+ } else /* if (index == TK_CARET_HEIGHT) -- last case */ {
+ height = value;
+ }
+ }
+ if (height < 0) {
+ height = Tk_Height(window);
+ }
+ Tk_SetCaretPos(window, x, y, height);
+ }
+ return TCL_OK;
+}
+
+int
+ScalingCmd(
+ 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 = clientData;
+ Screen *screenPtr;
+ int skip, width, height;
+ double d;
+
+ if (Tcl_IsSafe(interp)) {
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "scaling not accessible in a safe interpreter", -1));
+ Tcl_SetErrorCode(interp, "TK", "SAFE", "SCALING", NULL);
+ return TCL_ERROR;
+ }
+
+ skip = TkGetDisplayOf(interp, objc - 1, objv + 1, &tkwin);
+ if (skip < 0) {
+ return TCL_ERROR;
+ }
+ screenPtr = Tk_Screen(tkwin);
+ if (objc - skip == 1) {
+ d = 25.4 / 72;
+ d *= WidthOfScreen(screenPtr);
+ d /= WidthMMOfScreen(screenPtr);
+ Tcl_SetObjResult(interp, Tcl_NewDoubleObj(d));
+ } else if (objc - skip == 2) {
+ if (Tcl_GetDoubleFromObj(interp, objv[1+skip], &d) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ d = (25.4 / 72) / d;
+ width = (int) (d * WidthOfScreen(screenPtr) + 0.5);
+ if (width <= 0) {
+ width = 1;
+ }
+ height = (int) (d * HeightOfScreen(screenPtr) + 0.5);
+ if (height <= 0) {
+ height = 1;
+ }
+ WidthMMOfScreen(screenPtr) = width;
+ HeightMMOfScreen(screenPtr) = height;
+ } else {
+ Tcl_WrongNumArgs(interp, 1, objv, "?-displayof window? ?factor?");
+ return TCL_ERROR;
+ }
+ return TCL_OK;
+}
+
+int
+UseinputmethodsCmd(
+ 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 = clientData;
+ TkDisplay *dispPtr;
+ int skip;
+
+ if (Tcl_IsSafe(interp)) {
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "useinputmethods not accessible in a safe interpreter", -1));
+ Tcl_SetErrorCode(interp, "TK", "SAFE", "INPUT_METHODS", NULL);
+ return TCL_ERROR;
+ }
+
+ skip = TkGetDisplayOf(interp, objc-1, objv+1, &tkwin);
+ if (skip < 0) {
+ return TCL_ERROR;
+ }
+ dispPtr = ((TkWindow *) tkwin)->dispPtr;
+ if ((objc - skip) == 2) {
+ /*
+ * In the case where TK_USE_INPUT_METHODS is not defined, this
+ * will be ignored and we will always return 0. That will indicate
+ * to the user that input methods are just not available.
+ */
+
+ int boolVal;
+
+ if (Tcl_GetBooleanFromObj(interp, objv[1+skip],
+ &boolVal) != TCL_OK) {
+ return TCL_ERROR;
+ }
+#ifdef TK_USE_INPUT_METHODS
+ if (boolVal) {
+ dispPtr->flags |= TK_DISPLAY_USE_IM;
+ } else {
+ dispPtr->flags &= ~TK_DISPLAY_USE_IM;
+ }
+#endif /* TK_USE_INPUT_METHODS */
+ } else if ((objc - skip) != 1) {
+ Tcl_WrongNumArgs(interp, 1, objv,
+ "?-displayof window? ?boolean?");
+ return TCL_ERROR;
+ }
+ Tcl_SetObjResult(interp,
+ Tcl_NewBooleanObj(dispPtr->flags & TK_DISPLAY_USE_IM));
+ return TCL_OK;
+}
+
+int
+WindowingsystemCmd(
+ ClientData clientData, /* Main window associated with interpreter. */
+ Tcl_Interp *interp, /* Current interpreter. */
+ int objc, /* Number of arguments. */
+ Tcl_Obj *const objv[]) /* Argument objects. */
+{
+ const char *windowingsystem;
+
+ if (objc != 1) {
+ Tcl_WrongNumArgs(interp, 1, objv, NULL);
+ return TCL_ERROR;
+ }
+#if defined(_WIN32)
+ windowingsystem = "win32";
+#elif defined(MAC_OSX_TK)
+ windowingsystem = "aqua";
+#else
+ windowingsystem = "x11";
+#endif
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(windowingsystem, -1));
+ return TCL_OK;
+}
+
+int
+InactiveCmd(
+ 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 = clientData;
+ int skip = TkGetDisplayOf(interp, objc - 1, objv + 1, &tkwin);
+
+ if (skip < 0) {
+ return TCL_ERROR;
+ }
+ if (objc - skip == 1) {
+ long inactive;
+
+ inactive = (Tcl_IsSafe(interp) ? -1 :
+ Tk_GetUserInactiveTime(Tk_Display(tkwin)));
+ Tcl_SetObjResult(interp, Tcl_NewLongObj(inactive));
+ } else if (objc - skip == 2) {
+ const char *string;
+
+ string = Tcl_GetString(objv[objc-1]);
+ if (strcmp(string, "reset") != 0) {
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "bad option \"%s\": must be reset", string));
+ Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "INDEX", "option",
+ string, NULL);
+ return TCL_ERROR;
+ }
+ if (Tcl_IsSafe(interp)) {
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "resetting the user inactivity timer "
+ "is not allowed in a safe interpreter", -1));
+ Tcl_SetErrorCode(interp, "TK", "SAFE", "INACTIVITY_TIMER", NULL);
+ return TCL_ERROR;
+ }
+ Tk_ResetUserInactiveTime(Tk_Display(tkwin));
+ Tcl_ResetResult(interp);
+ } else {
+ Tcl_WrongNumArgs(interp, 1, objv, "?-displayof window? ?reset?");
+ return TCL_ERROR;
+ }
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_TkwaitObjCmd --
+ *
+ * This function is invoked to process the "tkwait" Tcl command. See the
+ * user documentation for details on what it does.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * See the user documentation.
+ *
+ *----------------------------------------------------------------------
+ */
+
+ /* ARGSUSED */
+int
+Tk_TkwaitObjCmd(
+ ClientData 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 = clientData;
+ int done, index;
+ int code = TCL_OK;
+ static const char *const optionStrings[] = {
+ "variable", "visibility", "window", NULL
+ };
+ enum options {
+ TKWAIT_VARIABLE, TKWAIT_VISIBILITY, TKWAIT_WINDOW
+ };
+
+ if (objc != 3) {
+ Tcl_WrongNumArgs(interp, 1, objv, "variable|visibility|window name");
+ return TCL_ERROR;
+ }
+
+ if (Tcl_GetIndexFromObj(interp, objv[1], optionStrings, "option", 0,
+ &index) != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ switch ((enum options) index) {
+ case TKWAIT_VARIABLE:
+ if (Tcl_TraceVar2(interp, Tcl_GetString(objv[2]),
+ NULL, TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS,
+ WaitVariableProc, &done) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ done = 0;
+ while (!done) {
+ if (Tcl_Canceled(interp, TCL_LEAVE_ERR_MSG) == TCL_ERROR) {
+ code = TCL_ERROR;
+ break;
+ }
+ Tcl_DoOneEvent(0);
+ }
+ Tcl_UntraceVar2(interp, Tcl_GetString(objv[2]),
+ NULL, TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS,
+ WaitVariableProc, &done);
+ break;
+
+ case TKWAIT_VISIBILITY: {
+ Tk_Window window;
+
+ window = Tk_NameToWindow(interp, Tcl_GetString(objv[2]), tkwin);
+ if (window == NULL) {
+ return TCL_ERROR;
+ }
+ Tk_CreateEventHandler(window,
+ VisibilityChangeMask|StructureNotifyMask,
+ WaitVisibilityProc, &done);
+ done = 0;
+ while (!done) {
+ if (Tcl_Canceled(interp, TCL_LEAVE_ERR_MSG) == TCL_ERROR) {
+ code = TCL_ERROR;
+ break;
+ }
+ Tcl_DoOneEvent(0);
+ }
+ if ((done != 0) && (done != 1)) {
+ /*
+ * Note that we do not delete the event handler because it was
+ * deleted automatically when the window was destroyed.
+ */
+
+ Tcl_ResetResult(interp);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "window \"%s\" was deleted before its visibility changed",
+ Tcl_GetString(objv[2])));
+ Tcl_SetErrorCode(interp, "TK", "WAIT", "PREMATURE", NULL);
+ return TCL_ERROR;
+ }
+ Tk_DeleteEventHandler(window,
+ VisibilityChangeMask|StructureNotifyMask,
+ WaitVisibilityProc, &done);
+ break;
+ }
+
+ case TKWAIT_WINDOW: {
+ Tk_Window window;
+
+ window = Tk_NameToWindow(interp, Tcl_GetString(objv[2]), tkwin);
+ if (window == NULL) {
+ return TCL_ERROR;
+ }
+ Tk_CreateEventHandler(window, StructureNotifyMask,
+ WaitWindowProc, &done);
+ done = 0;
+ while (!done) {
+ if (Tcl_Canceled(interp, TCL_LEAVE_ERR_MSG) == TCL_ERROR) {
+ code = TCL_ERROR;
+ break;
+ }
+ Tcl_DoOneEvent(0);
+ }
+
+ /*
+ * Note: normally there's no need to delete the event handler. It was
+ * deleted automatically when the window was destroyed; however, if
+ * the wait operation was canceled, we need to delete it.
+ */
+
+ if (done == 0) {
+ Tk_DeleteEventHandler(window, StructureNotifyMask,
+ WaitWindowProc, &done);
+ }
+ break;
+ }
+ }
+
+ /*
+ * Clear out the interpreter's result, since it may have been set by event
+ * handlers. This is skipped if an error occurred above, such as the wait
+ * operation being canceled.
+ */
+
+ if (code == TCL_OK)
+ Tcl_ResetResult(interp);
+
+ return code;
+}
+
+ /* ARGSUSED */
+static char *
+WaitVariableProc(
+ ClientData clientData, /* Pointer to integer to set to 1. */
+ Tcl_Interp *interp, /* Interpreter containing variable. */
+ const char *name1, /* Name of variable. */
+ const char *name2, /* Second part of variable name. */
+ int flags) /* Information about what happened. */
+{
+ int *donePtr = clientData;
+
+ *donePtr = 1;
+ return NULL;
+}
+
+ /*ARGSUSED*/
+static void
+WaitVisibilityProc(
+ ClientData clientData, /* Pointer to integer to set to 1. */
+ XEvent *eventPtr) /* Information about event (not used). */
+{
+ int *donePtr = clientData;
+
+ if (eventPtr->type == VisibilityNotify) {
+ *donePtr = 1;
+ } else if (eventPtr->type == DestroyNotify) {
+ *donePtr = 2;
+ }
+}
+
+static void
+WaitWindowProc(
+ ClientData clientData, /* Pointer to integer to set to 1. */
+ XEvent *eventPtr) /* Information about event. */
+{
+ int *donePtr = clientData;
+
+ if (eventPtr->type == DestroyNotify) {
+ *donePtr = 1;
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_UpdateObjCmd --
+ *
+ * This function is invoked to process the "update" Tcl command. See the
+ * user documentation for details on what it does.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * See the user documentation.
+ *
+ *----------------------------------------------------------------------
+ */
+
+ /* ARGSUSED */
+int
+Tk_UpdateObjCmd(
+ ClientData clientData, /* Main window associated with interpreter. */
+ Tcl_Interp *interp, /* Current interpreter. */
+ int objc, /* Number of arguments. */
+ Tcl_Obj *const objv[]) /* Argument objects. */
+{
+ static const char *const updateOptions[] = {"idletasks", NULL};
+ int flags, index;
+ TkDisplay *dispPtr;
+ int code = TCL_OK;
+
+ if (objc == 1) {
+ flags = TCL_DONT_WAIT;
+ } else if (objc == 2) {
+ if (Tcl_GetIndexFromObj(interp, objv[1], updateOptions, "option", 0,
+ &index) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ flags = TCL_IDLE_EVENTS;
+ } else {
+ Tcl_WrongNumArgs(interp, 1, objv, "?idletasks?");
+ return TCL_ERROR;
+ }
+
+ /*
+ * Handle all pending events, sync all displays, and repeat over and over
+ * again until all pending events have been handled. Special note: it's
+ * possible that the entire application could be destroyed by an event
+ * handler that occurs during the update. Thus, don't use any information
+ * from tkwin after calling Tcl_DoOneEvent.
+ */
+
+ while (1) {
+ while (Tcl_DoOneEvent(flags) != 0) {
+ if (Tcl_Canceled(interp, TCL_LEAVE_ERR_MSG) == TCL_ERROR) {
+ code = TCL_ERROR;
+ break;
+ }
+ }
+
+ /*
+ * If event processing was canceled proceed no further.
+ */
+
+ if (code == TCL_ERROR)
+ break;
+
+ for (dispPtr = TkGetDisplayList(); dispPtr != NULL;
+ dispPtr = dispPtr->nextPtr) {
+ XSync(dispPtr->display, False);
+ }
+
+ /*
+ * Check again if event processing has been canceled because the inner
+ * loop (above) may not have checked (i.e. no events were processed and
+ * the loop body was skipped).
+ */
+
+ if (Tcl_Canceled(interp, TCL_LEAVE_ERR_MSG) == TCL_ERROR) {
+ code = TCL_ERROR;
+ break;
+ }
+
+ if (Tcl_DoOneEvent(flags) == 0) {
+ break;
+ }
+ }
+
+ /*
+ * Must clear the interpreter's result because event handlers could have
+ * executed commands. This is skipped if an error occurred above, such as
+ * the wait operation being canceled.
+ */
+
+ if (code == TCL_OK)
+ Tcl_ResetResult(interp);
+
+ return code;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_WinfoObjCmd --
+ *
+ * This function is invoked to process the "winfo" Tcl command. See the
+ * user documentation for details on what it does.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * See the user documentation.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tk_WinfoObjCmd(
+ ClientData clientData, /* Main window associated with interpreter. */
+ Tcl_Interp *interp, /* Current interpreter. */
+ int objc, /* Number of arguments. */
+ Tcl_Obj *const objv[]) /* Argument objects. */
+{
+ int index, x, y, width, height, useX, useY, class, skip;
+ const char *string;
+ TkWindow *winPtr;
+ Tk_Window tkwin = clientData;
+
+ static const TkStateMap visualMap[] = {
+ {PseudoColor, "pseudocolor"},
+ {GrayScale, "grayscale"},
+ {DirectColor, "directcolor"},
+ {TrueColor, "truecolor"},
+ {StaticColor, "staticcolor"},
+ {StaticGray, "staticgray"},
+ {-1, NULL}
+ };
+ static const char *const optionStrings[] = {
+ "cells", "children", "class", "colormapfull",
+ "depth", "geometry", "height", "id",
+ "ismapped", "manager", "name", "parent",
+ "pointerx", "pointery", "pointerxy", "reqheight",
+ "reqwidth", "rootx", "rooty", "screen",
+ "screencells", "screendepth", "screenheight", "screenwidth",
+ "screenmmheight","screenmmwidth","screenvisual","server",
+ "toplevel", "viewable", "visual", "visualid",
+ "vrootheight", "vrootwidth", "vrootx", "vrooty",
+ "width", "x", "y",
+
+ "atom", "atomname", "containing", "interps",
+ "pathname",
+
+ "exists", "fpixels", "pixels", "rgb",
+ "visualsavailable",
+
+ NULL
+ };
+ enum options {
+ WIN_CELLS, WIN_CHILDREN, WIN_CLASS, WIN_COLORMAPFULL,
+ WIN_DEPTH, WIN_GEOMETRY, WIN_HEIGHT, WIN_ID,
+ WIN_ISMAPPED, WIN_MANAGER, WIN_NAME, WIN_PARENT,
+ WIN_POINTERX, WIN_POINTERY, WIN_POINTERXY, WIN_REQHEIGHT,
+ WIN_REQWIDTH, WIN_ROOTX, WIN_ROOTY, WIN_SCREEN,
+ WIN_SCREENCELLS,WIN_SCREENDEPTH,WIN_SCREENHEIGHT,WIN_SCREENWIDTH,
+ WIN_SCREENMMHEIGHT,WIN_SCREENMMWIDTH,WIN_SCREENVISUAL,WIN_SERVER,
+ WIN_TOPLEVEL, WIN_VIEWABLE, WIN_VISUAL, WIN_VISUALID,
+ WIN_VROOTHEIGHT,WIN_VROOTWIDTH, WIN_VROOTX, WIN_VROOTY,
+ WIN_WIDTH, WIN_X, WIN_Y,
+
+ WIN_ATOM, WIN_ATOMNAME, WIN_CONTAINING, WIN_INTERPS,
+ WIN_PATHNAME,
+
+ WIN_EXISTS, WIN_FPIXELS, WIN_PIXELS, WIN_RGB,
+ WIN_VISUALSAVAILABLE
+ };
+
+ if (objc < 2) {
+ Tcl_WrongNumArgs(interp, 1, objv, "option ?arg?");
+ return TCL_ERROR;
+ }
+ if (Tcl_GetIndexFromObj(interp, objv[1], optionStrings, "option", 0,
+ &index) != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ if (index < WIN_ATOM) {
+ if (objc != 3) {
+ Tcl_WrongNumArgs(interp, 2, objv, "window");
+ return TCL_ERROR;
+ }
+ string = Tcl_GetString(objv[2]);
+ tkwin = Tk_NameToWindow(interp, string, tkwin);
+ if (tkwin == NULL) {
+ return TCL_ERROR;
+ }
+ }
+ winPtr = (TkWindow *) tkwin;
+
+ switch ((enum options) index) {
+ case WIN_CELLS:
+ Tcl_SetObjResult(interp,
+ Tcl_NewIntObj(Tk_Visual(tkwin)->map_entries));
+ break;
+ case WIN_CHILDREN: {
+ Tcl_Obj *strPtr, *resultPtr = Tcl_NewObj();
+
+ winPtr = winPtr->childList;
+ for ( ; winPtr != NULL; winPtr = winPtr->nextPtr) {
+ if (!(winPtr->flags & TK_ANONYMOUS_WINDOW)) {
+ strPtr = Tcl_NewStringObj(winPtr->pathName, -1);
+ Tcl_ListObjAppendElement(NULL, resultPtr, strPtr);
+ }
+ }
+ Tcl_SetObjResult(interp, resultPtr);
+ break;
+ }
+ case WIN_CLASS:
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(Tk_Class(tkwin), -1));
+ break;
+ case WIN_COLORMAPFULL:
+ Tcl_SetObjResult(interp,
+ Tcl_NewBooleanObj(TkpCmapStressed(tkwin,Tk_Colormap(tkwin))));
+ break;
+ case WIN_DEPTH:
+ Tcl_SetObjResult(interp, Tcl_NewIntObj(Tk_Depth(tkwin)));
+ break;
+ case WIN_GEOMETRY:
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf("%dx%d+%d+%d",
+ Tk_Width(tkwin), Tk_Height(tkwin), Tk_X(tkwin), Tk_Y(tkwin)));
+ break;
+ case WIN_HEIGHT:
+ Tcl_SetObjResult(interp, Tcl_NewIntObj(Tk_Height(tkwin)));
+ break;
+ case WIN_ID: {
+ char buf[TCL_INTEGER_SPACE];
+
+ Tk_MakeWindowExist(tkwin);
+ TkpPrintWindowId(buf, Tk_WindowId(tkwin));
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(buf, -1));
+ break;
+ }
+ case WIN_ISMAPPED:
+ Tcl_SetObjResult(interp, Tcl_NewBooleanObj(Tk_IsMapped(tkwin)));
+ break;
+ case WIN_MANAGER:
+ if (winPtr->geomMgrPtr != NULL) {
+ Tcl_SetObjResult(interp,
+ Tcl_NewStringObj(winPtr->geomMgrPtr->name, -1));
+ }
+ break;
+ case WIN_NAME:
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(Tk_Name(tkwin), -1));
+ break;
+ case WIN_PARENT:
+ if (winPtr->parentPtr != NULL) {
+ Tcl_SetObjResult(interp,
+ Tcl_NewStringObj(winPtr->parentPtr->pathName, -1));
+ }
+ break;
+ case WIN_POINTERX:
+ useX = 1;
+ useY = 0;
+ goto pointerxy;
+ case WIN_POINTERY:
+ useX = 0;
+ useY = 1;
+ goto pointerxy;
+ case WIN_POINTERXY:
+ useX = 1;
+ useY = 1;
+
+ pointerxy:
+ winPtr = GetTopHierarchy(tkwin);
+ if (winPtr == NULL) {
+ x = -1;
+ y = -1;
+ } else {
+ TkGetPointerCoords((Tk_Window) winPtr, &x, &y);
+ }
+ if (useX & useY) {
+ Tcl_Obj *xyObj[2];
+
+ xyObj[0] = Tcl_NewIntObj(x);
+ xyObj[1] = Tcl_NewIntObj(y);
+ Tcl_SetObjResult(interp, Tcl_NewListObj(2, xyObj));
+ } else if (useX) {
+ Tcl_SetObjResult(interp, Tcl_NewIntObj(x));
+ } else {
+ Tcl_SetObjResult(interp, Tcl_NewIntObj(y));
+ }
+ break;
+ case WIN_REQHEIGHT:
+ Tcl_SetObjResult(interp, Tcl_NewIntObj(Tk_ReqHeight(tkwin)));
+ break;
+ case WIN_REQWIDTH:
+ Tcl_SetObjResult(interp, Tcl_NewIntObj(Tk_ReqWidth(tkwin)));
+ break;
+ case WIN_ROOTX:
+ Tk_GetRootCoords(tkwin, &x, &y);
+ Tcl_SetObjResult(interp, Tcl_NewIntObj(x));
+ break;
+ case WIN_ROOTY:
+ Tk_GetRootCoords(tkwin, &x, &y);
+ Tcl_SetObjResult(interp, Tcl_NewIntObj(y));
+ break;
+ case WIN_SCREEN:
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf("%s.%d",
+ Tk_DisplayName(tkwin), Tk_ScreenNumber(tkwin)));
+ break;
+ case WIN_SCREENCELLS:
+ Tcl_SetObjResult(interp,
+ Tcl_NewIntObj(CellsOfScreen(Tk_Screen(tkwin))));
+ break;
+ case WIN_SCREENDEPTH:
+ Tcl_SetObjResult(interp,
+ Tcl_NewIntObj(DefaultDepthOfScreen(Tk_Screen(tkwin))));
+ break;
+ case WIN_SCREENHEIGHT:
+ Tcl_SetObjResult(interp,
+ Tcl_NewIntObj(HeightOfScreen(Tk_Screen(tkwin))));
+ break;
+ case WIN_SCREENWIDTH:
+ Tcl_SetObjResult(interp,
+ Tcl_NewIntObj(WidthOfScreen(Tk_Screen(tkwin))));
+ break;
+ case WIN_SCREENMMHEIGHT:
+ Tcl_SetObjResult(interp,
+ Tcl_NewIntObj(HeightMMOfScreen(Tk_Screen(tkwin))));
+ break;
+ case WIN_SCREENMMWIDTH:
+ Tcl_SetObjResult(interp,
+ Tcl_NewIntObj(WidthMMOfScreen(Tk_Screen(tkwin))));
+ break;
+ case WIN_SCREENVISUAL:
+ class = DefaultVisualOfScreen(Tk_Screen(tkwin))->class;
+ goto visual;
+ case WIN_SERVER:
+ TkGetServerInfo(interp, tkwin);
+ break;
+ case WIN_TOPLEVEL:
+ winPtr = GetTopHierarchy(tkwin);
+ if (winPtr != NULL) {
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(winPtr->pathName, -1));
+ }
+ break;
+ case WIN_VIEWABLE: {
+ int viewable = 0;
+
+ for ( ; ; winPtr = winPtr->parentPtr) {
+ if ((winPtr == NULL) || !(winPtr->flags & TK_MAPPED)) {
+ break;
+ }
+ if (winPtr->flags & TK_TOP_HIERARCHY) {
+ viewable = 1;
+ break;
+ }
+ }
+
+ Tcl_SetObjResult(interp, Tcl_NewBooleanObj(viewable));
+ break;
+ }
+ case WIN_VISUAL:
+ class = Tk_Visual(tkwin)->class;
+
+ visual:
+ string = TkFindStateString(visualMap, class);
+ if (string == NULL) {
+ string = "unknown";
+ }
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(string, -1));
+ break;
+ case WIN_VISUALID:
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf("0x%x", (unsigned)
+ XVisualIDFromVisual(Tk_Visual(tkwin))));
+ break;
+ case WIN_VROOTHEIGHT:
+ Tk_GetVRootGeometry(tkwin, &x, &y, &width, &height);
+ Tcl_SetObjResult(interp, Tcl_NewIntObj(height));
+ break;
+ case WIN_VROOTWIDTH:
+ Tk_GetVRootGeometry(tkwin, &x, &y, &width, &height);
+ Tcl_SetObjResult(interp, Tcl_NewIntObj(width));
+ break;
+ case WIN_VROOTX:
+ Tk_GetVRootGeometry(tkwin, &x, &y, &width, &height);
+ Tcl_SetObjResult(interp, Tcl_NewIntObj(x));
+ break;
+ case WIN_VROOTY:
+ Tk_GetVRootGeometry(tkwin, &x, &y, &width, &height);
+ Tcl_SetObjResult(interp, Tcl_NewIntObj(y));
+ break;
+ case WIN_WIDTH:
+ Tcl_SetObjResult(interp, Tcl_NewIntObj(Tk_Width(tkwin)));
+ break;
+ case WIN_X:
+ Tcl_SetObjResult(interp, Tcl_NewIntObj(Tk_X(tkwin)));
+ break;
+ case WIN_Y:
+ Tcl_SetObjResult(interp, Tcl_NewIntObj(Tk_Y(tkwin)));
+ break;
+
+ /*
+ * Uses -displayof.
+ */
+
+ case WIN_ATOM:
+ skip = TkGetDisplayOf(interp, objc - 2, objv + 2, &tkwin);
+ if (skip < 0) {
+ return TCL_ERROR;
+ }
+ if (objc - skip != 3) {
+ Tcl_WrongNumArgs(interp, 2, objv, "?-displayof window? name");
+ return TCL_ERROR;
+ }
+ objv += skip;
+ string = Tcl_GetString(objv[2]);
+ Tcl_SetObjResult(interp,
+ Tcl_NewLongObj((long) Tk_InternAtom(tkwin, string)));
+ break;
+ case WIN_ATOMNAME: {
+ const char *name;
+ long id;
+
+ skip = TkGetDisplayOf(interp, objc - 2, objv + 2, &tkwin);
+ if (skip < 0) {
+ return TCL_ERROR;
+ }
+ if (objc - skip != 3) {
+ Tcl_WrongNumArgs(interp, 2, objv, "?-displayof window? id");
+ return TCL_ERROR;
+ }
+ objv += skip;
+ if (Tcl_GetLongFromObj(interp, objv[2], &id) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ name = Tk_GetAtomName(tkwin, (Atom) id);
+ if (strcmp(name, "?bad atom?") == 0) {
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "no atom exists with id \"%s\"", Tcl_GetString(objv[2])));
+ Tcl_SetErrorCode(interp, "TK", "LOOKUP", "ATOM",
+ Tcl_GetString(objv[2]), NULL);
+ return TCL_ERROR;
+ }
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(name, -1));
+ break;
+ }
+ case WIN_CONTAINING:
+ skip = TkGetDisplayOf(interp, objc - 2, objv + 2, &tkwin);
+ if (skip < 0) {
+ return TCL_ERROR;
+ }
+ if (objc - skip != 4) {
+ Tcl_WrongNumArgs(interp, 2, objv,
+ "?-displayof window? rootX rootY");
+ return TCL_ERROR;
+ }
+ objv += skip;
+ string = Tcl_GetString(objv[2]);
+ if (Tk_GetPixels(interp, tkwin, string, &x) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ string = Tcl_GetString(objv[3]);
+ if (Tk_GetPixels(interp, tkwin, string, &y) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ tkwin = Tk_CoordsToWindow(x, y, tkwin);
+ if (tkwin != NULL) {
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(Tk_PathName(tkwin),-1));
+ }
+ break;
+ case WIN_INTERPS:
+ skip = TkGetDisplayOf(interp, objc - 2, objv + 2, &tkwin);
+ if (skip < 0) {
+ return TCL_ERROR;
+ }
+ if (objc - skip != 2) {
+ Tcl_WrongNumArgs(interp, 2, objv, "?-displayof window?");
+ return TCL_ERROR;
+ }
+ return TkGetInterpNames(interp, tkwin);
+ case WIN_PATHNAME: {
+ Window id;
+
+ skip = TkGetDisplayOf(interp, objc - 2, objv + 2, &tkwin);
+ if (skip < 0) {
+ return TCL_ERROR;
+ }
+ if (objc - skip != 3) {
+ Tcl_WrongNumArgs(interp, 2, objv, "?-displayof window? id");
+ return TCL_ERROR;
+ }
+ string = Tcl_GetString(objv[2 + skip]);
+ if (TkpScanWindowId(interp, string, &id) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ winPtr = (TkWindow *) Tk_IdToWindow(Tk_Display(tkwin), id);
+ if ((winPtr == NULL) ||
+ (winPtr->mainPtr != ((TkWindow *) tkwin)->mainPtr)) {
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "window id \"%s\" doesn't exist in this application",
+ string));
+ Tcl_SetErrorCode(interp, "TK", "LOOKUP", "WINDOW", string, NULL);
+ return TCL_ERROR;
+ }
+
+ /*
+ * If the window is a utility window with no associated path (such as
+ * a wrapper window or send communication window), just return an
+ * empty string.
+ */
+
+ tkwin = (Tk_Window) winPtr;
+ if (Tk_PathName(tkwin) != NULL) {
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(Tk_PathName(tkwin),-1));
+ }
+ break;
+ }
+
+ /*
+ * objv[3] is window.
+ */
+
+ case WIN_EXISTS: {
+ int alive;
+
+ if (objc != 3) {
+ Tcl_WrongNumArgs(interp, 2, objv, "window");
+ return TCL_ERROR;
+ }
+ string = Tcl_GetString(objv[2]);
+ winPtr = (TkWindow *) Tk_NameToWindow(interp, string, tkwin);
+ Tcl_ResetResult(interp);
+
+ alive = 1;
+ if ((winPtr == NULL) || (winPtr->flags & TK_ALREADY_DEAD)) {
+ alive = 0;
+ }
+ Tcl_SetObjResult(interp, Tcl_NewBooleanObj(alive));
+ break;
+ }
+ case WIN_FPIXELS: {
+ double mm, pixels;
+
+ if (objc != 4) {
+ Tcl_WrongNumArgs(interp, 2, objv, "window number");
+ return TCL_ERROR;
+ }
+ if (TkGetWindowFromObj(interp, tkwin, objv[2], &tkwin) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ string = Tcl_GetString(objv[3]);
+ if (Tk_GetScreenMM(interp, tkwin, string, &mm) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ pixels = mm * WidthOfScreen(Tk_Screen(tkwin))
+ / WidthMMOfScreen(Tk_Screen(tkwin));
+ Tcl_SetObjResult(interp, Tcl_NewDoubleObj(pixels));
+ break;
+ }
+ case WIN_PIXELS: {
+ int pixels;
+
+ if (objc != 4) {
+ Tcl_WrongNumArgs(interp, 2, objv, "window number");
+ return TCL_ERROR;
+ }
+ if (TkGetWindowFromObj(interp, tkwin, objv[2], &tkwin) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ string = Tcl_GetString(objv[3]);
+ if (Tk_GetPixels(interp, tkwin, string, &pixels) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ Tcl_SetObjResult(interp, Tcl_NewIntObj(pixels));
+ break;
+ }
+ case WIN_RGB: {
+ XColor *colorPtr;
+
+ if (objc != 4) {
+ Tcl_WrongNumArgs(interp, 2, objv, "window colorName");
+ return TCL_ERROR;
+ }
+ if (TkGetWindowFromObj(interp, tkwin, objv[2], &tkwin) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ colorPtr = Tk_GetColor(interp, tkwin, Tcl_GetString(objv[3]));
+ if (colorPtr == NULL) {
+ return TCL_ERROR;
+ }
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf("%d %d %d",
+ colorPtr->red, colorPtr->green, colorPtr->blue));
+ Tk_FreeColor(colorPtr);
+ break;
+ }
+ case WIN_VISUALSAVAILABLE: {
+ XVisualInfo template, *visInfoPtr;
+ int count, i;
+ int includeVisualId;
+ Tcl_Obj *strPtr, *resultPtr;
+ char buf[16 + TCL_INTEGER_SPACE];
+ char visualIdString[TCL_INTEGER_SPACE];
+
+ if (objc == 3) {
+ includeVisualId = 0;
+ } else if ((objc == 4)
+ && (strcmp(Tcl_GetString(objv[3]), "includeids") == 0)) {
+ includeVisualId = 1;
+ } else {
+ Tcl_WrongNumArgs(interp, 2, objv, "window ?includeids?");
+ return TCL_ERROR;
+ }
+
+ if (TkGetWindowFromObj(interp, tkwin, objv[2], &tkwin) != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ template.screen = Tk_ScreenNumber(tkwin);
+ visInfoPtr = XGetVisualInfo(Tk_Display(tkwin), VisualScreenMask,
+ &template, &count);
+ if (visInfoPtr == NULL) {
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "can't find any visuals for screen", -1));
+ Tcl_SetErrorCode(interp, "TK", "VISUAL", "NONE", NULL);
+ return TCL_ERROR;
+ }
+ resultPtr = Tcl_NewObj();
+ for (i = 0; i < count; i++) {
+ string = TkFindStateString(visualMap, visInfoPtr[i].class);
+ if (string == NULL) {
+ strcpy(buf, "unknown");
+ } else {
+ sprintf(buf, "%s %d", string, visInfoPtr[i].depth);
+ }
+ if (includeVisualId) {
+ sprintf(visualIdString, " 0x%x",
+ (unsigned) visInfoPtr[i].visualid);
+ strcat(buf, visualIdString);
+ }
+ strPtr = Tcl_NewStringObj(buf, -1);
+ Tcl_ListObjAppendElement(NULL, resultPtr, strPtr);
+ }
+ Tcl_SetObjResult(interp, resultPtr);
+ XFree((char *) visInfoPtr);
+ break;
+ }
+ }
+ return TCL_OK;
+}
+
+#if 0
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_WmObjCmd --
+ *
+ * This function is invoked to process the "wm" Tcl command. See the user
+ * documentation for details on what it does.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * See the user documentation.
+ *
+ *----------------------------------------------------------------------
+ */
+
+ /* ARGSUSED */
+int
+Tk_WmObjCmd(
+ ClientData clientData, /* Main window associated with interpreter. */
+ Tcl_Interp *interp, /* Current interpreter. */
+ int objc, /* Number of arguments. */
+ Tcl_Obj *const objv[]) /* Argument objects. */
+{
+ Tk_Window tkwin;
+ TkWindow *winPtr;
+
+ static const char *const 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", NULL
+ };
+ enum options {
+ TKWM_ASPECT, TKWM_CLIENT, TKWM_COMMAND, TKWM_DEICONIFY,
+ TKWM_FOCUSMOD, TKWM_FRAME, TKWM_GEOMETRY, TKWM_GRID,
+ TKWM_GROUP, TKWM_ICONBMP, TKWM_ICONIFY, TKWM_ICONMASK,
+ TKWM_ICONNAME, TKWM_ICONPOS, TKWM_ICONWIN, TKWM_MAXSIZE,
+ TKWM_MINSIZE, TKWM_OVERRIDE, TKWM_POSFROM, TKWM_PROTOCOL,
+ TKWM_RESIZABLE, TKWM_SIZEFROM, TKWM_STATE, TKWM_TITLE,
+ TKWM_TRACING, TKWM_TRANSIENT, TKWM_WITHDRAW
+ };
+
+ tkwin = (Tk_Window) clientData;
+
+ if (objc < 2) {
+ Tcl_WrongNumArgs(interp, 1, objv, "option window ?arg?");
+ return TCL_ERROR;
+ }
+ if (Tcl_GetIndexFromObj(interp, objv[1], optionStrings, "option", 0,
+ &index) != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ if (index == TKWM_TRACING) {
+ int wmTracing;
+ TkDisplay *dispPtr = ((TkWindow *) tkwin)->dispPtr;
+
+ if ((objc != 2) && (objc != 3)) {
+ Tcl_WrongNumArgs(interp, 1, objv, "tracing ?boolean?");
+ return TCL_ERROR;
+ }
+ if (objc == 2) {
+ Tcl_SetObjResult(interp, Tcl_NewBooleanObj(
+ dispPtr->flags & TK_DISPLAY_WM_TRACING));
+ return TCL_OK;
+ }
+ if (Tcl_GetBooleanFromObj(interp, objv[2], &wmTracing) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (wmTracing) {
+ dispPtr->flags |= TK_DISPLAY_WM_TRACING;
+ } else {
+ dispPtr->flags &= ~TK_DISPLAY_WM_TRACING;
+ }
+ return TCL_OK;
+ }
+
+ if (objc < 3) {
+ Tcl_WrongNumArgs(interp, 2, objv, "window ?arg?");
+ return TCL_ERROR;
+ }
+
+ winPtr = (TkWindow *) Tk_NameToWindow(interp,
+ Tcl_GetString(objv[2]), tkwin);
+ if (winPtr == NULL) {
+ return TCL_ERROR;
+ }
+ if (!(winPtr->flags & TK_TOP_LEVEL)) {
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "window \"%s\" isn't a top-level window", winPtr->pathName));
+ Tcl_SetErrorCode(interp, "TK", "LOOKUP", "TOPLEVEL", winPtr->pathName,
+ 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, winPtr);
+ wmPtr->flags |= WM_UPDATE_PENDING;
+ }
+ return TCL_OK;
+}
+#endif
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkGetDisplayOf --
+ *
+ * Parses a "-displayof window" option for various commands. If present,
+ * the literal "-displayof" should be in objv[0] and the window name in
+ * objv[1].
+ *
+ * Results:
+ * The return value is 0 if the argument strings did not contain the
+ * "-displayof" option. The return value is 2 if the argument strings
+ * contained both the "-displayof" option and a valid window name.
+ * Otherwise, the return value is -1 if the window name was missing or
+ * did not specify a valid window.
+ *
+ * If the return value was 2, *tkwinPtr is filled with the token for the
+ * window specified on the command line. If the return value was -1, an
+ * error message is left in interp's result object.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TkGetDisplayOf(
+ Tcl_Interp *interp, /* Interpreter for error reporting. */
+ int objc, /* Number of arguments. */
+ Tcl_Obj *const objv[], /* Argument objects. If it is present,
+ * "-displayof" should be in objv[0] and
+ * objv[1] the name of a window. */
+ Tk_Window *tkwinPtr) /* On input, contains main window of
+ * application associated with interp. On
+ * output, filled with window specified as
+ * option to "-displayof" argument, or
+ * unmodified if "-displayof" argument was not
+ * present. */
+{
+ const char *string;
+ int length;
+
+ if (objc < 1) {
+ return 0;
+ }
+ string = Tcl_GetStringFromObj(objv[0], &length);
+ if ((length >= 2) &&
+ (strncmp(string, "-displayof", (unsigned) length) == 0)) {
+ if (objc < 2) {
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "value for \"-displayof\" missing", -1));
+ Tcl_SetErrorCode(interp, "TK", "NO_VALUE", "DISPLAYOF", NULL);
+ return -1;
+ }
+ *tkwinPtr = Tk_NameToWindow(interp, Tcl_GetString(objv[1]), *tkwinPtr);
+ if (*tkwinPtr == NULL) {
+ return -1;
+ }
+ return 2;
+ }
+ return 0;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkDeadAppObjCmd --
+ *
+ * If an application has been deleted then all Tk commands will be
+ * re-bound to this function.
+ *
+ * Results:
+ * A standard Tcl error is reported to let the user know that the
+ * application is dead.
+ *
+ * Side effects:
+ * See the user documentation.
+ *
+ *----------------------------------------------------------------------
+ */
+
+ /* ARGSUSED */
+int
+TkDeadAppObjCmd(
+ ClientData clientData, /* Dummy. */
+ Tcl_Interp *interp, /* Current interpreter. */
+ int objc, /* Number of arguments. */
+ Tcl_Obj *const objv[]) /* Argument strings. */
+{
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "can't invoke \"%s\" command: application has been destroyed",
+ Tcl_GetString(objv[0])));
+ return TCL_ERROR;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * GetTopHierarchy --
+ *
+ * Retrieves the top-of-hierarchy window which is the nearest ancestor of
+ * the specified window.
+ *
+ * Results:
+ * Returns the top-of-hierarchy window, or NULL if the window has no
+ * ancestor which is at the top of a physical window hierarchy.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static TkWindow *
+GetTopHierarchy(
+ Tk_Window tkwin) /* Window for which the top-of-hierarchy
+ * ancestor should be deterined. */
+{
+ TkWindow *winPtr = (TkWindow *) tkwin;
+
+ while ((winPtr != NULL) && !(winPtr->flags & TK_TOP_HIERARCHY)) {
+ winPtr = winPtr->parentPtr;
+ }
+ return winPtr;
+}
+
+/*
+ * Local Variables:
+ * mode: c
+ * c-basic-offset: 4
+ * fill-column: 78
+ * End:
+ */
diff --git a/tk8.6/generic/tkColor.c b/tk8.6/generic/tkColor.c
new file mode 100644
index 0000000..9abb448
--- /dev/null
+++ b/tk8.6/generic/tkColor.c
@@ -0,0 +1,947 @@
+/*
+ * tkColor.c --
+ *
+ * This file maintains a database of color values for the Tk toolkit, in
+ * order to avoid round-trips to the server to map color names to pixel
+ * values.
+ *
+ * Copyright (c) 1990-1994 The Regents of the University of California.
+ * Copyright (c) 1994-1997 Sun Microsystems, Inc.
+ *
+ * See the file "license.terms" for information on usage and redistribution of
+ * this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ */
+
+#include "tkInt.h"
+#include "tkColor.h"
+
+/*
+ * Structures of the following following type are used as keys for
+ * colorValueTable (in TkDisplay).
+ */
+
+typedef struct {
+ int red, green, blue; /* Values for desired color. */
+ Colormap colormap; /* Colormap from which color will be
+ * allocated. */
+ Display *display; /* Display for colormap. */
+} ValueKey;
+
+/*
+ * The structure below is used to allocate thread-local data.
+ */
+
+typedef struct ThreadSpecificData {
+ char rgbString[20]; /* */
+} ThreadSpecificData;
+static Tcl_ThreadDataKey dataKey;
+
+/*
+ * Forward declarations for functions defined in this file:
+ */
+
+static void ColorInit(TkDisplay *dispPtr);
+static void DupColorObjProc(Tcl_Obj *srcObjPtr,Tcl_Obj *dupObjPtr);
+static void FreeColorObj(Tcl_Obj *objPtr);
+static void FreeColorObjProc(Tcl_Obj *objPtr);
+static void InitColorObj(Tcl_Obj *objPtr);
+
+/*
+ * The following structure defines the implementation of the "color" Tcl
+ * object, which maps a string color name to a TkColor object. The ptr1 field
+ * of the Tcl_Obj points to a TkColor object.
+ */
+
+const Tcl_ObjType tkColorObjType = {
+ "color", /* name */
+ FreeColorObjProc, /* freeIntRepProc */
+ DupColorObjProc, /* dupIntRepProc */
+ NULL, /* updateStringProc */
+ NULL /* setFromAnyProc */
+};
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_AllocColorFromObj --
+ *
+ * Given a Tcl_Obj *, map the value to a corresponding XColor structure
+ * based on the tkwin given.
+ *
+ * Results:
+ * The return value is a pointer to an XColor structure that indicates
+ * the red, blue, and green intensities for the color given by the string
+ * in objPtr, and also specifies a pixel value to use to draw in that
+ * color. If an error occurs, NULL is returned and an error message will
+ * be left in interp's result (unless interp is NULL).
+ *
+ * Side effects:
+ * The color is added to an internal database with a reference count. For
+ * each call to this function, there should eventually be a call to
+ * Tk_FreeColorFromObj so that the database is cleaned up when colors
+ * aren't in use anymore.
+ *
+ *----------------------------------------------------------------------
+ */
+
+XColor *
+Tk_AllocColorFromObj(
+ Tcl_Interp *interp, /* Used only for error reporting. If NULL,
+ * then no messages are provided. */
+ Tk_Window tkwin, /* Window in which the color will be used.*/
+ Tcl_Obj *objPtr) /* Object that describes the color; string
+ * value is a color name such as "red" or
+ * "#ff0000".*/
+{
+ TkColor *tkColPtr;
+
+ if (objPtr->typePtr != &tkColorObjType) {
+ InitColorObj(objPtr);
+ }
+ tkColPtr = (TkColor *) objPtr->internalRep.twoPtrValue.ptr1;
+
+ /*
+ * If the object currently points to a TkColor, see if it's the one we
+ * want. If so, increment its reference count and return.
+ */
+
+ if (tkColPtr != NULL) {
+ if (tkColPtr->resourceRefCount == 0) {
+ /*
+ * This is a stale reference: it refers to a TkColor that's no
+ * longer in use. Clear the reference.
+ */
+
+ FreeColorObj(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 = Tcl_GetHashValue(tkColPtr->hashPtr);
+
+ FreeColorObj(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 = 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 = tkColPtr;
+ if (tkColPtr != NULL) {
+ tkColPtr->objRefCount++;
+ }
+ return (XColor *) tkColPtr;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_GetColor --
+ *
+ * Given a string name for a color, map the name to a corresponding
+ * XColor structure.
+ *
+ * Results:
+ * The return value is a pointer to an XColor structure that indicates
+ * the red, blue, and green intensities for the color given by "name",
+ * and also specifies a pixel value to use to draw in that color. If an
+ * error occurs, NULL is returned and an error message will be left in
+ * the interp's result.
+ *
+ * Side effects:
+ * The color is added to an internal database with a reference count. For
+ * each call to this function, there should eventually be a call to
+ * Tk_FreeColor so that the database is cleaned up when colors aren't in
+ * use anymore.
+ *
+ *----------------------------------------------------------------------
+ */
+
+XColor *
+Tk_GetColor(
+ Tcl_Interp *interp, /* Place to leave error message if color can't
+ * be found. */
+ Tk_Window tkwin, /* Window in which color will be used. */
+ Tk_Uid name) /* Name of color to be allocated (in form
+ * suitable for passing to XParseColor). */
+{
+ Tcl_HashEntry *nameHashPtr;
+ int isNew;
+ TkColor *tkColPtr;
+ TkColor *existingColPtr;
+ TkDisplay *dispPtr = ((TkWindow *) tkwin)->dispPtr;
+
+ if (!dispPtr->colorInit) {
+ ColorInit(dispPtr);
+ }
+
+ /*
+ * First, check to see if there's already a mapping for this color name.
+ */
+
+ nameHashPtr = Tcl_CreateHashEntry(&dispPtr->colorNameTable, name, &isNew);
+ if (!isNew) {
+ existingColPtr = Tcl_GetHashValue(nameHashPtr);
+ for (tkColPtr = existingColPtr; tkColPtr != NULL;
+ tkColPtr = tkColPtr->nextPtr) {
+ if ((tkColPtr->screen == Tk_Screen(tkwin))
+ && (Tk_Colormap(tkwin) == tkColPtr->colormap)) {
+ tkColPtr->resourceRefCount++;
+ return &tkColPtr->color;
+ }
+ }
+ } else {
+ existingColPtr = NULL;
+ }
+
+ /*
+ * The name isn't currently known. Map from the name to a pixel value.
+ */
+
+ tkColPtr = TkpGetColor(tkwin, name);
+ if (tkColPtr == NULL) {
+ if (interp != NULL) {
+ if (*name == '#') {
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "invalid color name \"%s\"", name));
+ Tcl_SetErrorCode(interp, "TK", "VALUE", "COLOR", NULL);
+ } else {
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "unknown color name \"%s\"", name));
+ Tcl_SetErrorCode(interp, "TK", "LOOKUP", "COLOR", name, NULL);
+ }
+ }
+ if (isNew) {
+ Tcl_DeleteHashEntry(nameHashPtr);
+ }
+ return NULL;
+ }
+
+ /*
+ * Now create a new TkColor structure and add it to colorNameTable (in
+ * TkDisplay).
+ */
+
+ tkColPtr->magic = COLOR_MAGIC;
+ tkColPtr->gc = None;
+ tkColPtr->screen = Tk_Screen(tkwin);
+ tkColPtr->colormap = Tk_Colormap(tkwin);
+ tkColPtr->visual = Tk_Visual(tkwin);
+ tkColPtr->resourceRefCount = 1;
+ tkColPtr->objRefCount = 0;
+ tkColPtr->type = TK_COLOR_BY_NAME;
+ tkColPtr->hashPtr = nameHashPtr;
+ tkColPtr->nextPtr = existingColPtr;
+ Tcl_SetHashValue(nameHashPtr, tkColPtr);
+
+ return &tkColPtr->color;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_GetColorByValue --
+ *
+ * Given a desired set of red-green-blue intensities for a color, locate
+ * a pixel value to use to draw that color in a given window.
+ *
+ * Results:
+ * The return value is a pointer to an XColor structure that indicates
+ * the closest red, blue, and green intensities available to those
+ * specified in colorPtr, and also specifies a pixel value to use to draw
+ * in that color.
+ *
+ * Side effects:
+ * The color is added to an internal database with a reference count. For
+ * each call to this function, there should eventually be a call to
+ * Tk_FreeColor, so that the database is cleaned up when colors aren't in
+ * use anymore.
+ *
+ *----------------------------------------------------------------------
+ */
+
+XColor *
+Tk_GetColorByValue(
+ Tk_Window tkwin, /* Window where color will be used. */
+ XColor *colorPtr) /* Red, green, and blue fields indicate
+ * desired color. */
+{
+ ValueKey valueKey;
+ Tcl_HashEntry *valueHashPtr;
+ int isNew;
+ TkColor *tkColPtr;
+ Display *display = Tk_Display(tkwin);
+ TkDisplay *dispPtr = TkGetDisplay(display);
+
+ if (!dispPtr->colorInit) {
+ ColorInit(dispPtr);
+ }
+
+ /*
+ * First, check to see if there's already a mapping for this color name.
+ * Must clear the structure first; it's not tightly packed on 64-bit
+ * systems. [Bug 2911570]
+ */
+
+ memset(&valueKey, 0, sizeof(ValueKey));
+ valueKey.red = colorPtr->red;
+ valueKey.green = colorPtr->green;
+ valueKey.blue = colorPtr->blue;
+ valueKey.colormap = Tk_Colormap(tkwin);
+ valueKey.display = display;
+ valueHashPtr = Tcl_CreateHashEntry(&dispPtr->colorValueTable,
+ (char *) &valueKey, &isNew);
+ if (!isNew) {
+ tkColPtr = Tcl_GetHashValue(valueHashPtr);
+ tkColPtr->resourceRefCount++;
+ return &tkColPtr->color;
+ }
+
+ /*
+ * The name isn't currently known. Find a pixel value for this color and
+ * add a new structure to colorValueTable (in TkDisplay).
+ */
+
+ tkColPtr = TkpGetColorByValue(tkwin, colorPtr);
+ tkColPtr->magic = COLOR_MAGIC;
+ tkColPtr->gc = None;
+ tkColPtr->screen = Tk_Screen(tkwin);
+ tkColPtr->colormap = valueKey.colormap;
+ tkColPtr->visual = Tk_Visual(tkwin);
+ tkColPtr->resourceRefCount = 1;
+ tkColPtr->objRefCount = 0;
+ tkColPtr->type = TK_COLOR_BY_VALUE;
+ tkColPtr->hashPtr = valueHashPtr;
+ tkColPtr->nextPtr = NULL;
+ Tcl_SetHashValue(valueHashPtr, tkColPtr);
+ return &tkColPtr->color;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * Tk_NameOfColor --
+ *
+ * Given a color, return a textual string identifying the color.
+ *
+ * Results:
+ * If colorPtr was created by Tk_GetColor, then the return value is the
+ * "string" that was used to create it. Otherwise the return value is a
+ * string that could have been passed to Tk_GetColor to allocate that
+ * color. The storage for the returned string is only guaranteed to
+ * persist up until the next call to this function.
+ *
+ * Side effects:
+ * None.
+ *
+ *--------------------------------------------------------------
+ */
+
+const char *
+Tk_NameOfColor(
+ XColor *colorPtr) /* Color whose name is desired. */
+{
+ register TkColor *tkColPtr = (TkColor *) colorPtr;
+
+ if (tkColPtr->magic==COLOR_MAGIC && tkColPtr->type==TK_COLOR_BY_NAME) {
+ return tkColPtr->hashPtr->key.string;
+ } else {
+ ThreadSpecificData *tsdPtr =
+ Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
+
+ sprintf(tsdPtr->rgbString, "#%04x%04x%04x", colorPtr->red,
+ colorPtr->green, colorPtr->blue);
+
+ /*
+ * If the string has the form #RSRSTUTUVWVW (where equal letters
+ * denote equal hexdigits) then this is equivalent to #RSTUVW. Then
+ * output the shorter form.
+ */
+
+ if ((tsdPtr->rgbString[1] == tsdPtr->rgbString[3])
+ && (tsdPtr->rgbString[2] == tsdPtr->rgbString[4])
+ && (tsdPtr->rgbString[5] == tsdPtr->rgbString[7])
+ && (tsdPtr->rgbString[6] == tsdPtr->rgbString[8])
+ && (tsdPtr->rgbString[9] == tsdPtr->rgbString[11])
+ && (tsdPtr->rgbString[10] == tsdPtr->rgbString[12])) {
+ tsdPtr->rgbString[3] = tsdPtr->rgbString[5];
+ tsdPtr->rgbString[4] = tsdPtr->rgbString[6];
+ tsdPtr->rgbString[5] = tsdPtr->rgbString[9];
+ tsdPtr->rgbString[6] = tsdPtr->rgbString[10];
+ tsdPtr->rgbString[7] = '\0';
+ }
+ return tsdPtr->rgbString;
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_GCForColor --
+ *
+ * Given a color allocated from this module, this function returns a GC
+ * that can be used for simple drawing with that color.
+ *
+ * Results:
+ * The return value is a GC with color set as its foreground color and
+ * all other fields defaulted. This GC is only valid as long as the color
+ * exists; it is freed automatically when the last reference to the color
+ * is freed.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+GC
+Tk_GCForColor(
+ XColor *colorPtr, /* Color for which a GC is desired. Must have
+ * been allocated by Tk_GetColor. */
+ Drawable drawable) /* Drawable in which the color will be used
+ * (must have same screen and depth as the one
+ * for which the color was allocated). */
+{
+ TkColor *tkColPtr = (TkColor *) colorPtr;
+ XGCValues gcValues;
+
+ /*
+ * Do a quick sanity check to make sure this color was really allocated by
+ * Tk_GetColor.
+ */
+
+ if (tkColPtr->magic != COLOR_MAGIC) {
+ Tcl_Panic("Tk_GCForColor called with bogus color");
+ }
+
+ if (tkColPtr->gc == None) {
+ gcValues.foreground = tkColPtr->color.pixel;
+ tkColPtr->gc = XCreateGC(DisplayOfScreen(tkColPtr->screen), drawable,
+ GCForeground, &gcValues);
+ }
+ return tkColPtr->gc;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_FreeColor --
+ *
+ * This function is called to release a color allocated by Tk_GetColor.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The reference count associated with colorPtr is deleted, and the color
+ * is released to X if there are no remaining uses for it.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tk_FreeColor(
+ XColor *colorPtr) /* Color to be released. Must have been
+ * allocated by Tk_GetColor or
+ * Tk_GetColorByValue. */
+{
+ TkColor *tkColPtr = (TkColor *) colorPtr;
+ Screen *screen = tkColPtr->screen;
+ TkColor *prevPtr;
+
+ /*
+ * Do a quick sanity check to make sure this color was really allocated by
+ * Tk_GetColor.
+ */
+
+ if (tkColPtr->magic != COLOR_MAGIC) {
+ Tcl_Panic("Tk_FreeColor called with bogus color");
+ }
+
+ tkColPtr->resourceRefCount--;
+ if (tkColPtr->resourceRefCount > 0) {
+ return;
+ }
+
+ /*
+ * This color is no longer being actively used, so free the color
+ * resources associated with it and remove it from the hash table. No
+ * longer any objects referencing it.
+ */
+
+ if (tkColPtr->gc != None) {
+ XFreeGC(DisplayOfScreen(screen), tkColPtr->gc);
+ tkColPtr->gc = None;
+ }
+ TkpFreeColor(tkColPtr);
+
+ prevPtr = Tcl_GetHashValue(tkColPtr->hashPtr);
+ if (prevPtr == tkColPtr) {
+ if (tkColPtr->nextPtr == NULL) {
+ Tcl_DeleteHashEntry(tkColPtr->hashPtr);
+ } else {
+ Tcl_SetHashValue(tkColPtr->hashPtr, tkColPtr->nextPtr);
+ }
+ } else {
+ while (prevPtr->nextPtr != tkColPtr) {
+ prevPtr = prevPtr->nextPtr;
+ }
+ prevPtr->nextPtr = tkColPtr->nextPtr;
+ }
+
+ /*
+ * Free the TkColor structure if there are no objects referencing it.
+ * However, if there are objects referencing it then keep the structure
+ * around; it will get freed when the last reference is cleared
+ */
+
+ if (tkColPtr->objRefCount == 0) {
+ ckfree(tkColPtr);
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_FreeColorFromObj --
+ *
+ * This function is called to release a color allocated by
+ * Tk_AllocColorFromObj. It does not throw away the Tcl_Obj *; it only
+ * gets rid of the hash table entry for this color and clears the cached
+ * value that is normally stored in the object.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The reference count associated with the color represented by objPtr is
+ * decremented, and the color is released to X if there are no remaining
+ * uses for it.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tk_FreeColorFromObj(
+ Tk_Window tkwin, /* The window this color lives in. Needed for
+ * the screen and colormap values. */
+ Tcl_Obj *objPtr) /* The Tcl_Obj * to be freed. */
+{
+ Tk_FreeColor(Tk_GetColorFromObj(tkwin, objPtr));
+ FreeColorObj(objPtr);
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * FreeColorObjProc, FreeColorObj --
+ *
+ * This proc is called to release an object reference to a color. Called
+ * when the object's internal rep is released or when the cached tkColPtr
+ * needs to be changed.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The object reference count is decremented. When both it and the hash
+ * ref count go to zero, the color's resources are released.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+static void
+FreeColorObjProc(
+ Tcl_Obj *objPtr) /* The object we are releasing. */
+{
+ FreeColorObj(objPtr);
+ objPtr->typePtr = NULL;
+}
+
+static void
+FreeColorObj(
+ Tcl_Obj *objPtr) /* The object we are releasing. */
+{
+ TkColor *tkColPtr = objPtr->internalRep.twoPtrValue.ptr1;
+
+ if (tkColPtr != NULL) {
+ tkColPtr->objRefCount--;
+ if ((tkColPtr->objRefCount == 0)
+ && (tkColPtr->resourceRefCount == 0)) {
+ ckfree(tkColPtr);
+ }
+ objPtr->internalRep.twoPtrValue.ptr1 = NULL;
+ }
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * DupColorObjProc --
+ *
+ * When a cached color object is duplicated, this is called to update the
+ * internal reps.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The color's objRefCount is incremented and the internal rep of the
+ * copy is set to point to it.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+static void
+DupColorObjProc(
+ Tcl_Obj *srcObjPtr, /* The object we are copying from. */
+ Tcl_Obj *dupObjPtr) /* The object we are copying to. */
+{
+ TkColor *tkColPtr = srcObjPtr->internalRep.twoPtrValue.ptr1;
+
+ dupObjPtr->typePtr = srcObjPtr->typePtr;
+ dupObjPtr->internalRep.twoPtrValue.ptr1 = tkColPtr;
+
+ if (tkColPtr != NULL) {
+ tkColPtr->objRefCount++;
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_GetColorFromObj --
+ *
+ * Returns the color referred to by a Tcl object. The color must already
+ * have been allocated via a call to Tk_AllocColorFromObj or Tk_GetColor.
+ *
+ * Results:
+ * Returns the XColor * that matches the tkwin and the string rep of
+ * objPtr.
+ *
+ * Side effects:
+ * If the object is not already a color, the conversion will free any old
+ * internal representation.
+ *
+ *----------------------------------------------------------------------
+ */
+
+XColor *
+Tk_GetColorFromObj(
+ Tk_Window tkwin, /* The window in which the color will be
+ * used. */
+ Tcl_Obj *objPtr) /* String value contains the name of the
+ * desired color. */
+{
+ TkColor *tkColPtr;
+ Tcl_HashEntry *hashPtr;
+ TkDisplay *dispPtr = ((TkWindow *) tkwin)->dispPtr;
+
+ if (objPtr->typePtr != &tkColorObjType) {
+ InitColorObj(objPtr);
+ }
+
+ /*
+ * First check to see if the internal representation of the object is
+ * defined and is a color that is valid for the current screen and color
+ * map. If it is, we are done.
+ */
+
+ tkColPtr = objPtr->internalRep.twoPtrValue.ptr1;
+ if ((tkColPtr != NULL)
+ && (tkColPtr->resourceRefCount > 0)
+ && (Tk_Screen(tkwin) == tkColPtr->screen)
+ && (Tk_Colormap(tkwin) == tkColPtr->colormap)) {
+ /*
+ * The object already points to the right TkColor structure. Just
+ * return it.
+ */
+
+ return (XColor *) tkColPtr;
+ }
+
+ /*
+ * If we reach this point, it means that the TkColor structure that we
+ * have cached in the internal representation is not valid for the current
+ * screen and colormap. But there is a list of other TkColor structures
+ * attached to the TkDisplay. Walk this list looking for the right TkColor
+ * structure.
+ */
+
+ hashPtr = Tcl_FindHashEntry(&dispPtr->colorNameTable,
+ Tcl_GetString(objPtr));
+ if (hashPtr == NULL) {
+ goto error;
+ }
+ for (tkColPtr = Tcl_GetHashValue(hashPtr);
+ (tkColPtr != NULL); tkColPtr = tkColPtr->nextPtr) {
+ if ((Tk_Screen(tkwin) == tkColPtr->screen)
+ && (Tk_Colormap(tkwin) == tkColPtr->colormap)) {
+ FreeColorObj(objPtr);
+ objPtr->internalRep.twoPtrValue.ptr1 = tkColPtr;
+ tkColPtr->objRefCount++;
+ return (XColor *) tkColPtr;
+ }
+ }
+
+ error:
+ Tcl_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 function to change an objPtr to a color type.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The old internal rep of the object is freed. The object's type is set
+ * to color with a NULL TkColor pointer (the pointer will be set later by
+ * either Tk_AllocColorFromObj or Tk_GetColorFromObj).
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+InitColorObj(
+ Tcl_Obj *objPtr) /* The object to convert. */
+{
+ const Tcl_ObjType *typePtr;
+
+ /*
+ * Free the old internalRep before setting the new one.
+ */
+
+ Tcl_GetString(objPtr);
+ typePtr = objPtr->typePtr;
+ if ((typePtr != NULL) && (typePtr->freeIntRepProc != NULL)) {
+ typePtr->freeIntRepProc(objPtr);
+ }
+ objPtr->typePtr = &tkColorObjType;
+ objPtr->internalRep.twoPtrValue.ptr1 = NULL;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ColorInit --
+ *
+ * Initialize the structure used for color management.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Read the code.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+ColorInit(
+ 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 function 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(
+ Tk_Window tkwin, /* The window in which the color will be used
+ * (not currently used). */
+ const char *name) /* Name of the desired color. */
+{
+ Tcl_HashEntry *hashPtr;
+ Tcl_Obj *resultPtr;
+ TkDisplay *dispPtr = ((TkWindow *) tkwin)->dispPtr;
+
+ resultPtr = Tcl_NewObj();
+ hashPtr = Tcl_FindHashEntry(&dispPtr->colorNameTable, name);
+ if (hashPtr != NULL) {
+ TkColor *tkColPtr = Tcl_GetHashValue(hashPtr);
+
+ if (tkColPtr == NULL) {
+ Tcl_Panic("TkDebugColor found empty hash table entry");
+ }
+ for ( ; (tkColPtr != NULL); tkColPtr = tkColPtr->nextPtr) {
+ Tcl_Obj *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;
+}
+
+#ifndef _WIN32
+
+/* This function is not necessary for Win32,
+ * since XParseColor already does the right thing */
+
+#undef XParseColor
+
+const char *const tkWebColors[20] = {
+ /* 'a' */ "qua\0#0000ffffffff",
+ /* 'b' */ NULL,
+ /* 'c' */ "rimson\0#dcdc14143c3c",
+ /* 'd' */ NULL,
+ /* 'e' */ NULL,
+ /* 'f' */ "uchsia\0#ffff0000ffff",
+ /* 'g' */ "reen\0#000080800000",
+ /* 'h' */ NULL,
+ /* 'i' */ "ndigo\0#4b4b00008282",
+ /* 'j' */ NULL,
+ /* 'k' */ NULL,
+ /* 'l' */ "ime\0#0000ffff0000",
+ /* 'm' */ "aroon\0#808000000000",
+ /* 'n' */ NULL,
+ /* 'o' */ "live\0#808080800000",
+ /* 'p' */ "urple\0#808000008080",
+ /* 'q' */ NULL,
+ /* 'r' */ NULL,
+ /* 's' */ "ilver\0#c0c0c0c0c0c0",
+ /* 't' */ "eal\0#000080808080"
+};
+
+Status
+TkParseColor(
+ Display *display, /* The display */
+ Colormap map, /* Color map */
+ const char *name, /* String to be parsed */
+ XColor *color)
+{
+ char buf[14];
+ if (*name == '#') {
+ buf[0] = '#'; buf[13] = '\0';
+ if (!*(++name) || !*(++name) || !*(++name)) {
+ /* Not at least 3 hex digits, so invalid */
+ return 0;
+ } else if (!*(++name)) {
+ /* Exactly 3 hex digits */
+ buf[9] = buf[10] = buf[11] = buf[12] = *(--name);
+ buf[5] = buf[6] = buf[7] = buf[8] = *(--name);
+ buf[1] = buf[2] = buf[3] = buf[4] = *(--name);
+ name = buf;
+ } else if (!*(++name) || !*(++name)) {
+ /* Not at least 6 hex digits, so invalid */
+ return 0;
+ } else if (!*(++name)) {
+ /* Exactly 6 hex digits */
+ buf[10] = buf[12] = *(--name);
+ buf[9] = buf[11] = *(--name);
+ buf[6] = buf[8] = *(--name);
+ buf[5] = buf[7] = *(--name);
+ buf[2] = buf[4] = *(--name);
+ buf[1] = buf[3] = *(--name);
+ name = buf;
+ } else if (!*(++name) || !*(++name)) {
+ /* Not at least 9 hex digits, so invalid */
+ return 0;
+ } else if (!*(++name)) {
+ /* Exactly 9 hex digits */
+ buf[11] = *(--name);
+ buf[10] = *(--name);
+ buf[9] = buf[12] = *(--name);
+ buf[7] = *(--name);
+ buf[6] = *(--name);
+ buf[5] = buf[8] = *(--name);
+ buf[3] = *(--name);
+ buf[2] = *(--name);
+ buf[1] = buf[4] = *(--name);
+ name = buf;
+ } else if (!*(++name) || !*(++name) || *(++name)) {
+ /* Not exactly 12 hex digits, so invalid */
+ return 0;
+ } else {
+ name -= 13;
+ }
+ goto done;
+ } else if (((*name - 'A') & 0xdf) < sizeof(tkWebColors)/sizeof(tkWebColors[0])) {
+ if (!((name[0] - 'G') & 0xdf) && !((name[1] - 'R') & 0xdf)
+ && !((name[2] - 'A') & 0xdb) && !((name[3] - 'Y') & 0xdf)
+ && !name[4]) {
+ name = "#808080808080";
+ goto done;
+ } else {
+ const char *p = tkWebColors[((*name - 'A') & 0x1f)];
+ if (p) {
+ const char *q = name;
+ while (!((*p - *(++q)) & 0xdf)) {
+ if (!*p++) {
+ name = p;
+ goto done;
+ }
+ }
+ }
+ }
+ }
+ if (strlen(name) > 99) {
+ return 0;
+ }
+done:
+ return XParseColor(display, map, name, color);
+}
+#endif /* _WIN32 */
+/*
+ * Local Variables:
+ * mode: c
+ * c-basic-offset: 4
+ * fill-column: 78
+ * End:
+ */
diff --git a/tk8.6/generic/tkColor.h b/tk8.6/generic/tkColor.h
new file mode 100644
index 0000000..05ef295
--- /dev/null
+++ b/tk8.6/generic/tkColor.h
@@ -0,0 +1,75 @@
+/*
+ * tkColor.h --
+ *
+ * Declarations of data types and functions used by the Tk color module.
+ *
+ * Copyright (c) 1996-1997 by Sun Microsystems, Inc.
+ *
+ * See the file "license.terms" for information on usage and redistribution of
+ * this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ */
+
+#ifndef _TKCOLOR
+#define _TKCOLOR
+
+#include "tkInt.h"
+
+/*
+ * One of the following data structures is used to keep track of each color
+ * that is being used by the application; typically there is a colormap entry
+ * allocated for each of these colors.
+ */
+
+#define TK_COLOR_BY_NAME 1
+#define TK_COLOR_BY_VALUE 2
+
+#define COLOR_MAGIC ((unsigned int) 0x46140277)
+
+typedef struct TkColor {
+ XColor color; /* Information about this color. */
+ unsigned int magic; /* Used for quick integrity check on this
+ * structure. Must always have the value
+ * COLOR_MAGIC. */
+ GC gc; /* Simple gc with this color as foreground
+ * color and all other fields defaulted. May
+ * be None. */
+ Screen *screen; /* Screen where this color is valid. Used to
+ * delete it, and to find its display. */
+ Colormap colormap; /* Colormap from which this entry was
+ * allocated. */
+ Visual *visual; /* Visual associated with colormap. */
+ int resourceRefCount; /* Number of active uses of this color (each
+ * active use corresponds to a call to
+ * Tk_AllocColorFromObj or Tk_GetColor). If
+ * this count is 0, then this TkColor
+ * structure is no longer valid and it isn't
+ * present in a hash table: it is being kept
+ * around only because there are objects
+ * referring to it. The structure is freed
+ * when resourceRefCount and objRefCount are
+ * both 0. */
+ int objRefCount; /* The number of Tcl objects that reference
+ * this structure. */
+ int type; /* TK_COLOR_BY_NAME or TK_COLOR_BY_VALUE. */
+ Tcl_HashEntry *hashPtr; /* Pointer to hash table entry for this
+ * structure. (for use in deleting entry). */
+ struct TkColor *nextPtr; /* Points to the next TkColor structure with
+ * the same color name. Colors with the same
+ * name but different screens or colormaps are
+ * chained together off a single entry in
+ * nameTable. For colors in valueTable (those
+ * allocated by Tk_GetColorByValue) this field
+ * is always NULL. */
+} TkColor;
+
+/*
+ * Common APIs exported from all platform-specific implementations.
+ */
+
+#ifndef TkpFreeColor
+MODULE_SCOPE void TkpFreeColor(TkColor *tkColPtr);
+#endif
+MODULE_SCOPE TkColor * TkpGetColor(Tk_Window tkwin, Tk_Uid name);
+MODULE_SCOPE TkColor * TkpGetColorByValue(Tk_Window tkwin, XColor *colorPtr);
+
+#endif /* _TKCOLOR */
diff --git a/tk8.6/generic/tkConfig.c b/tk8.6/generic/tkConfig.c
new file mode 100644
index 0000000..9c159e6
--- /dev/null
+++ b/tk8.6/generic/tkConfig.c
@@ -0,0 +1,2117 @@
+/*
+ * tkConfig.c --
+ *
+ * This file contains functions that manage configuration options for
+ * widgets and other things.
+ *
+ * Copyright (c) 1997-1998 Sun Microsystems, Inc.
+ *
+ * See the file "license.terms" for information on usage and redistribution of
+ * this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ */
+
+/*
+ * Temporary flag for working on new config package.
+ */
+
+#if 0
+
+/*
+ * used only for removing the old config code
+ */
+
+#define __NO_OLD_CONFIG
+#endif
+
+#include "tkInt.h"
+#include "tkFont.h"
+
+/*
+ * The following definition keeps track of all of
+ * the option tables that have been created for a thread.
+ */
+
+typedef struct ThreadSpecificData {
+ int initialized; /* 0 means table below needs initializing. */
+ Tcl_HashTable hashTable;
+} ThreadSpecificData;
+static Tcl_ThreadDataKey dataKey;
+
+
+/*
+ * 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. */
+ const struct Tk_ObjCustomOption *custom;
+ /* For TK_OPTION_CUSTOM. */
+ } extra;
+ int flags; /* Miscellaneous flag values; see below for
+ * definitions. */
+} Option;
+
+/*
+ * Flag bits defined for Option structures:
+ *
+ * OPTION_NEEDS_FREEING - 1 means that FreeResources must be invoked to
+ * free resources associated with the option when
+ * it is no longer needed.
+ */
+
+#define OPTION_NEEDS_FREEING 1
+
+/*
+ * One of the following exists for each Tk_OptionSpec array that has been
+ * passed to Tk_CreateOptionTable.
+ */
+
+typedef struct OptionTable {
+ int refCount; /* Counts the number of uses of this table
+ * (the number of times Tk_CreateOptionTable
+ * has returned it). This can be greater than
+ * 1 if it is shared along several option
+ * table chains, or if the same table is used
+ * for multiple purposes. */
+ Tcl_HashEntry *hashEntryPtr;/* Hash table entry that refers to this table;
+ * used to delete the entry. */
+ struct OptionTable *nextPtr;/* If templatePtr was part of a chain of
+ * templates, this points to the table
+ * corresponding to the next template in the
+ * chain. */
+ int numOptions; /* The number of items in the options array
+ * below. */
+ Option options[1]; /* Information about the individual options in
+ * the table. This must be the last field in
+ * the structure: the actual size of the array
+ * will be numOptions, not 1. */
+} OptionTable;
+
+/*
+ * Forward declarations for functions defined later in this file:
+ */
+
+static int DoObjConfig(Tcl_Interp *interp, char *recordPtr,
+ Option *optionPtr, Tcl_Obj *valuePtr,
+ Tk_Window tkwin, Tk_SavedOption *savePtr);
+static void FreeResources(Option *optionPtr, Tcl_Obj *objPtr,
+ char *internalPtr, Tk_Window tkwin);
+static Tcl_Obj * GetConfigList(char *recordPtr,
+ Option *optionPtr, Tk_Window tkwin);
+static Tcl_Obj * GetObjectForOption(char *recordPtr,
+ Option *optionPtr, Tk_Window tkwin);
+static Option * GetOption(const char *name, OptionTable *tablePtr);
+static Option * GetOptionFromObj(Tcl_Interp *interp,
+ Tcl_Obj *objPtr, OptionTable *tablePtr);
+static int ObjectIsEmpty(Tcl_Obj *objPtr);
+static void FreeOptionInternalRep(Tcl_Obj *objPtr);
+static void DupOptionInternalRep(Tcl_Obj *, Tcl_Obj *);
+
+/*
+ * 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.
+ */
+
+static const Tcl_ObjType optionObjType = {
+ "option", /* name */
+ FreeOptionInternalRep, /* freeIntRepProc */
+ DupOptionInternalRep, /* dupIntRepProc */
+ NULL, /* updateStringProc */
+ NULL /* setFromAnyProc */
+};
+
+/*
+ *--------------------------------------------------------------
+ *
+ * Tk_CreateOptionTable --
+ *
+ * Given a template for configuration options, this function creates a
+ * table that may be used to look up options efficiently.
+ *
+ * Results:
+ * Returns a token to a structure that can be passed to functions such as
+ * Tk_InitOptions, Tk_SetOptions, and Tk_FreeConfigOptions.
+ *
+ * Side effects:
+ * Storage is allocated.
+ *
+ *--------------------------------------------------------------
+ */
+
+Tk_OptionTable
+Tk_CreateOptionTable(
+ Tcl_Interp *interp, /* Interpreter associated with the application
+ * in which this table will be used. */
+ const Tk_OptionSpec *templatePtr)
+ /* Static information about the configuration
+ * options. */
+{
+ Tcl_HashEntry *hashEntryPtr;
+ int newEntry;
+ OptionTable *tablePtr;
+ const Tk_OptionSpec *specPtr, *specPtr2;
+ Option *optionPtr;
+ int numOptions, i;
+ ThreadSpecificData *tsdPtr =
+ Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
+
+ /*
+ * We use an TSD in the thread to keep a hash table of
+ * all the option tables we've created for this application. This is
+ * used for allowing us to share the tables (e.g. in several chains).
+ * The code below finds the hash table or creates a new one if it
+ * doesn't already exist.
+ */
+
+ if (!tsdPtr->initialized) {
+ Tcl_InitHashTable(&tsdPtr->hashTable, TCL_ONE_WORD_KEYS);
+ tsdPtr->initialized = 1;
+ }
+
+ /*
+ * See if a table has already been created for this template. If so, just
+ * reuse the existing table.
+ */
+
+ hashEntryPtr = Tcl_CreateHashEntry(&tsdPtr->hashTable, (char *) templatePtr,
+ &newEntry);
+ if (!newEntry) {
+ tablePtr = 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 = ckalloc(sizeof(OptionTable) + (numOptions * 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) {
+ Tcl_Panic("Tk_CreateOptionTable couldn't find synonym");
+ }
+ if (strcmp(specPtr2->optionName,
+ (char *) specPtr->clientData) == 0) {
+ optionPtr->extra.synonymPtr = tablePtr->options + i;
+ break;
+ }
+ }
+ } else {
+ if (specPtr->dbName != NULL) {
+ optionPtr->dbNameUID = Tk_GetUid(specPtr->dbName);
+ }
+ if (specPtr->dbClass != NULL) {
+ optionPtr->dbClassUID = Tk_GetUid(specPtr->dbClass);
+ }
+ if (specPtr->defValue != NULL) {
+ optionPtr->defaultPtr = Tcl_NewStringObj(specPtr->defValue,-1);
+ Tcl_IncrRefCount(optionPtr->defaultPtr);
+ }
+ if (((specPtr->type == TK_OPTION_COLOR)
+ || (specPtr->type == TK_OPTION_BORDER))
+ && (specPtr->clientData != NULL)) {
+ optionPtr->extra.monoColorPtr =
+ Tcl_NewStringObj(specPtr->clientData, -1);
+ Tcl_IncrRefCount(optionPtr->extra.monoColorPtr);
+ }
+
+ if (specPtr->type == TK_OPTION_CUSTOM) {
+ /*
+ * Get the custom parsing, etc., functions.
+ */
+
+ optionPtr->extra.custom = specPtr->clientData;
+ }
+ }
+ if (((specPtr->type == TK_OPTION_STRING)
+ && (specPtr->internalOffset >= 0))
+ || (specPtr->type == TK_OPTION_COLOR)
+ || (specPtr->type == TK_OPTION_FONT)
+ || (specPtr->type == TK_OPTION_BITMAP)
+ || (specPtr->type == TK_OPTION_BORDER)
+ || (specPtr->type == TK_OPTION_CURSOR)
+ || (specPtr->type == TK_OPTION_CUSTOM)) {
+ optionPtr->flags |= OPTION_NEEDS_FREEING;
+ }
+ }
+ tablePtr->hashEntryPtr = hashEntryPtr;
+ Tcl_SetHashValue(hashEntryPtr, tablePtr);
+
+ /*
+ * Finally, check to see if this template chains to another template with
+ * additional options. If so, call ourselves recursively to create the
+ * next table(s).
+ */
+
+ if (specPtr->clientData != NULL) {
+ tablePtr->nextPtr = (OptionTable *)
+ Tk_CreateOptionTable(interp, 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(
+ 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, 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(tablePtr);
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * Tk_InitOptions --
+ *
+ * This function 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 function completed successfully, and
+ * TCL_ERROR if one of the initial values was bogus. If an error occurs
+ * and interp isn't NULL, then an error message will be left in its
+ * result.
+ *
+ * Side effects:
+ * Fields of recordPtr are filled in with initial values.
+ *
+ *--------------------------------------------------------------
+ */
+
+int
+Tk_InitOptions(
+ Tcl_Interp *interp, /* Interpreter for error reporting. NULL means
+ * don't leave an error message. */
+ char *recordPtr, /* Pointer to the record to configure. Note:
+ * the caller should have properly initialized
+ * the record with NULL pointers for each
+ * option value. */
+ Tk_OptionTable optionTable, /* The token which matches the config specs
+ * for the widget in question. */
+ Tk_Window tkwin) /* Certain options types (such as
+ * TK_OPTION_COLOR) need fields out of the
+ * window they are used in to be able to
+ * calculate their values. Not needed unless
+ * one of these options is in the configSpecs
+ * record. */
+{
+ OptionTable *tablePtr = (OptionTable *) optionTable;
+ Option *optionPtr;
+ int count;
+ Tk_Uid value;
+ Tcl_Obj *valuePtr;
+ enum {
+ OPTION_DATABASE, SYSTEM_DEFAULT, TABLE_DEFAULT
+ } source;
+
+ /*
+ * If this table chains to other tables, handle their initialization
+ * first. That way, if both tables refer to the same field of the record,
+ * the value in the first table will win.
+ */
+
+ if (tablePtr->nextPtr != NULL) {
+ if (Tk_InitOptions(interp, recordPtr,
+ (Tk_OptionTable) tablePtr->nextPtr, tkwin) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ }
+
+ /*
+ * Iterate over all of the options in the table, initializing each in
+ * turn.
+ */
+
+ for (optionPtr = tablePtr->options, count = tablePtr->numOptions;
+ count > 0; optionPtr++, count--) {
+ /*
+ * If we specify TK_OPTION_DONT_SET_DEFAULT, then the user has
+ * processed and set a default for this already.
+ */
+
+ if ((optionPtr->specPtr->type == TK_OPTION_SYNONYM) ||
+ (optionPtr->specPtr->flags & TK_OPTION_DONT_SET_DEFAULT)) {
+ continue;
+ }
+ source = TABLE_DEFAULT;
+
+ /*
+ * We look in three places for the initial value, using the first
+ * non-NULL value that we find. First, check the option database.
+ */
+
+ valuePtr = NULL;
+ if (optionPtr->dbNameUID != NULL) {
+ value = Tk_GetOption(tkwin, optionPtr->dbNameUID,
+ optionPtr->dbClassUID);
+ if (value != NULL) {
+ valuePtr = Tcl_NewStringObj(value, -1);
+ source = OPTION_DATABASE;
+ }
+ }
+
+ /*
+ * Second, check for a system-specific default value.
+ */
+
+ if ((valuePtr == NULL)
+ && (optionPtr->dbNameUID != NULL)) {
+ valuePtr = TkpGetSystemDefault(tkwin, optionPtr->dbNameUID,
+ optionPtr->dbClassUID);
+ if (valuePtr != NULL) {
+ source = SYSTEM_DEFAULT;
+ }
+ }
+
+ /*
+ * Third and last, use the default value supplied by the option table.
+ * In the case of color objects, we pick one of two values depending
+ * on whether the screen is mono or color.
+ */
+
+ if (valuePtr == NULL) {
+ if ((tkwin != NULL)
+ && ((optionPtr->specPtr->type == TK_OPTION_COLOR)
+ || (optionPtr->specPtr->type == TK_OPTION_BORDER))
+ && (Tk_Depth(tkwin) <= 1)
+ && (optionPtr->extra.monoColorPtr != NULL)) {
+ valuePtr = optionPtr->extra.monoColorPtr;
+ } else {
+ valuePtr = optionPtr->defaultPtr;
+ }
+ }
+
+ if (valuePtr == NULL) {
+ continue;
+ }
+
+ /*
+ * Bump the reference count on valuePtr, so that it is strongly
+ * referenced here, and will be properly free'd when finished,
+ * regardless of what DoObjConfig does.
+ */
+
+ Tcl_IncrRefCount(valuePtr);
+
+ if (DoObjConfig(interp, recordPtr, optionPtr, valuePtr, tkwin,
+ NULL) != TCL_OK) {
+ if (interp != NULL) {
+ char msg[200];
+
+ switch (source) {
+ case OPTION_DATABASE:
+ sprintf(msg, "\n (database entry for \"%.50s\")",
+ optionPtr->specPtr->optionName);
+ break;
+ case SYSTEM_DEFAULT:
+ sprintf(msg, "\n (system default for \"%.50s\")",
+ optionPtr->specPtr->optionName);
+ break;
+ case TABLE_DEFAULT:
+ sprintf(msg, "\n (default value for \"%.50s\")",
+ optionPtr->specPtr->optionName);
+ }
+ if (tkwin != NULL) {
+ sprintf(msg + strlen(msg) - 1, " in widget \"%.50s\")",
+ Tk_PathName(tkwin));
+ }
+ Tcl_AddErrorInfo(interp, msg);
+ }
+ Tcl_DecrRefCount(valuePtr);
+ return TCL_ERROR;
+ }
+ Tcl_DecrRefCount(valuePtr);
+ }
+ return TCL_OK;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * DoObjConfig --
+ *
+ * This function applies a new value for a configuration option to the
+ * record being configured.
+ *
+ * Results:
+ * The return value is TCL_OK if the function completed successfully. If
+ * an error occurred then TCL_ERROR is returned and an error message is
+ * left in interp's result, if interp isn't NULL. In addition, if
+ * oldValuePtrPtr isn't NULL then it *oldValuePtrPtr is filled in with a
+ * pointer to the option's old value.
+ *
+ * Side effects:
+ * RecordPtr gets modified to hold the new value in the form of a
+ * Tcl_Obj, an internal representation, or both. The old value is freed
+ * if oldValuePtrPtr is NULL.
+ *
+ *--------------------------------------------------------------
+ */
+
+static int
+DoObjConfig(
+ Tcl_Interp *interp, /* Interpreter for error reporting. If NULL,
+ * then no message is left if an error
+ * occurs. */
+ char *recordPtr, /* The record to modify to hold the new option
+ * value. */
+ Option *optionPtr, /* Pointer to information about the option. */
+ Tcl_Obj *valuePtr, /* New value for option. */
+ Tk_Window tkwin, /* Window in which option will be used (needed
+ * to allocate resources for some options).
+ * May be NULL if the option doesn't require
+ * window-related resources. */
+ Tk_SavedOption *savedOptionPtr)
+ /* If NULL, the old value for the option will
+ * be freed. If non-NULL, the old value will
+ * be stored here, and it becomes the property
+ * of the caller (the caller must eventually
+ * free the old value). */
+{
+ Tcl_Obj **slotPtrPtr, *oldPtr;
+ char *internalPtr; /* Points to location in record where internal
+ * representation of value should be stored,
+ * or NULL. */
+ char *oldInternalPtr; /* Points to location in which to save old
+ * internal representation of value. */
+ Tk_SavedOption internal; /* Used to save the old internal
+ * representation of the value if
+ * savedOptionPtr is NULL. */
+ const Tk_OptionSpec *specPtr;
+ int nullOK;
+
+ /*
+ * Save the old object form for the value, if there is one.
+ */
+
+ specPtr = optionPtr->specPtr;
+ if (specPtr->objOffset >= 0) {
+ slotPtrPtr = (Tcl_Obj **) (recordPtr + specPtr->objOffset);
+ oldPtr = *slotPtrPtr;
+ } else {
+ slotPtrPtr = NULL;
+ oldPtr = NULL;
+ }
+
+ /*
+ * Apply the new value in a type-specific way. Also remember the old
+ * object and internal forms, if they exist.
+ */
+
+ if (specPtr->internalOffset >= 0) {
+ internalPtr = recordPtr + specPtr->internalOffset;
+ } else {
+ internalPtr = NULL;
+ }
+ if (savedOptionPtr != NULL) {
+ savedOptionPtr->optionPtr = optionPtr;
+ savedOptionPtr->valuePtr = oldPtr;
+ oldInternalPtr = (char *) &savedOptionPtr->internalForm;
+ } else {
+ oldInternalPtr = (char *) &internal.internalForm;
+ }
+ nullOK = (optionPtr->specPtr->flags & TK_OPTION_NULL_OK);
+ switch (optionPtr->specPtr->type) {
+ case TK_OPTION_BOOLEAN: {
+ int newBool;
+
+ if (Tcl_GetBooleanFromObj(interp, valuePtr, &newBool) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (internalPtr != NULL) {
+ *((int *) oldInternalPtr) = *((int *) internalPtr);
+ *((int *) internalPtr) = newBool;
+ }
+ break;
+ }
+ case TK_OPTION_INT: {
+ int newInt;
+
+ if (Tcl_GetIntFromObj(interp, valuePtr, &newInt) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (internalPtr != NULL) {
+ *((int *) oldInternalPtr) = *((int *) internalPtr);
+ *((int *) internalPtr) = newInt;
+ }
+ break;
+ }
+ case TK_OPTION_DOUBLE: {
+ double newDbl;
+
+ if (nullOK && ObjectIsEmpty(valuePtr)) {
+ valuePtr = NULL;
+ newDbl = 0;
+ } else {
+ if (Tcl_GetDoubleFromObj(interp, valuePtr, &newDbl) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ }
+
+ if (internalPtr != NULL) {
+ *((double *) oldInternalPtr) = *((double *) internalPtr);
+ *((double *) internalPtr) = newDbl;
+ }
+ break;
+ }
+ case TK_OPTION_STRING: {
+ char *newStr;
+ const char *value;
+ int length;
+
+ if (nullOK && ObjectIsEmpty(valuePtr)) {
+ valuePtr = NULL;
+ }
+ if (internalPtr != NULL) {
+ if (valuePtr != NULL) {
+ value = Tcl_GetStringFromObj(valuePtr, &length);
+ newStr = ckalloc(length + 1);
+ strcpy(newStr, value);
+ } else {
+ newStr = NULL;
+ }
+ *((char **) oldInternalPtr) = *((char **) internalPtr);
+ *((char **) internalPtr) = newStr;
+ }
+ break;
+ }
+ case TK_OPTION_STRING_TABLE: {
+ int newValue;
+
+ if (Tcl_GetIndexFromObjStruct(interp, valuePtr,
+ optionPtr->specPtr->clientData, sizeof(char *),
+ optionPtr->specPtr->optionName+1, 0, &newValue) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (internalPtr != NULL) {
+ *((int *) oldInternalPtr) = *((int *) internalPtr);
+ *((int *) internalPtr) = newValue;
+ }
+ break;
+ }
+ case TK_OPTION_COLOR: {
+ XColor *newPtr;
+
+ if (nullOK && ObjectIsEmpty(valuePtr)) {
+ valuePtr = NULL;
+ newPtr = NULL;
+ } else {
+ newPtr = Tk_AllocColorFromObj(interp, tkwin, valuePtr);
+ if (newPtr == NULL) {
+ return TCL_ERROR;
+ }
+ }
+ if (internalPtr != NULL) {
+ *((XColor **) oldInternalPtr) = *((XColor **) internalPtr);
+ *((XColor **) internalPtr) = newPtr;
+ }
+ break;
+ }
+ case TK_OPTION_FONT: {
+ Tk_Font newFont;
+
+ if (nullOK && ObjectIsEmpty(valuePtr)) {
+ valuePtr = NULL;
+ newFont = NULL;
+ } else {
+ newFont = Tk_AllocFontFromObj(interp, tkwin, valuePtr);
+ if (newFont == NULL) {
+ return TCL_ERROR;
+ }
+ }
+ if (internalPtr != NULL) {
+ *((Tk_Font *) oldInternalPtr) = *((Tk_Font *) internalPtr);
+ *((Tk_Font *) internalPtr) = newFont;
+ }
+ break;
+ }
+ case TK_OPTION_STYLE: {
+ Tk_Style newStyle;
+
+ if (nullOK && ObjectIsEmpty(valuePtr)) {
+ valuePtr = NULL;
+ newStyle = NULL;
+ } else {
+ newStyle = Tk_AllocStyleFromObj(interp, valuePtr);
+ if (newStyle == NULL) {
+ return TCL_ERROR;
+ }
+ }
+ if (internalPtr != NULL) {
+ *((Tk_Style *) oldInternalPtr) = *((Tk_Style *) internalPtr);
+ *((Tk_Style *) internalPtr) = newStyle;
+ }
+ break;
+ }
+ case TK_OPTION_BITMAP: {
+ Pixmap newBitmap;
+
+ if (nullOK && ObjectIsEmpty(valuePtr)) {
+ valuePtr = NULL;
+ newBitmap = None;
+ } else {
+ newBitmap = Tk_AllocBitmapFromObj(interp, tkwin, valuePtr);
+ if (newBitmap == None) {
+ return TCL_ERROR;
+ }
+ }
+ if (internalPtr != NULL) {
+ *((Pixmap *) oldInternalPtr) = *((Pixmap *) internalPtr);
+ *((Pixmap *) internalPtr) = newBitmap;
+ }
+ break;
+ }
+ case TK_OPTION_BORDER: {
+ Tk_3DBorder newBorder;
+
+ if (nullOK && ObjectIsEmpty(valuePtr)) {
+ valuePtr = NULL;
+ newBorder = NULL;
+ } else {
+ newBorder = Tk_Alloc3DBorderFromObj(interp, tkwin, valuePtr);
+ if (newBorder == NULL) {
+ return TCL_ERROR;
+ }
+ }
+ if (internalPtr != NULL) {
+ *((Tk_3DBorder *) oldInternalPtr) = *((Tk_3DBorder *) internalPtr);
+ *((Tk_3DBorder *) internalPtr) = newBorder;
+ }
+ break;
+ }
+ case TK_OPTION_RELIEF: {
+ int newRelief;
+
+ if (nullOK && ObjectIsEmpty(valuePtr)) {
+ valuePtr = NULL;
+ newRelief = TK_RELIEF_NULL;
+ } else {
+ if (Tk_GetReliefFromObj(interp, valuePtr, &newRelief) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ }
+ if (internalPtr != NULL) {
+ *((int *) oldInternalPtr) = *((int *) internalPtr);
+ *((int *) internalPtr) = newRelief;
+ }
+ break;
+ }
+ case TK_OPTION_CURSOR: {
+ Tk_Cursor newCursor;
+
+ if (nullOK && ObjectIsEmpty(valuePtr)) {
+ newCursor = None;
+ valuePtr = NULL;
+ } else {
+ newCursor = Tk_AllocCursorFromObj(interp, tkwin, valuePtr);
+ if (newCursor == None) {
+ return TCL_ERROR;
+ }
+ }
+ if (internalPtr != NULL) {
+ *((Tk_Cursor *) oldInternalPtr) = *((Tk_Cursor *) internalPtr);
+ *((Tk_Cursor *) internalPtr) = newCursor;
+ }
+ Tk_DefineCursor(tkwin, newCursor);
+ break;
+ }
+ case TK_OPTION_JUSTIFY: {
+ Tk_Justify newJustify;
+
+ if (Tk_GetJustifyFromObj(interp, valuePtr, &newJustify) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (internalPtr != NULL) {
+ *((Tk_Justify *) oldInternalPtr) = *((Tk_Justify *) internalPtr);
+ *((Tk_Justify *) internalPtr) = newJustify;
+ }
+ break;
+ }
+ case TK_OPTION_ANCHOR: {
+ Tk_Anchor newAnchor;
+
+ if (Tk_GetAnchorFromObj(interp, valuePtr, &newAnchor) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (internalPtr != NULL) {
+ *((Tk_Anchor *) oldInternalPtr) = *((Tk_Anchor *) internalPtr);
+ *((Tk_Anchor *) internalPtr) = newAnchor;
+ }
+ break;
+ }
+ case TK_OPTION_PIXELS: {
+ int newPixels;
+
+ if (nullOK && ObjectIsEmpty(valuePtr)) {
+ valuePtr = NULL;
+ newPixels = 0;
+ } else {
+ if (Tk_GetPixelsFromObj(interp, tkwin, valuePtr,
+ &newPixels) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ }
+ if (internalPtr != NULL) {
+ *((int *) oldInternalPtr) = *((int *) internalPtr);
+ *((int *) internalPtr) = newPixels;
+ }
+ break;
+ }
+ case TK_OPTION_WINDOW: {
+ Tk_Window newWin;
+
+ if (nullOK && ObjectIsEmpty(valuePtr)) {
+ valuePtr = NULL;
+ newWin = None;
+ } else {
+ if (TkGetWindowFromObj(interp, tkwin, valuePtr,
+ &newWin) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ }
+ if (internalPtr != NULL) {
+ *((Tk_Window *) oldInternalPtr) = *((Tk_Window *) internalPtr);
+ *((Tk_Window *) internalPtr) = newWin;
+ }
+ break;
+ }
+ case TK_OPTION_CUSTOM: {
+ const Tk_ObjCustomOption *custom = optionPtr->extra.custom;
+
+ if (custom->setProc(custom->clientData, interp, tkwin,
+ &valuePtr, recordPtr, optionPtr->specPtr->internalOffset,
+ (char *)oldInternalPtr, optionPtr->specPtr->flags) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ break;
+ }
+
+ default:
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "bad config table: unknown type %d",
+ optionPtr->specPtr->type));
+ Tcl_SetErrorCode(interp, "TK", "BAD_CONFIG", NULL);
+ return TCL_ERROR;
+ }
+
+ /*
+ * Release resources associated with the old value, if we're not returning
+ * it to the caller, then install the new object value into the record.
+ */
+
+ if (savedOptionPtr == NULL) {
+ if (optionPtr->flags & OPTION_NEEDS_FREEING) {
+ FreeResources(optionPtr, oldPtr, oldInternalPtr, tkwin);
+ }
+ if (oldPtr != NULL) {
+ Tcl_DecrRefCount(oldPtr);
+ }
+ }
+ if (slotPtrPtr != NULL) {
+ *slotPtrPtr = valuePtr;
+ if (valuePtr != NULL) {
+ Tcl_IncrRefCount(valuePtr);
+ }
+ }
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ObjectIsEmpty --
+ *
+ * This function tests whether the string value of an object is empty.
+ *
+ * Results:
+ * The return value is 1 if the string value of objPtr has length zero,
+ * and 0 otherwise.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+ObjectIsEmpty(
+ Tcl_Obj *objPtr) /* Object to test. May be NULL. */
+{
+ int length;
+
+ if (objPtr == NULL) {
+ return 1;
+ }
+ if (objPtr->bytes != NULL) {
+ return (objPtr->length == 0);
+ }
+ (void)Tcl_GetStringFromObj(objPtr, &length);
+ return (length == 0);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * GetOption --
+ *
+ * This function searches through a chained option table to find the
+ * entry for a particular option name.
+ *
+ * Results:
+ * The return value is a pointer to the matching entry, or NULL if no
+ * matching entry could be found. Note: if the matching entry is a
+ * synonym then this function returns a pointer to the synonym entry,
+ * *not* the "real" entry that the synonym refers to.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static Option *
+GetOption(
+ const char *name, /* String balue to be looked up in the option
+ * table. */
+ OptionTable *tablePtr) /* Table in which to look up name. */
+{
+ Option *bestPtr, *optionPtr;
+ OptionTable *tablePtr2;
+ const char *p1, *p2;
+ int count;
+
+ /*
+ * Search through all of the option tables in the chain to find the best
+ * match. Some tricky aspects:
+ *
+ * 1. We have to accept unique abbreviations.
+ * 2. The same name could appear in different tables in the chain. If this
+ * happens, we use the entry from the first table. We have to be
+ * careful to distinguish this case from an ambiguous abbreviation.
+ */
+
+ bestPtr = NULL;
+ for (tablePtr2 = tablePtr; tablePtr2 != NULL;
+ tablePtr2 = tablePtr2->nextPtr) {
+ for (optionPtr = tablePtr2->options, count = tablePtr2->numOptions;
+ count > 0; optionPtr++, count--) {
+ for (p1 = name, p2 = optionPtr->specPtr->optionName;
+ *p1 == *p2; p1++, p2++) {
+ if (*p1 == 0) {
+ /*
+ * This is an exact match. We're done.
+ */
+
+ return optionPtr;
+ }
+ }
+ if (*p1 == 0) {
+ /*
+ * The name is an abbreviation for this option. Keep to make
+ * sure that the abbreviation only matches one option name.
+ * If we've already found a match in the past, then it is an
+ * error unless the full names for the two options are
+ * identical; in this case, the first option overrides the
+ * second.
+ */
+
+ if (bestPtr == NULL) {
+ bestPtr = optionPtr;
+ } else if (strcmp(bestPtr->specPtr->optionName,
+ optionPtr->specPtr->optionName) != 0) {
+ return NULL;
+ }
+ }
+ }
+ }
+
+ /*
+ * Return whatever we have found, which could be NULL if nothing
+ * matched. The multiple-matching case is handled above.
+ */
+
+ return bestPtr;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * GetOptionFromObj --
+ *
+ * This function 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 function returns a pointer to
+ * the synonym entry, *not* the "real" entry that the synonym refers to.
+ *
+ * Side effects:
+ * Information about the matching entry is cached in the object
+ * containing the name, so that future lookups can proceed more quickly.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static Option *
+GetOptionFromObj(
+ 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;
+ const char *name;
+
+ /*
+ * First, check to see if the object already has the answer cached.
+ */
+
+ if (objPtr->typePtr == &optionObjType) {
+ if (objPtr->internalRep.twoPtrValue.ptr1 == (void *) tablePtr) {
+ return (Option *) objPtr->internalRep.twoPtrValue.ptr2;
+ }
+ }
+
+ /*
+ * The answer isn't cached.
+ */
+
+ name = Tcl_GetString(objPtr);
+ bestPtr = GetOption(name, tablePtr);
+ if (bestPtr == NULL) {
+ goto error;
+ }
+
+ if ((objPtr->typePtr != NULL)
+ && (objPtr->typePtr->freeIntRepProc != NULL)) {
+ objPtr->typePtr->freeIntRepProc(objPtr);
+ }
+ objPtr->internalRep.twoPtrValue.ptr1 = (void *) tablePtr;
+ objPtr->internalRep.twoPtrValue.ptr2 = (void *) bestPtr;
+ objPtr->typePtr = &optionObjType;
+ tablePtr->refCount++;
+ return bestPtr;
+
+ error:
+ if (interp != NULL) {
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "unknown option \"%s\"", name));
+ Tcl_SetErrorCode(interp, "TK", "LOOKUP", "OPTION", name, NULL);
+ }
+ return NULL;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkGetOptionSpec --
+ *
+ * This function searches through a chained option table to find the
+ * option spec for a particular option name.
+ *
+ * Results:
+ * The return value is a pointer to the option spec of the matching
+ * entry, or NULL if no matching entry could be found. Note: if the
+ * matching entry is a synonym then this function returns a pointer to
+ * the option spec of the synonym entry, *not* the "real" entry that the
+ * synonym refers to. Note: this call is primarily used by the style
+ * management code (tkStyle.c) to look up an element's option spec into a
+ * widget's option table.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+const Tk_OptionSpec *
+TkGetOptionSpec(
+ const char *name, /* String value to be looked up. */
+ Tk_OptionTable optionTable) /* Table in which to look up name. */
+{
+ Option *optionPtr;
+
+ optionPtr = GetOption(name, (OptionTable *) optionTable);
+ if (optionPtr == NULL) {
+ return NULL;
+ }
+ return optionPtr->specPtr;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * FreeOptionInternalRep --
+ *
+ * Part of the option Tcl object type implementation. Frees the storage
+ * associated with a option object's internal representation unless it
+ * is still in use.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The option object's internal rep is marked invalid and its memory
+ * gets freed unless it is still in use somewhere. In that case the
+ * cleanup is delayed until the last reference goes away.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+FreeOptionInternalRep(
+ register Tcl_Obj *objPtr) /* Object whose internal rep to free. */
+{
+ register Tk_OptionTable tablePtr = (Tk_OptionTable) objPtr->internalRep.twoPtrValue.ptr1;
+
+ Tk_DeleteOptionTable(tablePtr);
+ objPtr->typePtr = NULL;
+ objPtr->internalRep.twoPtrValue.ptr1 = NULL;
+ objPtr->internalRep.twoPtrValue.ptr2 = NULL;
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * DupOptionInternalRep --
+ *
+ * When a cached option object is duplicated, this is called to update the
+ * internal reps.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+static void
+DupOptionInternalRep(
+ Tcl_Obj *srcObjPtr, /* The object we are copying from. */
+ Tcl_Obj *dupObjPtr) /* The object we are copying to. */
+{
+ register OptionTable *tablePtr = (OptionTable *) srcObjPtr->internalRep.twoPtrValue.ptr1;
+ tablePtr->refCount++;
+ dupObjPtr->typePtr = srcObjPtr->typePtr;
+ dupObjPtr->internalRep = srcObjPtr->internalRep;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * 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(
+ 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_SetObjResult(interp, Tcl_ObjPrintf(
+ "value for \"%s\" missing",
+ Tcl_GetString(*objv)));
+ Tcl_SetErrorCode(interp, "TK", "VALUE_MISSING", NULL);
+ goto error;
+ }
+ }
+ if ((savePtr != NULL)
+ && (lastSavePtr->numItems >= TK_NUM_SAVED_OPTIONS)) {
+ /*
+ * We've run out of space for saving old option values. Allocate
+ * more space.
+ */
+
+ newSavePtr = 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]
+ : NULL) != TCL_OK) {
+ Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf(
+ "\n (processing \"%.40s\" option)",
+ Tcl_GetString(*objv)));
+ 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 function 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(
+ 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(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) {
+ register char *ptr = (char *) &savePtr->items[i].internalForm;
+
+ CLANG_ASSERT(internalPtr);
+ switch (specPtr->type) {
+ case TK_OPTION_BOOLEAN:
+ *((int *) internalPtr) = *((int *) ptr);
+ break;
+ case TK_OPTION_INT:
+ *((int *) internalPtr) = *((int *) ptr);
+ break;
+ case TK_OPTION_DOUBLE:
+ *((double *) internalPtr) = *((double *) ptr);
+ break;
+ case TK_OPTION_STRING:
+ *((char **) internalPtr) = *((char **) ptr);
+ break;
+ case TK_OPTION_STRING_TABLE:
+ *((int *) internalPtr) = *((int *) ptr);
+ break;
+ case TK_OPTION_COLOR:
+ *((XColor **) internalPtr) = *((XColor **) ptr);
+ break;
+ case TK_OPTION_FONT:
+ *((Tk_Font *) internalPtr) = *((Tk_Font *) ptr);
+ break;
+ case TK_OPTION_STYLE:
+ *((Tk_Style *) internalPtr) = *((Tk_Style *) ptr);
+ break;
+ case TK_OPTION_BITMAP:
+ *((Pixmap *) internalPtr) = *((Pixmap *) ptr);
+ break;
+ case TK_OPTION_BORDER:
+ *((Tk_3DBorder *) internalPtr) = *((Tk_3DBorder *) ptr);
+ break;
+ case TK_OPTION_RELIEF:
+ *((int *) internalPtr) = *((int *) ptr);
+ break;
+ case TK_OPTION_CURSOR:
+ *((Tk_Cursor *) internalPtr) = *((Tk_Cursor *) ptr);
+ Tk_DefineCursor(savePtr->tkwin, *((Tk_Cursor *) internalPtr));
+ break;
+ case TK_OPTION_JUSTIFY:
+ *((Tk_Justify *) internalPtr) = *((Tk_Justify *) ptr);
+ break;
+ case TK_OPTION_ANCHOR:
+ *((Tk_Anchor *) internalPtr) = *((Tk_Anchor *) ptr);
+ break;
+ case TK_OPTION_PIXELS:
+ *((int *) internalPtr) = *((int *) ptr);
+ break;
+ case TK_OPTION_WINDOW:
+ *((Tk_Window *) internalPtr) = *((Tk_Window *) ptr);
+ break;
+ case TK_OPTION_CUSTOM: {
+ const Tk_ObjCustomOption *custom = optionPtr->extra.custom;
+
+ if (custom->restoreProc != NULL) {
+ custom->restoreProc(custom->clientData, savePtr->tkwin,
+ internalPtr, ptr);
+ }
+ break;
+ }
+ default:
+ Tcl_Panic("bad option type in Tk_RestoreSavedOptions");
+ }
+ }
+ }
+ savePtr->numItems = 0;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * Tk_FreeSavedOptions --
+ *
+ * Free all of the saved configuration option values from a previous call
+ * to Tk_SetOptions.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Storage and system resources are freed.
+ *
+ *--------------------------------------------------------------
+ */
+
+void
+Tk_FreeSavedOptions(
+ 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(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(
+ 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(
+ Option *optionPtr, /* Description of the configuration option. */
+ Tcl_Obj *objPtr, /* The current value of the option, specified
+ * as an object. */
+ char *internalPtr, /* A pointer to an internal representation for
+ * the option's value, such as an int or
+ * (XColor *). Only valid if
+ * optionPtr->specPtr->internalOffset >= 0. */
+ Tk_Window tkwin) /* The window in which this option is used. */
+{
+ int internalFormExists;
+
+ /*
+ * If there exists an internal form for the value, use it to free
+ * resources (also zero out the internal form). If there is no internal
+ * form, then use the object form.
+ */
+
+ internalFormExists = optionPtr->specPtr->internalOffset >= 0;
+ switch (optionPtr->specPtr->type) {
+ case TK_OPTION_STRING:
+ if (internalFormExists) {
+ if (*((char **) internalPtr) != NULL) {
+ ckfree(*((char **) internalPtr));
+ *((char **) internalPtr) = NULL;
+ }
+ }
+ break;
+ case TK_OPTION_COLOR:
+ if (internalFormExists) {
+ if (*((XColor **) internalPtr) != NULL) {
+ Tk_FreeColor(*((XColor **) internalPtr));
+ *((XColor **) internalPtr) = NULL;
+ }
+ } else if (objPtr != NULL) {
+ Tk_FreeColorFromObj(tkwin, objPtr);
+ }
+ break;
+ case TK_OPTION_FONT:
+ if (internalFormExists) {
+ Tk_FreeFont(*((Tk_Font *) internalPtr));
+ *((Tk_Font *) internalPtr) = NULL;
+ } else if (objPtr != NULL) {
+ Tk_FreeFontFromObj(tkwin, objPtr);
+ }
+ break;
+ case TK_OPTION_STYLE:
+ if (internalFormExists) {
+ Tk_FreeStyle(*((Tk_Style *) internalPtr));
+ *((Tk_Style *) internalPtr) = NULL;
+ } else if (objPtr != NULL) {
+ Tk_FreeStyleFromObj(objPtr);
+ }
+ break;
+ case TK_OPTION_BITMAP:
+ if (internalFormExists) {
+ if (*((Pixmap *) internalPtr) != None) {
+ Tk_FreeBitmap(Tk_Display(tkwin), *((Pixmap *) internalPtr));
+ *((Pixmap *) internalPtr) = None;
+ }
+ } else if (objPtr != NULL) {
+ Tk_FreeBitmapFromObj(tkwin, objPtr);
+ }
+ break;
+ case TK_OPTION_BORDER:
+ if (internalFormExists) {
+ if (*((Tk_3DBorder *) internalPtr) != NULL) {
+ Tk_Free3DBorder(*((Tk_3DBorder *) internalPtr));
+ *((Tk_3DBorder *) internalPtr) = NULL;
+ }
+ } else if (objPtr != NULL) {
+ Tk_Free3DBorderFromObj(tkwin, objPtr);
+ }
+ break;
+ case TK_OPTION_CURSOR:
+ if (internalFormExists) {
+ if (*((Tk_Cursor *) internalPtr) != None) {
+ Tk_FreeCursor(Tk_Display(tkwin), *((Tk_Cursor *) internalPtr));
+ *((Tk_Cursor *) internalPtr) = None;
+ }
+ } else if (objPtr != NULL) {
+ Tk_FreeCursorFromObj(tkwin, objPtr);
+ }
+ break;
+ case TK_OPTION_CUSTOM: {
+ const Tk_ObjCustomOption *custom = optionPtr->extra.custom;
+ if (internalFormExists && custom->freeProc != NULL) {
+ custom->freeProc(custom->clientData, tkwin, internalPtr);
+ }
+ break;
+ }
+ default:
+ break;
+ }
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * Tk_GetOptionInfo --
+ *
+ * Returns a list object containing complete information about either a
+ * single option or all the configuration options in a table.
+ *
+ * Results:
+ * This function normally returns a pointer to an object. If namePtr
+ * isn't NULL, then the result object is a list with five elements: the
+ * option's name, its database name, database class, default value, and
+ * current value. If the option is a synonym then the list will contain
+ * only two values: the option name and the name of the option it refers
+ * to. If namePtr is NULL, then information is returned for every option
+ * in the option table: the result will have one sub-list (in the form
+ * described above) for each option in the table. If an error occurs
+ * (e.g. because namePtr isn't valid) then NULL is returned and an error
+ * message will be left in interp's result unless interp is NULL.
+ *
+ * Side effects:
+ * None.
+ *
+ *--------------------------------------------------------------
+ */
+
+Tcl_Obj *
+Tk_GetOptionInfo(
+ Tcl_Interp *interp, /* Interpreter for error reporting. If NULL,
+ * then no error message is created. */
+ char *recordPtr, /* Record whose fields contain current values
+ * for options. */
+ Tk_OptionTable optionTable, /* Describes all the legal options. */
+ Tcl_Obj *namePtr, /* If non-NULL, the string value selects a
+ * single option whose info is to be returned.
+ * Otherwise info is returned for all options
+ * in optionTable. */
+ Tk_Window tkwin) /* Window associated with recordPtr; needed to
+ * compute correct default value for some
+ * options. */
+{
+ Tcl_Obj *resultPtr;
+ OptionTable *tablePtr = (OptionTable *) optionTable;
+ Option *optionPtr;
+ int count;
+
+ /*
+ * If information is only wanted for a single configuration spec, then
+ * handle that one spec specially.
+ */
+
+ if (namePtr != NULL) {
+ optionPtr = GetOptionFromObj(interp, namePtr, tablePtr);
+ if (optionPtr == NULL) {
+ return NULL;
+ }
+ if (optionPtr->specPtr->type == TK_OPTION_SYNONYM) {
+ optionPtr = optionPtr->extra.synonymPtr;
+ }
+ return GetConfigList(recordPtr, optionPtr, tkwin);
+ }
+
+ /*
+ * Loop through all the specs, creating a big list with all their
+ * information.
+ */
+
+ resultPtr = Tcl_NewListObj(0, NULL);
+ for (; tablePtr != NULL; tablePtr = tablePtr->nextPtr) {
+ for (optionPtr = tablePtr->options, count = tablePtr->numOptions;
+ count > 0; optionPtr++, count--) {
+ Tcl_ListObjAppendElement(interp, resultPtr,
+ GetConfigList(recordPtr, optionPtr, tkwin));
+ }
+ }
+ return resultPtr;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * GetConfigList --
+ *
+ * Create a valid Tcl list holding the configuration information for a
+ * single configuration option.
+ *
+ * Results:
+ * A Tcl list, dynamically allocated. The caller is expected to arrange
+ * for this list to be freed eventually.
+ *
+ * Side effects:
+ * Memory is allocated.
+ *
+ *--------------------------------------------------------------
+ */
+
+static Tcl_Obj *
+GetConfigList(
+ char *recordPtr, /* Pointer to record holding current values of
+ * configuration options. */
+ Option *optionPtr, /* Pointer to information describing a
+ * particular option. */
+ Tk_Window tkwin) /* Window corresponding to recordPtr. */
+{
+ Tcl_Obj *listPtr, *elementPtr;
+
+ listPtr = Tcl_NewListObj(0, NULL);
+ Tcl_ListObjAppendElement(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(NULL, listPtr, elementPtr);
+ } else {
+ if (optionPtr->dbNameUID == NULL) {
+ elementPtr = Tcl_NewObj();
+ } else {
+ elementPtr = Tcl_NewStringObj(optionPtr->dbNameUID, -1);
+ }
+ Tcl_ListObjAppendElement(NULL, listPtr, elementPtr);
+
+ if (optionPtr->dbClassUID == NULL) {
+ elementPtr = Tcl_NewObj();
+ } else {
+ elementPtr = Tcl_NewStringObj(optionPtr->dbClassUID, -1);
+ }
+ Tcl_ListObjAppendElement(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(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(NULL, listPtr, elementPtr);
+ }
+ return listPtr;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * GetObjectForOption --
+ *
+ * This function is called to create an object that contains the value
+ * for an option. It is invoked by GetConfigList and Tk_GetOptionValue
+ * when only the internal form of an option is stored in the record.
+ *
+ * Results:
+ * The return value is a pointer to a Tcl object. The caller must call
+ * Tcl_IncrRefCount on this object to preserve it.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static Tcl_Obj *
+GetObjectForOption(
+ char *recordPtr, /* Pointer to record holding current values of
+ * configuration options. */
+ Option *optionPtr, /* Pointer to information describing an option
+ * whose internal value is stored in
+ * *recordPtr. */
+ Tk_Window tkwin) /* Window corresponding to recordPtr. */
+{
+ Tcl_Obj *objPtr;
+ char *internalPtr; /* Points to internal value of option in
+ * record. */
+
+ internalPtr = recordPtr + optionPtr->specPtr->internalOffset;
+ objPtr = NULL;
+ switch (optionPtr->specPtr->type) {
+ case TK_OPTION_BOOLEAN:
+ objPtr = Tcl_NewIntObj(*((int *) internalPtr));
+ break;
+ case TK_OPTION_INT:
+ objPtr = Tcl_NewIntObj(*((int *) internalPtr));
+ break;
+ case TK_OPTION_DOUBLE:
+ objPtr = Tcl_NewDoubleObj(*((double *) internalPtr));
+ break;
+ case TK_OPTION_STRING:
+ objPtr = Tcl_NewStringObj(*((char **) internalPtr), -1);
+ break;
+ case TK_OPTION_STRING_TABLE:
+ objPtr = Tcl_NewStringObj(((char **) optionPtr->specPtr->clientData)[
+ *((int *) internalPtr)], -1);
+ break;
+ case TK_OPTION_COLOR: {
+ XColor *colorPtr = *((XColor **) internalPtr);
+
+ if (colorPtr != NULL) {
+ objPtr = Tcl_NewStringObj(Tk_NameOfColor(colorPtr), -1);
+ }
+ break;
+ }
+ case TK_OPTION_FONT: {
+ Tk_Font tkfont = *((Tk_Font *) internalPtr);
+
+ if (tkfont != NULL) {
+ objPtr = Tcl_NewStringObj(Tk_NameOfFont(tkfont), -1);
+ }
+ break;
+ }
+ case TK_OPTION_STYLE: {
+ Tk_Style style = *((Tk_Style *) internalPtr);
+
+ if (style != NULL) {
+ objPtr = Tcl_NewStringObj(Tk_NameOfStyle(style), -1);
+ }
+ break;
+ }
+ case TK_OPTION_BITMAP: {
+ Pixmap pixmap = *((Pixmap *) internalPtr);
+
+ if (pixmap != None) {
+ objPtr = Tcl_NewStringObj(
+ Tk_NameOfBitmap(Tk_Display(tkwin), pixmap), -1);
+ }
+ break;
+ }
+ case TK_OPTION_BORDER: {
+ Tk_3DBorder border = *((Tk_3DBorder *) internalPtr);
+
+ if (border != NULL) {
+ objPtr = Tcl_NewStringObj(Tk_NameOf3DBorder(border), -1);
+ }
+ break;
+ }
+ case TK_OPTION_RELIEF:
+ objPtr = Tcl_NewStringObj(Tk_NameOfRelief(*((int *) internalPtr)), -1);
+ break;
+ case TK_OPTION_CURSOR: {
+ Tk_Cursor cursor = *((Tk_Cursor *) internalPtr);
+
+ if (cursor != None) {
+ objPtr = Tcl_NewStringObj(
+ Tk_NameOfCursor(Tk_Display(tkwin), cursor), -1);
+ }
+ break;
+ }
+ case TK_OPTION_JUSTIFY:
+ objPtr = Tcl_NewStringObj(Tk_NameOfJustify(
+ *((Tk_Justify *) internalPtr)), -1);
+ break;
+ case TK_OPTION_ANCHOR:
+ objPtr = Tcl_NewStringObj(Tk_NameOfAnchor(
+ *((Tk_Anchor *) internalPtr)), -1);
+ break;
+ case TK_OPTION_PIXELS:
+ objPtr = Tcl_NewIntObj(*((int *) internalPtr));
+ break;
+ case TK_OPTION_WINDOW: {
+ Tk_Window tkwin = *((Tk_Window *) internalPtr);
+
+ if (tkwin != NULL) {
+ objPtr = Tcl_NewStringObj(Tk_PathName(tkwin), -1);
+ }
+ break;
+ }
+ case TK_OPTION_CUSTOM: {
+ const Tk_ObjCustomOption *custom = optionPtr->extra.custom;
+
+ objPtr = custom->getProc(custom->clientData, tkwin, recordPtr,
+ optionPtr->specPtr->internalOffset);
+ break;
+ }
+ default:
+ Tcl_Panic("bad option type in GetObjectForOption");
+ }
+ if (objPtr == NULL) {
+ objPtr = Tcl_NewObj();
+ }
+ return objPtr;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_GetOptionValue --
+ *
+ * This function returns the current value of a configuration option.
+ *
+ * Results:
+ * The return value is the object holding the current value of the option
+ * given by namePtr. If no such option exists, then the return value is
+ * NULL and an error message is left in interp's result (if interp isn't
+ * NULL).
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+Tcl_Obj *
+Tk_GetOptionValue(
+ Tcl_Interp *interp, /* Interpreter for error reporting. If NULL
+ * then no messages are provided for
+ * errors. */
+ char *recordPtr, /* Record whose fields contain current values
+ * for options. */
+ Tk_OptionTable optionTable, /* Describes legal options. */
+ Tcl_Obj *namePtr, /* Gives the command-line name for the option
+ * whose value is to be returned. */
+ Tk_Window tkwin) /* Window corresponding to recordPtr. */
+{
+ OptionTable *tablePtr = (OptionTable *) optionTable;
+ Option *optionPtr;
+ Tcl_Obj *resultPtr;
+
+ optionPtr = GetOptionFromObj(interp, namePtr, tablePtr);
+ if (optionPtr == NULL) {
+ return NULL;
+ }
+ if (optionPtr->specPtr->type == TK_OPTION_SYNONYM) {
+ optionPtr = optionPtr->extra.synonymPtr;
+ }
+ if (optionPtr->specPtr->objOffset >= 0) {
+ resultPtr = *((Tcl_Obj **) (recordPtr+optionPtr->specPtr->objOffset));
+ if (resultPtr == NULL) {
+ /*
+ * This option has a null value and is represented by a null
+ * object pointer. We can't return the null pointer, since that
+ * would indicate an error. Instead, return a new empty object.
+ */
+
+ resultPtr = Tcl_NewObj();
+ }
+ } else {
+ resultPtr = GetObjectForOption(recordPtr, optionPtr, tkwin);
+ }
+ return resultPtr;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkDebugConfig --
+ *
+ * This is a debugging function that returns information about one of the
+ * configuration tables that currently exists for an interpreter.
+ *
+ * Results:
+ * If the specified table exists in the given interpreter, then a list is
+ * returned describing the table and any other tables that it chains to:
+ * for each table there will be three list elements giving the reference
+ * count for the table, the number of elements in the table, and the
+ * command-line name for the first option in the table. If the table
+ * doesn't exist in the interpreter then an empty object is returned.
+ * The reference count for the returned object is 0.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+Tcl_Obj *
+TkDebugConfig(
+ Tcl_Interp *interp, /* Interpreter in which the table is
+ * defined. */
+ Tk_OptionTable table) /* Table about which information is to be
+ * returned. May not necessarily exist in the
+ * interpreter anymore. */
+{
+ OptionTable *tablePtr = (OptionTable *) table;
+ Tcl_HashEntry *hashEntryPtr;
+ Tcl_HashSearch search;
+ Tcl_Obj *objPtr;
+ ThreadSpecificData *tsdPtr =
+ Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
+
+ objPtr = Tcl_NewObj();
+ if (!tablePtr || !tsdPtr->initialized) {
+ return objPtr;
+ }
+
+ /*
+ * Scan all the tables for this interpreter to make sure that the one we
+ * want still is valid.
+ */
+
+ for (hashEntryPtr = Tcl_FirstHashEntry(&tsdPtr->hashTable, &search);
+ hashEntryPtr != NULL;
+ hashEntryPtr = Tcl_NextHashEntry(&search)) {
+ if (tablePtr == (OptionTable *) Tcl_GetHashValue(hashEntryPtr)) {
+ for ( ; tablePtr != NULL; tablePtr = tablePtr->nextPtr) {
+ Tcl_ListObjAppendElement(NULL, objPtr,
+ Tcl_NewIntObj(tablePtr->refCount));
+ Tcl_ListObjAppendElement(NULL, objPtr,
+ Tcl_NewIntObj(tablePtr->numOptions));
+ Tcl_ListObjAppendElement(NULL, objPtr, Tcl_NewStringObj(
+ tablePtr->options[0].specPtr->optionName, -1));
+ }
+ break;
+ }
+ }
+ return objPtr;
+}
+
+/*
+ * Local Variables:
+ * mode: c
+ * c-basic-offset: 4
+ * fill-column: 78
+ * End:
+ */
diff --git a/tk8.6/generic/tkConsole.c b/tk8.6/generic/tkConsole.c
new file mode 100644
index 0000000..8bfbe9b
--- /dev/null
+++ b/tk8.6/generic/tkConsole.c
@@ -0,0 +1,964 @@
+/*
+ * tkConsole.c --
+ *
+ * This file implements a Tcl console for systems that may not otherwise
+ * have access to a console. It uses the Text widget and provides special
+ * access via a console command.
+ *
+ * Copyright (c) 1995-1996 Sun Microsystems, Inc.
+ *
+ * See the file "license.terms" for information on usage and redistribution of
+ * this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ */
+
+#include "tkInt.h"
+
+/*
+ * Each console is associated with an instance of the ConsoleInfo struct.
+ * It keeps track of what interp holds the Tk application that displays
+ * the console, and what interp is controlled by the interactions in that
+ * console. A refCount permits the struct to be shared as instance data
+ * by commands and by channels.
+ */
+
+typedef struct ConsoleInfo {
+ Tcl_Interp *consoleInterp; /* Interpreter displaying the console. */
+ Tcl_Interp *interp; /* Interpreter controlled by console. */
+ int refCount;
+} ConsoleInfo;
+
+/*
+ * Each console channel holds an instance of the ChannelData struct as
+ * its instance data. It contains ConsoleInfo, so the channel can work
+ * with the appropriate console window, and a type value to distinguish
+ * the stdout channel from the stderr channel.
+ */
+
+typedef struct ChannelData {
+ ConsoleInfo *info;
+ int type; /* TCL_STDOUT or TCL_STDERR */
+} ChannelData;
+
+/*
+ * Prototypes for local procedures defined in this file:
+ */
+
+static int ConsoleClose(ClientData instanceData, Tcl_Interp *interp);
+static void ConsoleDeleteProc(ClientData clientData);
+static void ConsoleEventProc(ClientData clientData, XEvent *eventPtr);
+static int ConsoleHandle(ClientData instanceData, int direction,
+ ClientData *handlePtr);
+static int ConsoleInput(ClientData instanceData, char *buf, int toRead,
+ int *errorCode);
+static int ConsoleObjCmd(ClientData clientData, Tcl_Interp *interp,
+ int objc, Tcl_Obj *const objv[]);
+static int ConsoleOutput(ClientData instanceData, const char *buf,
+ int toWrite, int *errorCode);
+static void ConsoleWatch(ClientData instanceData, int mask);
+static void DeleteConsoleInterp(ClientData clientData);
+static void InterpDeleteProc(ClientData clientData, Tcl_Interp *interp);
+static int InterpreterObjCmd(ClientData clientData, Tcl_Interp *interp,
+ int objc, Tcl_Obj *const objv[]);
+
+/*
+ * This structure describes the channel type structure for file based IO:
+ */
+
+static const Tcl_ChannelType consoleChannelType = {
+ "console", /* Type name. */
+ TCL_CHANNEL_VERSION_4, /* v4 channel */
+ ConsoleClose, /* Close proc. */
+ ConsoleInput, /* Input proc. */
+ ConsoleOutput, /* Output proc. */
+ NULL, /* Seek proc. */
+ NULL, /* Set option proc. */
+ NULL, /* Get option proc. */
+ ConsoleWatch, /* Watch for events on console. */
+ ConsoleHandle, /* Get a handle from the device. */
+ NULL, /* close2proc. */
+ NULL, /* Always non-blocking.*/
+ NULL, /* flush proc. */
+ NULL, /* handler proc. */
+ NULL, /* wide seek proc */
+ NULL, /* thread action proc */
+ NULL
+};
+
+#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(
+ int type)
+{
+ DWORD handleId; /* Standard handle to retrieve. */
+ DCB dcb;
+ DWORD consoleParams;
+ DWORD fileType;
+ HANDLE handle;
+
+ switch (type) {
+ case TCL_STDIN:
+ handleId = STD_INPUT_HANDLE;
+ break;
+ case TCL_STDOUT:
+ handleId = STD_OUTPUT_HANDLE;
+ break;
+ case TCL_STDERR:
+ handleId = STD_ERROR_HANDLE;
+ break;
+ default:
+ return 0;
+ break;
+ }
+
+ handle = GetStdHandle(handleId);
+
+ /*
+ * Note that we need to check for 0 because Windows will return 0 if this
+ * is not a console mode application, even though this is not a valid
+ * handle.
+ */
+
+ if ((handle == INVALID_HANDLE_VALUE) || (handle == 0)) {
+ return 1;
+ }
+
+ /*
+ * Win2K BUG: GetStdHandle(STD_OUTPUT_HANDLE) can return what appears to
+ * be a valid handle. See TclpGetDefaultStdChannel() for this change
+ * implemented. We didn't change it here because GetFileType() [below]
+ * will catch this with FILE_TYPE_UNKNOWN and appropriately return a value
+ * of 1, anyways.
+ *
+ * char dummyBuff[1];
+ * DWORD dummyWritten;
+ *
+ * if ((type == TCL_STDOUT)
+ * && !WriteFile(handle, dummyBuff, 0, &dummyWritten, NULL)) {
+ * return 1;
+ * }
+ */
+
+ fileType = GetFileType(handle);
+
+ /*
+ * If the file is a character device, we need to try to figure out whether
+ * it is a serial port, a console, or something else. We test for the
+ * console case first because this is more common.
+ */
+
+ if (fileType == FILE_TYPE_CHAR) {
+ dcb.DCBlength = sizeof(DCB);
+ if (!GetConsoleMode(handle, &consoleParams) &&
+ !GetCommState(handle, &dcb)) {
+ /*
+ * Don't use a CHAR type channel for stdio, otherwise Tk runs into
+ * trouble with the MS DevStudio debugger.
+ */
+
+ return 1;
+ }
+ } else if (fileType == FILE_TYPE_UNKNOWN) {
+ return 1;
+ } else if (Tcl_GetStdChannel(type) == NULL) {
+ return 1;
+ }
+
+ return 0;
+}
+#else
+/*
+ * Mac should always use a console channel, Unix should if it's trying to
+ */
+
+#define ShouldUseConsoleChannel(chan) (1)
+#endif
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_InitConsoleChannels --
+ *
+ * Create the console channels and install them as the standard channels.
+ * All I/O will be discarded until Tk_CreateConsoleWindow is called to
+ * attach the console to a text widget.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Creates the console channel and installs it as the standard channels.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tk_InitConsoleChannels(
+ Tcl_Interp *interp)
+{
+ static Tcl_ThreadDataKey consoleInitKey;
+ int *consoleInitPtr, doIn, doOut, doErr;
+ ConsoleInfo *info;
+ Tcl_Channel consoleChannel;
+
+ /*
+ * Ensure that we are getting a compatible version of Tcl.
+ */
+
+ if (Tcl_InitStubs(interp, "8.6", 0) == NULL) {
+ return;
+ }
+
+ consoleInitPtr = Tcl_GetThreadData(&consoleInitKey, (int) sizeof(int));
+ if (*consoleInitPtr) {
+ /*
+ * We've already initialized console channels in this thread.
+ */
+
+ return;
+ }
+ *consoleInitPtr = 1;
+
+ doIn = ShouldUseConsoleChannel(TCL_STDIN);
+ doOut = ShouldUseConsoleChannel(TCL_STDOUT);
+ doErr = ShouldUseConsoleChannel(TCL_STDERR);
+
+ if (!(doIn || doOut || doErr)) {
+ /*
+ * No std channels should be tied to the console; thus, no need to
+ * create the console.
+ */
+
+ return;
+ }
+
+ /*
+ * At least one std channel wants to be tied to the console, so create the
+ * interp for it to live in.
+ */
+
+ info = ckalloc(sizeof(ConsoleInfo));
+ info->consoleInterp = NULL;
+ info->interp = NULL;
+ info->refCount = 0;
+
+ if (doIn) {
+ ChannelData *data = ckalloc(sizeof(ChannelData));
+
+ data->info = info;
+ data->info->refCount++;
+ data->type = TCL_STDIN;
+ consoleChannel = Tcl_CreateChannel(&consoleChannelType, "console0",
+ data, 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);
+ Tcl_RegisterChannel(NULL, consoleChannel);
+ }
+
+ if (doOut) {
+ ChannelData *data = ckalloc(sizeof(ChannelData));
+
+ data->info = info;
+ data->info->refCount++;
+ data->type = TCL_STDOUT;
+ consoleChannel = Tcl_CreateChannel(&consoleChannelType, "console1",
+ data, 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);
+ Tcl_RegisterChannel(NULL, consoleChannel);
+ }
+
+ if (doErr) {
+ ChannelData *data = ckalloc(sizeof(ChannelData));
+
+ data->info = info;
+ data->info->refCount++;
+ data->type = TCL_STDERR;
+ consoleChannel = Tcl_CreateChannel(&consoleChannelType, "console2",
+ data, 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_RegisterChannel(NULL, consoleChannel);
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_CreateConsoleWindow --
+ *
+ * Initialize the console. This code actually creates a new application
+ * and associated interpreter. This effectivly hides the implementation
+ * from the main application.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * A new console it created.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tk_CreateConsoleWindow(
+ Tcl_Interp *interp) /* Interpreter to use for prompting. */
+{
+ Tcl_Channel chan;
+ ConsoleInfo *info;
+ Tk_Window mainWindow;
+ Tcl_Command token;
+ int result = TCL_OK;
+ int haveConsoleChannel = 1;
+
+ /* Init an interp with Tcl and Tk */
+ Tcl_Interp *consoleInterp = Tcl_CreateInterp();
+ if (Tcl_Init(consoleInterp) != TCL_OK) {
+ goto error;
+ }
+ if (Tk_Init(consoleInterp) != TCL_OK) {
+ goto error;
+ }
+
+ /*
+ * Fetch the instance data from whatever std channel is a
+ * console channel. If none, create fresh instance data.
+ */
+
+ if (Tcl_GetChannelType(chan = Tcl_GetStdChannel(TCL_STDIN))
+ == &consoleChannelType) {
+ } else if (Tcl_GetChannelType(chan = Tcl_GetStdChannel(TCL_STDOUT))
+ == &consoleChannelType) {
+ } else if (Tcl_GetChannelType(chan = Tcl_GetStdChannel(TCL_STDERR))
+ == &consoleChannelType) {
+ } else {
+ haveConsoleChannel = 0;
+ }
+
+ if (haveConsoleChannel) {
+ ChannelData *data = (ChannelData *) Tcl_GetChannelInstanceData(chan);
+ info = data->info;
+ if (info->consoleInterp) {
+ /*
+ * New ConsoleInfo for a new console window.
+ */
+
+ info = ckalloc(sizeof(ConsoleInfo));
+ info->refCount = 0;
+
+ /*
+ * Update any console channels to make use of the new console.
+ */
+
+ if (Tcl_GetChannelType(chan = Tcl_GetStdChannel(TCL_STDIN))
+ == &consoleChannelType) {
+ data = (ChannelData *) Tcl_GetChannelInstanceData(chan);
+ data->info->refCount--;
+ data->info = info;
+ data->info->refCount++;
+ }
+ if (Tcl_GetChannelType(chan = Tcl_GetStdChannel(TCL_STDOUT))
+ == &consoleChannelType) {
+ data = (ChannelData *) Tcl_GetChannelInstanceData(chan);
+ data->info->refCount--;
+ data->info = info;
+ data->info->refCount++;
+ }
+ if (Tcl_GetChannelType(chan = Tcl_GetStdChannel(TCL_STDERR))
+ == &consoleChannelType) {
+ data = (ChannelData *) Tcl_GetChannelInstanceData(chan);
+ data->info->refCount--;
+ data->info = info;
+ data->info->refCount++;
+ }
+ }
+ } else {
+ info = ckalloc(sizeof(ConsoleInfo));
+ info->refCount = 0;
+ }
+
+ info->consoleInterp = consoleInterp;
+ info->interp = interp;
+
+ Tcl_CallWhenDeleted(consoleInterp, InterpDeleteProc, info);
+ info->refCount++;
+ Tcl_CreateThreadExitHandler(DeleteConsoleInterp, consoleInterp);
+
+ /*
+ * Add console commands to the interp
+ */
+
+ token = Tcl_CreateObjCommand(interp, "console", ConsoleObjCmd, info,
+ ConsoleDeleteProc);
+ info->refCount++;
+
+ /*
+ * We don't have to count the ref held by the [consoleinterp] command
+ * in the consoleInterp. The ref held by the consoleInterp delete
+ * handler takes care of us.
+ */
+ Tcl_CreateObjCommand(consoleInterp, "consoleinterp", InterpreterObjCmd,
+ info, NULL);
+
+ mainWindow = Tk_MainWindow(interp);
+ if (mainWindow) {
+ Tk_CreateEventHandler(mainWindow, StructureNotifyMask,
+ ConsoleEventProc, info);
+ info->refCount++;
+ }
+
+ Tcl_Preserve(consoleInterp);
+ result = Tcl_EvalEx(consoleInterp, "source $tk_library/console.tcl",
+ -1, TCL_EVAL_GLOBAL);
+ if (result == TCL_ERROR) {
+ Tcl_SetReturnOptions(interp,
+ Tcl_GetReturnOptions(consoleInterp, result));
+ Tcl_SetObjResult(interp, Tcl_GetObjResult(consoleInterp));
+ }
+ Tcl_Release(consoleInterp);
+ if (result == TCL_ERROR) {
+ Tcl_DeleteCommandFromToken(interp, token);
+ mainWindow = Tk_MainWindow(interp);
+ if (mainWindow) {
+ Tk_DeleteEventHandler(mainWindow, StructureNotifyMask,
+ ConsoleEventProc, info);
+ if (--info->refCount <= 0) {
+ ckfree(info);
+ }
+ }
+ goto error;
+ }
+ return TCL_OK;
+
+ error:
+ Tcl_AddErrorInfo(interp, "\n (creating console window)");
+ if (!Tcl_InterpDeleted(consoleInterp)) {
+ Tcl_DeleteInterp(consoleInterp);
+ }
+ return TCL_ERROR;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ConsoleOutput--
+ *
+ * Writes the given output on the IO channel. Returns count of how many
+ * characters were actually written, and an error indication.
+ *
+ * Results:
+ * A count of how many characters were written is returned and an error
+ * indication is returned in an output argument.
+ *
+ * Side effects:
+ * Writes output on the actual channel.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+ConsoleOutput(
+ ClientData instanceData, /* Indicates which device to use. */
+ const char *buf, /* The data buffer. */
+ int toWrite, /* How many bytes to write? */
+ int *errorCode) /* Where to store error code. */
+{
+ ChannelData *data = instanceData;
+ ConsoleInfo *info = data->info;
+
+ *errorCode = 0;
+ Tcl_SetErrno(0);
+
+ if (info) {
+ Tcl_Interp *consoleInterp = info->consoleInterp;
+
+ if (consoleInterp && !Tcl_InterpDeleted(consoleInterp)) {
+ Tcl_DString ds;
+ Tcl_Encoding utf8 = Tcl_GetEncoding(NULL, "utf-8");
+
+ /*
+ * Not checking for utf8 == NULL. Did not check for TCL_ERROR
+ * from Tcl_SetChannelOption() in Tk_InitConsoleChannels() either.
+ * Assumption is utf-8 Tcl_Encoding is reliably present.
+ */
+
+ const char *bytes
+ = Tcl_ExternalToUtfDString(utf8, buf, toWrite, &ds);
+ int numBytes = Tcl_DStringLength(&ds);
+ Tcl_Obj *cmd = Tcl_NewStringObj("tk::ConsoleOutput", -1);
+
+ Tcl_FreeEncoding(utf8);
+
+ if (data->type == TCL_STDERR) {
+ Tcl_ListObjAppendElement(NULL, cmd,
+ Tcl_NewStringObj("stderr", -1));
+ } else {
+ Tcl_ListObjAppendElement(NULL, cmd,
+ Tcl_NewStringObj("stdout", -1));
+ }
+ Tcl_ListObjAppendElement(NULL, cmd,
+ Tcl_NewStringObj(bytes, numBytes));
+
+ Tcl_DStringFree(&ds);
+ Tcl_IncrRefCount(cmd);
+ Tcl_EvalObjEx(consoleInterp, cmd, TCL_EVAL_GLOBAL);
+ Tcl_DecrRefCount(cmd);
+ }
+ }
+ return toWrite;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ConsoleInput --
+ *
+ * Read input from the console. Not currently implemented.
+ *
+ * Results:
+ * Always returns EOF.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+ /* ARGSUSED */
+static int
+ConsoleInput(
+ ClientData instanceData, /* Unused. */
+ char *buf, /* Where to store data read. */
+ int bufSize, /* How much space is available in the
+ * buffer? */
+ int *errorCode) /* Where to store error code. */
+{
+ return 0; /* Always return EOF. */
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ConsoleClose --
+ *
+ * Closes the IO channel.
+ *
+ * Results:
+ * Always returns 0 (success).
+ *
+ * Side effects:
+ * Frees the dummy file associated with the channel.
+ *
+ *----------------------------------------------------------------------
+ */
+
+ /* ARGSUSED */
+static int
+ConsoleClose(
+ ClientData instanceData, /* Unused. */
+ Tcl_Interp *interp) /* Unused. */
+{
+ ChannelData *data = instanceData;
+ ConsoleInfo *info = data->info;
+
+ if (info) {
+ if (--info->refCount <= 0) {
+ /*
+ * Assuming the Tcl_Interp * fields must already be NULL.
+ */
+
+ ckfree(info);
+ }
+ }
+ ckfree(data);
+ return 0;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ConsoleWatch --
+ *
+ * Called by the notifier to set up the console device so that events
+ * will be noticed. Since there are no events on the console, this
+ * routine just returns without doing anything.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+ /* ARGSUSED */
+static void
+ConsoleWatch(
+ ClientData instanceData, /* Device ID for the channel. */
+ int mask) /* OR-ed combination of TCL_READABLE,
+ * TCL_WRITABLE and TCL_EXCEPTION, for the
+ * events we are interested in. */
+{
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ConsoleHandle --
+ *
+ * Invoked by the generic IO layer to get a handle from a channel.
+ * Because console channels are not devices, this function always fails.
+ *
+ * Results:
+ * Always returns TCL_ERROR.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+ /* ARGSUSED */
+static int
+ConsoleHandle(
+ ClientData instanceData, /* Device ID for the channel. */
+ int direction, /* TCL_READABLE or TCL_WRITABLE to indicate
+ * which direction of the channel is being
+ * requested. */
+ ClientData *handlePtr) /* Where to store handle */
+{
+ return TCL_ERROR;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ConsoleObjCmd --
+ *
+ * The console command implements a Tcl interface to the various console
+ * options.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * See the user documentation.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+ConsoleObjCmd(
+ ClientData clientData, /* Access to the console interp */
+ Tcl_Interp *interp, /* Current interpreter */
+ int objc, /* Number of arguments */
+ Tcl_Obj *const objv[]) /* Argument objects */
+{
+ int index, result;
+ static const char *const options[] = {
+ "eval", "hide", "show", "title", NULL};
+ enum option {CON_EVAL, CON_HIDE, CON_SHOW, CON_TITLE};
+ Tcl_Obj *cmd = NULL;
+ ConsoleInfo *info = clientData;
+ Tcl_Interp *consoleInterp = info->consoleInterp;
+
+ if (objc < 2) {
+ Tcl_WrongNumArgs(interp, 1, objv, "option ?arg?");
+ return TCL_ERROR;
+ }
+ if (Tcl_GetIndexFromObjStruct(interp, objv[1], options,
+ sizeof(char *), "option", 0, &index) != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ switch ((enum option) index) {
+ case CON_EVAL:
+ if (objc != 3) {
+ Tcl_WrongNumArgs(interp, 2, objv, "script");
+ return TCL_ERROR;
+ }
+ cmd = objv[2];
+ break;
+ case CON_HIDE:
+ if (objc != 2) {
+ Tcl_WrongNumArgs(interp, 2, objv, NULL);
+ return TCL_ERROR;
+ }
+ cmd = Tcl_NewStringObj("wm withdraw .", -1);
+ break;
+ case CON_SHOW:
+ if (objc != 2) {
+ Tcl_WrongNumArgs(interp, 2, objv, NULL);
+ return TCL_ERROR;
+ }
+ cmd = Tcl_NewStringObj("wm deiconify .", -1);
+ break;
+ case CON_TITLE:
+ if (objc > 3) {
+ Tcl_WrongNumArgs(interp, 2, objv, "?title?");
+ return TCL_ERROR;
+ }
+ cmd = Tcl_NewStringObj("wm title .", -1);
+ if (objc == 3) {
+ Tcl_ListObjAppendElement(NULL, cmd, objv[2]);
+ }
+ break;
+ default:
+ CLANG_ASSERT(0);
+ }
+
+ Tcl_IncrRefCount(cmd);
+ if (consoleInterp && !Tcl_InterpDeleted(consoleInterp)) {
+ Tcl_Preserve(consoleInterp);
+ result = Tcl_EvalObjEx(consoleInterp, cmd, TCL_EVAL_GLOBAL);
+ Tcl_SetReturnOptions(interp,
+ Tcl_GetReturnOptions(consoleInterp, result));
+ Tcl_SetObjResult(interp, Tcl_GetObjResult(consoleInterp));
+ Tcl_Release(consoleInterp);
+ } else {
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "no active console interp", -1));
+ Tcl_SetErrorCode(interp, "TK", "CONSOLE", "NONE", NULL);
+ result = TCL_ERROR;
+ }
+ Tcl_DecrRefCount(cmd);
+ return result;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * InterpreterObjCmd --
+ *
+ * This command allows the console interp to communicate with the main
+ * interpreter.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+InterpreterObjCmd(
+ ClientData clientData, /* */
+ Tcl_Interp *interp, /* Current interpreter */
+ int objc, /* Number of arguments */
+ Tcl_Obj *const objv[]) /* Argument objects */
+{
+ int index, result = TCL_OK;
+ static const char *const options[] = {"eval", "record", NULL};
+ enum option {OTHER_EVAL, OTHER_RECORD};
+ ConsoleInfo *info = clientData;
+ Tcl_Interp *otherInterp = info->interp;
+
+ if (objc < 2) {
+ Tcl_WrongNumArgs(interp, 1, objv, "option arg");
+ return TCL_ERROR;
+ }
+ if (Tcl_GetIndexFromObjStruct(interp, objv[1], options,
+ sizeof(char *), "option", 0, &index) != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ if (objc != 3) {
+ Tcl_WrongNumArgs(interp, 2, objv, "script");
+ return TCL_ERROR;
+ }
+
+ if ((otherInterp == NULL) || Tcl_InterpDeleted(otherInterp)) {
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "no active master interp", -1));
+ Tcl_SetErrorCode(interp, "TK", "CONSOLE", "NO_INTERP", NULL);
+ return TCL_ERROR;
+ }
+
+ Tcl_Preserve(otherInterp);
+ switch ((enum option) index) {
+ case OTHER_EVAL:
+ result = Tcl_EvalObjEx(otherInterp, objv[2], TCL_EVAL_GLOBAL);
+
+ /*
+ * TODO: Should exceptions be filtered here?
+ */
+
+ Tcl_SetReturnOptions(interp,
+ Tcl_GetReturnOptions(otherInterp, result));
+ Tcl_SetObjResult(interp, Tcl_GetObjResult(otherInterp));
+ break;
+ case OTHER_RECORD:
+ Tcl_RecordAndEvalObj(otherInterp, objv[2], TCL_EVAL_GLOBAL);
+
+ /*
+ * By not setting result, we discard any exceptions or errors here and
+ * always return TCL_OK. All the caller wants is the interp result to
+ * display, whether that's result or error message.
+ */
+
+ Tcl_SetObjResult(interp, Tcl_GetObjResult(otherInterp));
+ break;
+ }
+ Tcl_Release(otherInterp);
+ return result;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * DeleteConsoleInterp --
+ *
+ * Thread exit handler to destroy a console interp when the thread it
+ * lives in gets torn down.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+DeleteConsoleInterp(
+ ClientData clientData)
+{
+ Tcl_Interp *interp = clientData;
+
+ Tcl_DeleteInterp(interp);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * InterpDeleteProc --
+ *
+ * React when the interp in which the console is displayed is deleted for
+ * any reason.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * A new console it created.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+InterpDeleteProc(
+ ClientData clientData,
+ Tcl_Interp *interp)
+{
+ ConsoleInfo *info = clientData;
+
+ if (info->consoleInterp == interp) {
+ Tcl_DeleteThreadExitHandler(DeleteConsoleInterp, info->consoleInterp);
+ info->consoleInterp = NULL;
+ }
+ if (--info->refCount <= 0) {
+ ckfree(info);
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ConsoleDeleteProc --
+ *
+ * If the console command is deleted we destroy the console window and
+ * all associated data structures.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * A new console it created.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+ConsoleDeleteProc(
+ ClientData clientData)
+{
+ ConsoleInfo *info = clientData;
+
+ if (info->consoleInterp) {
+ Tcl_DeleteInterp(info->consoleInterp);
+ }
+ if (--info->refCount <= 0) {
+ ckfree(info);
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ConsoleEventProc --
+ *
+ * This event function is registered on the main window of the slave
+ * interpreter. If the user or a running script causes the main window to
+ * be destroyed, then we need to inform the console interpreter by
+ * invoking "::tk::ConsoleExit".
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Invokes the "::tk::ConsoleExit" command in the console interp.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+ConsoleEventProc(
+ ClientData clientData,
+ XEvent *eventPtr)
+{
+ if (eventPtr->type == DestroyNotify) {
+ ConsoleInfo *info = clientData;
+ Tcl_Interp *consoleInterp = info->consoleInterp;
+
+ if (consoleInterp && !Tcl_InterpDeleted(consoleInterp)) {
+ Tcl_EvalEx(consoleInterp, "tk::ConsoleExit", -1, TCL_EVAL_GLOBAL);
+ }
+
+ if (--info->refCount <= 0) {
+ ckfree(info);
+ }
+ }
+}
+
+/*
+ * Local Variables:
+ * mode: c
+ * c-basic-offset: 4
+ * fill-column: 78
+ * End:
+ */
diff --git a/tk8.6/generic/tkCursor.c b/tk8.6/generic/tkCursor.c
new file mode 100644
index 0000000..6b2d5f4
--- /dev/null
+++ b/tk8.6/generic/tkCursor.c
@@ -0,0 +1,882 @@
+/*
+ * tkCursor.c --
+ *
+ * This file maintains a database of read-only cursors for the Tk
+ * toolkit. This allows cursors to be shared between widgets and also
+ * avoids round-trips to the X server.
+ *
+ * Copyright (c) 1990-1994 The Regents of the University of California.
+ * Copyright (c) 1994-1997 Sun Microsystems, Inc.
+ *
+ * See the file "license.terms" for information on usage and redistribution of
+ * this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ */
+
+#include "tkInt.h"
+
+/*
+ * A TkCursor structure exists for each cursor that is currently active. Each
+ * structure is indexed with two hash tables defined below. One of the tables
+ * is cursorIdTable, and the other is either cursorNameTable or
+ * cursorDataTable, each of which are stored in the TkDisplay structure for
+ * the current thread.
+ */
+
+typedef struct {
+ const char *source; /* Cursor bits. */
+ const char *mask; /* Mask bits. */
+ int width, height; /* Dimensions of cursor (and data and
+ * mask). */
+ int xHot, yHot; /* Location of cursor hot-spot. */
+ Tk_Uid fg, bg; /* Colors for cursor. */
+ Display *display; /* Display on which cursor will be used. */
+} DataKey;
+
+/*
+ * Forward declarations for functions defined in this file:
+ */
+
+static void CursorInit(TkDisplay *dispPtr);
+static void DupCursorObjProc(Tcl_Obj *srcObjPtr,
+ Tcl_Obj *dupObjPtr);
+static void FreeCursor(TkCursor *cursorPtr);
+static void FreeCursorObj(Tcl_Obj *objPtr);
+static void FreeCursorObjProc(Tcl_Obj *objPtr);
+static TkCursor * TkcGetCursor(Tcl_Interp *interp, Tk_Window tkwin,
+ const char *name);
+static TkCursor * GetCursorFromObj(Tk_Window tkwin, Tcl_Obj *objPtr);
+static void InitCursorObj(Tcl_Obj *objPtr);
+
+/*
+ * The following structure defines the implementation of the "cursor" Tcl
+ * object, used for drawing. The color object remembers the hash table
+ * entry associated with a color. The actual allocation and deallocation
+ * of the color should be done by the configuration package when the cursor
+ * option is set.
+ */
+
+Tcl_ObjType const tkCursorObjType = {
+ "cursor", /* name */
+ FreeCursorObjProc, /* freeIntRepProc */
+ DupCursorObjProc, /* dupIntRepProc */
+ NULL, /* updateStringProc */
+ NULL /* setFromAnyProc */
+};
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_AllocCursorFromObj --
+ *
+ * Given a Tcl_Obj *, map the value to a corresponding Tk_Cursor
+ * structure based on the tkwin given.
+ *
+ * Results:
+ * The return value is the X identifer for the desired cursor, unless
+ * objPtr couldn't be parsed correctly. In this case, None is returned
+ * and an error message is left in the interp's result. The caller should
+ * never modify the cursor that is returned, and should eventually call
+ * Tk_FreeCursorFromObj when the cursor is no longer needed.
+ *
+ * Side effects:
+ * The cursor is added to an internal database with a reference count.
+ * For each call to this function, there should eventually be a call to
+ * Tk_FreeCursorFromObj, so that the database can be cleaned up when
+ * cursors aren't needed anymore.
+ *
+ *----------------------------------------------------------------------
+ */
+
+Tk_Cursor
+Tk_AllocCursorFromObj(
+ Tcl_Interp *interp, /* Interp for error results. */
+ Tk_Window tkwin, /* Window in which the cursor will be used.*/
+ Tcl_Obj *objPtr) /* Object describing cursor; see manual entry
+ * for description of legal syntax of this
+ * obj's string rep. */
+{
+ TkCursor *cursorPtr;
+
+ if (objPtr->typePtr != &tkCursorObjType) {
+ InitCursorObj(objPtr);
+ }
+ cursorPtr = 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.
+ */
+
+ FreeCursorObj(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 = Tcl_GetHashValue(cursorPtr->hashPtr);
+
+ FreeCursorObj(objPtr);
+ for (cursorPtr = firstCursorPtr; cursorPtr != NULL;
+ cursorPtr = cursorPtr->nextPtr) {
+ if (Tk_Display(tkwin) == cursorPtr->display) {
+ cursorPtr->resourceRefCount++;
+ cursorPtr->objRefCount++;
+ objPtr->internalRep.twoPtrValue.ptr1 = cursorPtr;
+ return cursorPtr->cursor;
+ }
+ }
+ }
+
+ /*
+ * Still no luck. Call TkcGetCursor to allocate a new TkCursor object.
+ */
+
+ cursorPtr = TkcGetCursor(interp, tkwin, Tcl_GetString(objPtr));
+ objPtr->internalRep.twoPtrValue.ptr1 = cursorPtr;
+ if (cursorPtr == NULL) {
+ return None;
+ }
+ cursorPtr->objRefCount++;
+ return cursorPtr->cursor;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_GetCursor --
+ *
+ * Given a string describing a cursor, locate (or create if necessary) a
+ * cursor that fits the description.
+ *
+ * Results:
+ * The return value is the X identifer for the desired cursor, unless
+ * string couldn't be parsed correctly. In this case, None is returned
+ * and an error message is left in the interp's result. The caller should
+ * never modify the cursor that is returned, and should eventually call
+ * Tk_FreeCursor when the cursor is no longer needed.
+ *
+ * Side effects:
+ * The cursor is added to an internal database with a reference count.
+ * For each call to this function, there should eventually be a call to
+ * Tk_FreeCursor, so that the database can be cleaned up when cursors
+ * aren't needed anymore.
+ *
+ *----------------------------------------------------------------------
+ */
+
+Tk_Cursor
+Tk_GetCursor(
+ Tcl_Interp *interp, /* Interpreter to use for error reporting. */
+ Tk_Window tkwin, /* Window in which cursor will be used. */
+ Tk_Uid string) /* Description of cursor. See manual entry for
+ * details on legal syntax. */
+{
+ TkCursor *cursorPtr = TkcGetCursor(interp, tkwin, string);
+
+ if (cursorPtr == NULL) {
+ return None;
+ }
+ return cursorPtr->cursor;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkcGetCursor --
+ *
+ * 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 function, 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 *
+TkcGetCursor(
+ Tcl_Interp *interp, /* Interpreter to use for error reporting. */
+ Tk_Window tkwin, /* Window in which cursor will be used. */
+ const char *string) /* Description of cursor. See manual entry for
+ * details on legal syntax. */
+{
+ Tcl_HashEntry *nameHashPtr;
+ register TkCursor *cursorPtr;
+ TkCursor *existingCursorPtr = NULL;
+ int isNew;
+ TkDisplay *dispPtr = ((TkWindow *) tkwin)->dispPtr;
+
+ if (!dispPtr->cursorInit) {
+ CursorInit(dispPtr);
+ }
+
+ nameHashPtr = Tcl_CreateHashEntry(&dispPtr->cursorNameTable,
+ string, &isNew);
+ if (!isNew) {
+ existingCursorPtr = Tcl_GetHashValue(nameHashPtr);
+ for (cursorPtr = existingCursorPtr; cursorPtr != NULL;
+ cursorPtr = cursorPtr->nextPtr) {
+ if (Tk_Display(tkwin) == cursorPtr->display) {
+ cursorPtr->resourceRefCount++;
+ return cursorPtr;
+ }
+ }
+ } else {
+ existingCursorPtr = NULL;
+ }
+
+ cursorPtr = TkGetCursorByName(interp, tkwin, string);
+
+ if (cursorPtr == NULL) {
+ if (isNew) {
+ Tcl_DeleteHashEntry(nameHashPtr);
+ }
+ return NULL;
+ }
+
+ /*
+ * Add information about this cursor to our database.
+ */
+
+ cursorPtr->display = Tk_Display(tkwin);
+ cursorPtr->resourceRefCount = 1;
+ cursorPtr->objRefCount = 0;
+ cursorPtr->otherTable = &dispPtr->cursorNameTable;
+ cursorPtr->hashPtr = nameHashPtr;
+ cursorPtr->nextPtr = existingCursorPtr;
+ cursorPtr->idHashPtr = Tcl_CreateHashEntry(&dispPtr->cursorIdTable,
+ (char *) cursorPtr->cursor, &isNew);
+ if (!isNew) {
+ Tcl_Panic("cursor already registered in Tk_GetCursor");
+ }
+ Tcl_SetHashValue(nameHashPtr, cursorPtr);
+ Tcl_SetHashValue(cursorPtr->idHashPtr, cursorPtr);
+
+ return cursorPtr;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_GetCursorFromData --
+ *
+ * Given a description of the bits and colors for a cursor, make a cursor
+ * that has the given properties.
+ *
+ * Results:
+ * The return value is the X identifer for the desired cursor, unless it
+ * couldn't be created properly. In this case, None is returned and an
+ * error message is left in the interp's result. The caller should never
+ * modify the cursor that is returned, and should eventually call
+ * Tk_FreeCursor when the cursor is no longer needed.
+ *
+ * Side effects:
+ * The cursor is added to an internal database with a reference count.
+ * For each call to this function, there should eventually be a call to
+ * Tk_FreeCursor, so that the database can be cleaned up when cursors
+ * aren't needed anymore.
+ *
+ *----------------------------------------------------------------------
+ */
+
+Tk_Cursor
+Tk_GetCursorFromData(
+ Tcl_Interp *interp, /* Interpreter to use for error reporting. */
+ Tk_Window tkwin, /* Window in which cursor will be used. */
+ const char *source, /* Bitmap data for cursor shape. */
+ const char *mask, /* Bitmap data for cursor mask. */
+ int width, int height, /* Dimensions of cursor. */
+ int xHot, int yHot, /* Location of hot-spot in cursor. */
+ Tk_Uid fg, /* Foreground color for cursor. */
+ Tk_Uid bg) /* Background color for cursor. */
+{
+ DataKey dataKey;
+ Tcl_HashEntry *dataHashPtr;
+ register TkCursor *cursorPtr;
+ int isNew;
+ XColor fgColor, bgColor;
+ TkDisplay *dispPtr = ((TkWindow *) tkwin)->dispPtr;
+
+ if (!dispPtr->cursorInit) {
+ CursorInit(dispPtr);
+ }
+
+ dataKey.source = source;
+ dataKey.mask = mask;
+ dataKey.width = width;
+ dataKey.height = height;
+ dataKey.xHot = xHot;
+ dataKey.yHot = yHot;
+ dataKey.fg = fg;
+ dataKey.bg = bg;
+ dataKey.display = Tk_Display(tkwin);
+ dataHashPtr = Tcl_CreateHashEntry(&dispPtr->cursorDataTable,
+ (char *) &dataKey, &isNew);
+ if (!isNew) {
+ cursorPtr = Tcl_GetHashValue(dataHashPtr);
+ cursorPtr->resourceRefCount++;
+ return cursorPtr->cursor;
+ }
+
+ /*
+ * No suitable cursor exists yet. Make one using the data available and
+ * add it to the database.
+ */
+
+ if (TkParseColor(dataKey.display, Tk_Colormap(tkwin), fg, &fgColor) == 0) {
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "invalid color name \"%s\"", fg));
+ Tcl_SetErrorCode(interp, "TK", "VALUE", "CURSOR", "COLOR", NULL);
+ goto error;
+ }
+ if (TkParseColor(dataKey.display, Tk_Colormap(tkwin), bg, &bgColor) == 0) {
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "invalid color name \"%s\"", bg));
+ Tcl_SetErrorCode(interp, "TK", "VALUE", "CURSOR", "COLOR", NULL);
+ goto error;
+ }
+
+ cursorPtr = TkCreateCursorFromData(tkwin, source, mask, width, height,
+ xHot, yHot, fgColor, bgColor);
+
+ if (cursorPtr == NULL) {
+ goto error;
+ }
+
+ cursorPtr->resourceRefCount = 1;
+ cursorPtr->otherTable = &dispPtr->cursorDataTable;
+ cursorPtr->hashPtr = dataHashPtr;
+ cursorPtr->objRefCount = 0;
+ cursorPtr->idHashPtr = Tcl_CreateHashEntry(&dispPtr->cursorIdTable,
+ (char *) cursorPtr->cursor, &isNew);
+ cursorPtr->nextPtr = NULL;
+
+ if (!isNew) {
+ Tcl_Panic("cursor already registered in Tk_GetCursorFromData");
+ }
+ Tcl_SetHashValue(dataHashPtr, cursorPtr);
+ Tcl_SetHashValue(cursorPtr->idHashPtr, cursorPtr);
+ return cursorPtr->cursor;
+
+ error:
+ Tcl_DeleteHashEntry(dataHashPtr);
+ return None;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * Tk_NameOfCursor --
+ *
+ * Given a cursor, return a textual string identifying it.
+ *
+ * Results:
+ * If cursor was created by Tk_GetCursor, then the return value is the
+ * "string" that was used to create it. Otherwise the return value is a
+ * string giving the X identifier for the cursor. The storage for the
+ * returned string is only guaranteed to persist up until the next call
+ * to this function.
+ *
+ * Side effects:
+ * None.
+ *
+ *--------------------------------------------------------------
+ */
+
+const char *
+Tk_NameOfCursor(
+ Display *display, /* Display for which cursor was allocated. */
+ Tk_Cursor cursor) /* Identifier for cursor whose name is
+ * wanted. */
+{
+ Tcl_HashEntry *idHashPtr;
+ TkCursor *cursorPtr;
+ TkDisplay *dispPtr;
+
+ dispPtr = TkGetDisplay(display);
+
+ if (!dispPtr->cursorInit) {
+ printid:
+ sprintf(dispPtr->cursorString, "cursor id %p", cursor);
+ return dispPtr->cursorString;
+ }
+ idHashPtr = Tcl_FindHashEntry(&dispPtr->cursorIdTable, (char *) cursor);
+ if (idHashPtr == NULL) {
+ goto printid;
+ }
+ cursorPtr = Tcl_GetHashValue(idHashPtr);
+ if (cursorPtr->otherTable != &dispPtr->cursorNameTable) {
+ goto printid;
+ }
+ return cursorPtr->hashPtr->key.string;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * FreeCursor --
+ *
+ * This function is invoked by both Tk_FreeCursorFromObj and
+ * Tk_FreeCursor; 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(
+ TkCursor *cursorPtr) /* Cursor to be released. */
+{
+ TkCursor *prevPtr;
+
+ cursorPtr->resourceRefCount--;
+ if (cursorPtr->resourceRefCount > 0) {
+ return;
+ }
+
+ Tcl_DeleteHashEntry(cursorPtr->idHashPtr);
+ prevPtr = 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(cursorPtr);
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_FreeCursor --
+ *
+ * This function is called to release a cursor allocated by Tk_GetCursor
+ * or TkGetCursorFromData.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The reference count associated with cursor is decremented, and it is
+ * officially deallocated if no-one is using it anymore.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tk_FreeCursor(
+ Display *display, /* Display for which cursor was allocated. */
+ Tk_Cursor cursor) /* Identifier for cursor to be released. */
+{
+ Tcl_HashEntry *idHashPtr;
+ TkDisplay *dispPtr = TkGetDisplay(display);
+
+ if (!dispPtr->cursorInit) {
+ Tcl_Panic("Tk_FreeCursor called before Tk_GetCursor");
+ }
+
+ idHashPtr = Tcl_FindHashEntry(&dispPtr->cursorIdTable, (char *) cursor);
+ if (idHashPtr == NULL) {
+ Tcl_Panic("Tk_FreeCursor received unknown cursor argument");
+ }
+ FreeCursor(Tcl_GetHashValue(idHashPtr));
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_FreeCursorFromObj --
+ *
+ * This function 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(
+ 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));
+ FreeCursorObj(objPtr);
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * FreeCursorObjProc, FreeCursorObj --
+ *
+ * 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(
+ Tcl_Obj *objPtr) /* The object we are releasing. */
+{
+ FreeCursorObj(objPtr);
+ objPtr->typePtr = NULL;
+}
+
+static void
+FreeCursorObj(
+ Tcl_Obj *objPtr) /* The object we are releasing. */
+{
+ TkCursor *cursorPtr = objPtr->internalRep.twoPtrValue.ptr1;
+
+ if (cursorPtr != NULL) {
+ cursorPtr->objRefCount--;
+ if ((cursorPtr->objRefCount == 0)
+ && (cursorPtr->resourceRefCount == 0)) {
+ ckfree(cursorPtr);
+ }
+ objPtr->internalRep.twoPtrValue.ptr1 = 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(
+ Tcl_Obj *srcObjPtr, /* The object we are copying from. */
+ Tcl_Obj *dupObjPtr) /* The object we are copying to. */
+{
+ TkCursor *cursorPtr = srcObjPtr->internalRep.twoPtrValue.ptr1;
+
+ dupObjPtr->typePtr = srcObjPtr->typePtr;
+ dupObjPtr->internalRep.twoPtrValue.ptr1 = 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(
+ 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(
+ Tk_Window tkwin, /* Window in which the cursor will be used. */
+ Tcl_Obj *objPtr) /* The object that describes the desired
+ * cursor. */
+{
+ TkCursor *cursorPtr;
+ Tcl_HashEntry *hashPtr;
+ TkDisplay *dispPtr = ((TkWindow *) tkwin)->dispPtr;
+
+ if (objPtr->typePtr != &tkCursorObjType) {
+ InitCursorObj(objPtr);
+ }
+
+ /*
+ * The internal representation is a cache of the last cursor used with the
+ * given name. But there can be lots different cursors for each cursor
+ * name; one cursor for each display. Check to see if the cursor we have
+ * cached is the one that is needed.
+ */
+
+ cursorPtr = 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 = Tcl_GetHashValue(hashPtr);
+ cursorPtr != NULL; cursorPtr = cursorPtr->nextPtr) {
+ if (Tk_Display(tkwin) == cursorPtr->display) {
+ FreeCursorObj(objPtr);
+ objPtr->internalRep.twoPtrValue.ptr1 = cursorPtr;
+ cursorPtr->objRefCount++;
+ return cursorPtr;
+ }
+ }
+
+ error:
+ Tcl_Panic("GetCursorFromObj called with non-existent cursor!");
+ /*
+ * The following code isn't reached; it's just there to please compilers.
+ */
+ return NULL;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * InitCursorObj --
+ *
+ * Bookeeping function 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(
+ Tcl_Obj *objPtr) /* The object to convert. */
+{
+ const Tcl_ObjType *typePtr;
+
+ /*
+ * Free the old internalRep before setting the new one.
+ */
+
+ Tcl_GetString(objPtr);
+ typePtr = objPtr->typePtr;
+ if ((typePtr != NULL) && (typePtr->freeIntRepProc != NULL)) {
+ typePtr->freeIntRepProc(objPtr);
+ }
+ objPtr->typePtr = &tkCursorObjType;
+ objPtr->internalRep.twoPtrValue.ptr1 = NULL;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * CursorInit --
+ *
+ * Initialize the structures used for cursor management.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Read the code.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+CursorInit(
+ TkDisplay *dispPtr) /* Display used to store thread-specific
+ * data. */
+{
+ Tcl_InitHashTable(&dispPtr->cursorNameTable, TCL_STRING_KEYS);
+ Tcl_InitHashTable(&dispPtr->cursorDataTable, sizeof(DataKey)/sizeof(int));
+
+ /*
+ * The call below is tricky: can't use sizeof(IdKey) because it gets
+ * padded with extra unpredictable bytes on some 64-bit machines.
+ */
+
+ /*
+ * Old code....
+ * Tcl_InitHashTable(&dispPtr->cursorIdTable, sizeof(Display *)
+ * /sizeof(int));
+ *
+ * The comment above doesn't make sense. However, XIDs should only be 32
+ * bits, by the definition of X, so the code above causes Tk to crash.
+ * Here is the real code:
+ */
+
+ Tcl_InitHashTable(&dispPtr->cursorIdTable, TCL_ONE_WORD_KEYS);
+
+ dispPtr->cursorInit = 1;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkDebugCursor --
+ *
+ * This function 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(
+ Tk_Window tkwin, /* The window in which the cursor will be used
+ * (not currently used). */
+ const char *name) /* Name of the desired color. */
+{
+ TkCursor *cursorPtr;
+ Tcl_HashEntry *hashPtr;
+ Tcl_Obj *resultPtr, *objPtr;
+ TkDisplay *dispPtr = ((TkWindow *) tkwin)->dispPtr;
+
+ if (!dispPtr->cursorInit) {
+ CursorInit(dispPtr);
+ }
+ resultPtr = Tcl_NewObj();
+ hashPtr = Tcl_FindHashEntry(&dispPtr->cursorNameTable, name);
+ if (hashPtr != NULL) {
+ cursorPtr = Tcl_GetHashValue(hashPtr);
+ if (cursorPtr == NULL) {
+ Tcl_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;
+}
+
+/*
+ * Local Variables:
+ * mode: c
+ * c-basic-offset: 4
+ * fill-column: 78
+ * End:
+ */
diff --git a/tk8.6/generic/tkDecls.h b/tk8.6/generic/tkDecls.h
new file mode 100644
index 0000000..64c32cd
--- /dev/null
+++ b/tk8.6/generic/tkDecls.h
@@ -0,0 +1,1733 @@
+/*
+ * 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.
+ */
+
+#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. */
+
+#ifdef __cplusplus
+extern "C" {
+#endif
+
+/*
+ * Exported function declarations:
+ */
+
+/* 0 */
+EXTERN void Tk_MainLoop(void);
+/* 1 */
+EXTERN XColor * Tk_3DBorderColor(Tk_3DBorder border);
+/* 2 */
+EXTERN GC Tk_3DBorderGC(Tk_Window tkwin, Tk_3DBorder border,
+ int which);
+/* 3 */
+EXTERN 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);
+/* 4 */
+EXTERN void Tk_3DVerticalBevel(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(Tk_Window tkwin, const char *name,
+ const char *value, int priority);
+/* 6 */
+EXTERN void Tk_BindEvent(Tk_BindingTable bindingTable,
+ XEvent *eventPtr, Tk_Window tkwin,
+ int numObjects, ClientData *objectPtr);
+/* 7 */
+EXTERN void Tk_CanvasDrawableCoords(Tk_Canvas canvas, double x,
+ double y, short *drawableXPtr,
+ short *drawableYPtr);
+/* 8 */
+EXTERN void Tk_CanvasEventuallyRedraw(Tk_Canvas canvas, int x1,
+ int y1, int x2, int y2);
+/* 9 */
+EXTERN int Tk_CanvasGetCoord(Tcl_Interp *interp,
+ Tk_Canvas canvas, const char *str,
+ double *doublePtr);
+/* 10 */
+EXTERN Tk_CanvasTextInfo * Tk_CanvasGetTextInfo(Tk_Canvas canvas);
+/* 11 */
+EXTERN int Tk_CanvasPsBitmap(Tcl_Interp *interp,
+ Tk_Canvas canvas, Pixmap bitmap, int x,
+ int y, int width, int height);
+/* 12 */
+EXTERN int Tk_CanvasPsColor(Tcl_Interp *interp,
+ Tk_Canvas canvas, XColor *colorPtr);
+/* 13 */
+EXTERN int Tk_CanvasPsFont(Tcl_Interp *interp, Tk_Canvas canvas,
+ Tk_Font font);
+/* 14 */
+EXTERN void Tk_CanvasPsPath(Tcl_Interp *interp, Tk_Canvas canvas,
+ double *coordPtr, int numPoints);
+/* 15 */
+EXTERN int Tk_CanvasPsStipple(Tcl_Interp *interp,
+ Tk_Canvas canvas, Pixmap bitmap);
+/* 16 */
+EXTERN double Tk_CanvasPsY(Tk_Canvas canvas, double y);
+/* 17 */
+EXTERN void Tk_CanvasSetStippleOrigin(Tk_Canvas canvas, GC gc);
+/* 18 */
+EXTERN int Tk_CanvasTagsParseProc(ClientData clientData,
+ Tcl_Interp *interp, Tk_Window tkwin,
+ const char *value, char *widgRec, int offset);
+/* 19 */
+EXTERN CONST86 char * Tk_CanvasTagsPrintProc(ClientData clientData,
+ Tk_Window tkwin, char *widgRec, int offset,
+ Tcl_FreeProc **freeProcPtr);
+/* 20 */
+EXTERN Tk_Window Tk_CanvasTkwin(Tk_Canvas canvas);
+/* 21 */
+EXTERN void Tk_CanvasWindowCoords(Tk_Canvas canvas, double x,
+ double y, short *screenXPtr,
+ short *screenYPtr);
+/* 22 */
+EXTERN void Tk_ChangeWindowAttributes(Tk_Window tkwin,
+ unsigned long valueMask,
+ XSetWindowAttributes *attsPtr);
+/* 23 */
+EXTERN int Tk_CharBbox(Tk_TextLayout layout, int index,
+ int *xPtr, int *yPtr, int *widthPtr,
+ int *heightPtr);
+/* 24 */
+EXTERN void Tk_ClearSelection(Tk_Window tkwin, Atom selection);
+/* 25 */
+EXTERN int Tk_ClipboardAppend(Tcl_Interp *interp,
+ Tk_Window tkwin, Atom target, Atom format,
+ const char *buffer);
+/* 26 */
+EXTERN int Tk_ClipboardClear(Tcl_Interp *interp,
+ Tk_Window tkwin);
+/* 27 */
+EXTERN int Tk_ConfigureInfo(Tcl_Interp *interp, Tk_Window tkwin,
+ const Tk_ConfigSpec *specs, char *widgRec,
+ const char *argvName, int flags);
+/* 28 */
+EXTERN int Tk_ConfigureValue(Tcl_Interp *interp,
+ Tk_Window tkwin, const Tk_ConfigSpec *specs,
+ char *widgRec, const char *argvName,
+ int flags);
+/* 29 */
+EXTERN int Tk_ConfigureWidget(Tcl_Interp *interp,
+ Tk_Window tkwin, const Tk_ConfigSpec *specs,
+ int argc, CONST84 char **argv, char *widgRec,
+ int flags);
+/* 30 */
+EXTERN void Tk_ConfigureWindow(Tk_Window tkwin,
+ unsigned int valueMask,
+ XWindowChanges *valuePtr);
+/* 31 */
+EXTERN Tk_TextLayout Tk_ComputeTextLayout(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(int rootX, int rootY,
+ Tk_Window tkwin);
+/* 33 */
+EXTERN unsigned long Tk_CreateBinding(Tcl_Interp *interp,
+ Tk_BindingTable bindingTable,
+ ClientData object, const char *eventStr,
+ const char *script, int append);
+/* 34 */
+EXTERN Tk_BindingTable Tk_CreateBindingTable(Tcl_Interp *interp);
+/* 35 */
+EXTERN Tk_ErrorHandler Tk_CreateErrorHandler(Display *display, int errNum,
+ int request, int minorCode,
+ Tk_ErrorProc *errorProc,
+ ClientData clientData);
+/* 36 */
+EXTERN void Tk_CreateEventHandler(Tk_Window token,
+ unsigned long mask, Tk_EventProc *proc,
+ ClientData clientData);
+/* 37 */
+EXTERN void Tk_CreateGenericHandler(Tk_GenericProc *proc,
+ ClientData clientData);
+/* 38 */
+EXTERN void Tk_CreateImageType(const Tk_ImageType *typePtr);
+/* 39 */
+EXTERN void Tk_CreateItemType(Tk_ItemType *typePtr);
+/* 40 */
+EXTERN void Tk_CreatePhotoImageFormat(
+ const Tk_PhotoImageFormat *formatPtr);
+/* 41 */
+EXTERN void Tk_CreateSelHandler(Tk_Window tkwin, Atom selection,
+ Atom target, Tk_SelectionProc *proc,
+ ClientData clientData, Atom format);
+/* 42 */
+EXTERN Tk_Window Tk_CreateWindow(Tcl_Interp *interp, Tk_Window parent,
+ const char *name, const char *screenName);
+/* 43 */
+EXTERN Tk_Window Tk_CreateWindowFromPath(Tcl_Interp *interp,
+ Tk_Window tkwin, const char *pathName,
+ const char *screenName);
+/* 44 */
+EXTERN int Tk_DefineBitmap(Tcl_Interp *interp, const char *name,
+ const void *source, int width, int height);
+/* 45 */
+EXTERN void Tk_DefineCursor(Tk_Window window, Tk_Cursor cursor);
+/* 46 */
+EXTERN void Tk_DeleteAllBindings(Tk_BindingTable bindingTable,
+ ClientData object);
+/* 47 */
+EXTERN int Tk_DeleteBinding(Tcl_Interp *interp,
+ Tk_BindingTable bindingTable,
+ ClientData object, const char *eventStr);
+/* 48 */
+EXTERN void Tk_DeleteBindingTable(Tk_BindingTable bindingTable);
+/* 49 */
+EXTERN void Tk_DeleteErrorHandler(Tk_ErrorHandler handler);
+/* 50 */
+EXTERN void Tk_DeleteEventHandler(Tk_Window token,
+ unsigned long mask, Tk_EventProc *proc,
+ ClientData clientData);
+/* 51 */
+EXTERN void Tk_DeleteGenericHandler(Tk_GenericProc *proc,
+ ClientData clientData);
+/* 52 */
+EXTERN void Tk_DeleteImage(Tcl_Interp *interp, const char *name);
+/* 53 */
+EXTERN void Tk_DeleteSelHandler(Tk_Window tkwin, Atom selection,
+ Atom target);
+/* 54 */
+EXTERN void Tk_DestroyWindow(Tk_Window tkwin);
+/* 55 */
+EXTERN CONST84_RETURN char * Tk_DisplayName(Tk_Window tkwin);
+/* 56 */
+EXTERN int Tk_DistanceToTextLayout(Tk_TextLayout layout, int x,
+ int y);
+/* 57 */
+EXTERN void Tk_Draw3DPolygon(Tk_Window tkwin, Drawable drawable,
+ Tk_3DBorder border, XPoint *pointPtr,
+ int numPoints, int borderWidth,
+ int leftRelief);
+/* 58 */
+EXTERN void Tk_Draw3DRectangle(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(Display *display, Drawable drawable,
+ GC gc, Tk_Font tkfont, const char *source,
+ int numBytes, int x, int y);
+/* 60 */
+EXTERN void Tk_DrawFocusHighlight(Tk_Window tkwin, GC gc,
+ int width, Drawable drawable);
+/* 61 */
+EXTERN void Tk_DrawTextLayout(Display *display,
+ Drawable drawable, GC gc,
+ Tk_TextLayout layout, int x, int y,
+ int firstChar, int lastChar);
+/* 62 */
+EXTERN void Tk_Fill3DPolygon(Tk_Window tkwin, Drawable drawable,
+ Tk_3DBorder border, XPoint *pointPtr,
+ int numPoints, int borderWidth,
+ int leftRelief);
+/* 63 */
+EXTERN void Tk_Fill3DRectangle(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(Tcl_Interp *interp,
+ const char *imageName);
+/* 65 */
+EXTERN Font Tk_FontId(Tk_Font font);
+/* 66 */
+EXTERN void Tk_Free3DBorder(Tk_3DBorder border);
+/* 67 */
+EXTERN void Tk_FreeBitmap(Display *display, Pixmap bitmap);
+/* 68 */
+EXTERN void Tk_FreeColor(XColor *colorPtr);
+/* 69 */
+EXTERN void Tk_FreeColormap(Display *display, Colormap colormap);
+/* 70 */
+EXTERN void Tk_FreeCursor(Display *display, Tk_Cursor cursor);
+/* 71 */
+EXTERN void Tk_FreeFont(Tk_Font f);
+/* 72 */
+EXTERN void Tk_FreeGC(Display *display, GC gc);
+/* 73 */
+EXTERN void Tk_FreeImage(Tk_Image image);
+/* 74 */
+EXTERN void Tk_FreeOptions(const Tk_ConfigSpec *specs,
+ char *widgRec, Display *display,
+ int needFlags);
+/* 75 */
+EXTERN void Tk_FreePixmap(Display *display, Pixmap pixmap);
+/* 76 */
+EXTERN void Tk_FreeTextLayout(Tk_TextLayout textLayout);
+/* 77 */
+EXTERN void Tk_FreeXId(Display *display, XID xid);
+/* 78 */
+EXTERN GC Tk_GCForColor(XColor *colorPtr, Drawable drawable);
+/* 79 */
+EXTERN void Tk_GeometryRequest(Tk_Window tkwin, int reqWidth,
+ int reqHeight);
+/* 80 */
+EXTERN Tk_3DBorder Tk_Get3DBorder(Tcl_Interp *interp, Tk_Window tkwin,
+ Tk_Uid colorName);
+/* 81 */
+EXTERN void Tk_GetAllBindings(Tcl_Interp *interp,
+ Tk_BindingTable bindingTable,
+ ClientData object);
+/* 82 */
+EXTERN int Tk_GetAnchor(Tcl_Interp *interp, const char *str,
+ Tk_Anchor *anchorPtr);
+/* 83 */
+EXTERN CONST84_RETURN char * Tk_GetAtomName(Tk_Window tkwin, Atom atom);
+/* 84 */
+EXTERN CONST84_RETURN char * Tk_GetBinding(Tcl_Interp *interp,
+ Tk_BindingTable bindingTable,
+ ClientData object, const char *eventStr);
+/* 85 */
+EXTERN Pixmap Tk_GetBitmap(Tcl_Interp *interp, Tk_Window tkwin,
+ const char *str);
+/* 86 */
+EXTERN Pixmap Tk_GetBitmapFromData(Tcl_Interp *interp,
+ Tk_Window tkwin, const void *source,
+ int width, int height);
+/* 87 */
+EXTERN int Tk_GetCapStyle(Tcl_Interp *interp, const char *str,
+ int *capPtr);
+/* 88 */
+EXTERN XColor * Tk_GetColor(Tcl_Interp *interp, Tk_Window tkwin,
+ Tk_Uid name);
+/* 89 */
+EXTERN XColor * Tk_GetColorByValue(Tk_Window tkwin, XColor *colorPtr);
+/* 90 */
+EXTERN Colormap Tk_GetColormap(Tcl_Interp *interp, Tk_Window tkwin,
+ const char *str);
+/* 91 */
+EXTERN Tk_Cursor Tk_GetCursor(Tcl_Interp *interp, Tk_Window tkwin,
+ Tk_Uid str);
+/* 92 */
+EXTERN Tk_Cursor Tk_GetCursorFromData(Tcl_Interp *interp,
+ Tk_Window tkwin, const char *source,
+ const char *mask, int width, int height,
+ int xHot, int yHot, Tk_Uid fg, Tk_Uid bg);
+/* 93 */
+EXTERN Tk_Font Tk_GetFont(Tcl_Interp *interp, Tk_Window tkwin,
+ const char *str);
+/* 94 */
+EXTERN Tk_Font Tk_GetFontFromObj(Tk_Window tkwin, Tcl_Obj *objPtr);
+/* 95 */
+EXTERN void Tk_GetFontMetrics(Tk_Font font,
+ Tk_FontMetrics *fmPtr);
+/* 96 */
+EXTERN GC Tk_GetGC(Tk_Window tkwin, unsigned long valueMask,
+ XGCValues *valuePtr);
+/* 97 */
+EXTERN Tk_Image Tk_GetImage(Tcl_Interp *interp, Tk_Window tkwin,
+ const char *name,
+ Tk_ImageChangedProc *changeProc,
+ ClientData clientData);
+/* 98 */
+EXTERN ClientData Tk_GetImageMasterData(Tcl_Interp *interp,
+ const char *name,
+ CONST86 Tk_ImageType **typePtrPtr);
+/* 99 */
+EXTERN Tk_ItemType * Tk_GetItemTypes(void);
+/* 100 */
+EXTERN int Tk_GetJoinStyle(Tcl_Interp *interp, const char *str,
+ int *joinPtr);
+/* 101 */
+EXTERN int Tk_GetJustify(Tcl_Interp *interp, const char *str,
+ Tk_Justify *justifyPtr);
+/* 102 */
+EXTERN int Tk_GetNumMainWindows(void);
+/* 103 */
+EXTERN Tk_Uid Tk_GetOption(Tk_Window tkwin, const char *name,
+ const char *className);
+/* 104 */
+EXTERN int Tk_GetPixels(Tcl_Interp *interp, Tk_Window tkwin,
+ const char *str, int *intPtr);
+/* 105 */
+EXTERN Pixmap Tk_GetPixmap(Display *display, Drawable d, int width,
+ int height, int depth);
+/* 106 */
+EXTERN int Tk_GetRelief(Tcl_Interp *interp, const char *name,
+ int *reliefPtr);
+/* 107 */
+EXTERN void Tk_GetRootCoords(Tk_Window tkwin, int *xPtr,
+ int *yPtr);
+/* 108 */
+EXTERN int Tk_GetScrollInfo(Tcl_Interp *interp, int argc,
+ CONST84 char **argv, double *dblPtr,
+ int *intPtr);
+/* 109 */
+EXTERN int Tk_GetScreenMM(Tcl_Interp *interp, Tk_Window tkwin,
+ const char *str, double *doublePtr);
+/* 110 */
+EXTERN int Tk_GetSelection(Tcl_Interp *interp, Tk_Window tkwin,
+ Atom selection, Atom target,
+ Tk_GetSelProc *proc, ClientData clientData);
+/* 111 */
+EXTERN Tk_Uid Tk_GetUid(const char *str);
+/* 112 */
+EXTERN Visual * Tk_GetVisual(Tcl_Interp *interp, Tk_Window tkwin,
+ const char *str, int *depthPtr,
+ Colormap *colormapPtr);
+/* 113 */
+EXTERN void Tk_GetVRootGeometry(Tk_Window tkwin, int *xPtr,
+ int *yPtr, int *widthPtr, int *heightPtr);
+/* 114 */
+EXTERN int Tk_Grab(Tcl_Interp *interp, Tk_Window tkwin,
+ int grabGlobal);
+/* 115 */
+EXTERN void Tk_HandleEvent(XEvent *eventPtr);
+/* 116 */
+EXTERN Tk_Window Tk_IdToWindow(Display *display, Window window);
+/* 117 */
+EXTERN void Tk_ImageChanged(Tk_ImageMaster master, int x, int y,
+ int width, int height, int imageWidth,
+ int imageHeight);
+/* 118 */
+EXTERN int Tk_Init(Tcl_Interp *interp);
+/* 119 */
+EXTERN Atom Tk_InternAtom(Tk_Window tkwin, const char *name);
+/* 120 */
+EXTERN int Tk_IntersectTextLayout(Tk_TextLayout layout, int x,
+ int y, int width, int height);
+/* 121 */
+EXTERN void Tk_MaintainGeometry(Tk_Window slave,
+ Tk_Window master, int x, int y, int width,
+ int height);
+/* 122 */
+EXTERN Tk_Window Tk_MainWindow(Tcl_Interp *interp);
+/* 123 */
+EXTERN void Tk_MakeWindowExist(Tk_Window tkwin);
+/* 124 */
+EXTERN void Tk_ManageGeometry(Tk_Window tkwin,
+ const Tk_GeomMgr *mgrPtr,
+ ClientData clientData);
+/* 125 */
+EXTERN void Tk_MapWindow(Tk_Window tkwin);
+/* 126 */
+EXTERN int Tk_MeasureChars(Tk_Font tkfont, const char *source,
+ int numBytes, int maxPixels, int flags,
+ int *lengthPtr);
+/* 127 */
+EXTERN void Tk_MoveResizeWindow(Tk_Window tkwin, int x, int y,
+ int width, int height);
+/* 128 */
+EXTERN void Tk_MoveWindow(Tk_Window tkwin, int x, int y);
+/* 129 */
+EXTERN void Tk_MoveToplevelWindow(Tk_Window tkwin, int x, int y);
+/* 130 */
+EXTERN CONST84_RETURN char * Tk_NameOf3DBorder(Tk_3DBorder border);
+/* 131 */
+EXTERN CONST84_RETURN char * Tk_NameOfAnchor(Tk_Anchor anchor);
+/* 132 */
+EXTERN CONST84_RETURN char * Tk_NameOfBitmap(Display *display, Pixmap bitmap);
+/* 133 */
+EXTERN CONST84_RETURN char * Tk_NameOfCapStyle(int cap);
+/* 134 */
+EXTERN CONST84_RETURN char * Tk_NameOfColor(XColor *colorPtr);
+/* 135 */
+EXTERN CONST84_RETURN char * Tk_NameOfCursor(Display *display,
+ Tk_Cursor cursor);
+/* 136 */
+EXTERN CONST84_RETURN char * Tk_NameOfFont(Tk_Font font);
+/* 137 */
+EXTERN CONST84_RETURN char * Tk_NameOfImage(Tk_ImageMaster imageMaster);
+/* 138 */
+EXTERN CONST84_RETURN char * Tk_NameOfJoinStyle(int join);
+/* 139 */
+EXTERN CONST84_RETURN char * Tk_NameOfJustify(Tk_Justify justify);
+/* 140 */
+EXTERN CONST84_RETURN char * Tk_NameOfRelief(int relief);
+/* 141 */
+EXTERN Tk_Window Tk_NameToWindow(Tcl_Interp *interp,
+ const char *pathName, Tk_Window tkwin);
+/* 142 */
+EXTERN void Tk_OwnSelection(Tk_Window tkwin, Atom selection,
+ Tk_LostSelProc *proc, ClientData clientData);
+/* 143 */
+EXTERN int Tk_ParseArgv(Tcl_Interp *interp, Tk_Window tkwin,
+ int *argcPtr, CONST84 char **argv,
+ const Tk_ArgvInfo *argTable, int flags);
+/* 144 */
+EXTERN void Tk_PhotoPutBlock_NoComposite(Tk_PhotoHandle handle,
+ Tk_PhotoImageBlock *blockPtr, int x, int y,
+ int width, int height);
+/* 145 */
+EXTERN void Tk_PhotoPutZoomedBlock_NoComposite(
+ Tk_PhotoHandle handle,
+ Tk_PhotoImageBlock *blockPtr, int x, int y,
+ int width, int height, int zoomX, int zoomY,
+ int subsampleX, int subsampleY);
+/* 146 */
+EXTERN int Tk_PhotoGetImage(Tk_PhotoHandle handle,
+ Tk_PhotoImageBlock *blockPtr);
+/* 147 */
+EXTERN void Tk_PhotoBlank(Tk_PhotoHandle handle);
+/* 148 */
+EXTERN void Tk_PhotoExpand_Panic(Tk_PhotoHandle handle,
+ int width, int height);
+/* 149 */
+EXTERN void Tk_PhotoGetSize(Tk_PhotoHandle handle, int *widthPtr,
+ int *heightPtr);
+/* 150 */
+EXTERN void Tk_PhotoSetSize_Panic(Tk_PhotoHandle handle,
+ int width, int height);
+/* 151 */
+EXTERN int Tk_PointToChar(Tk_TextLayout layout, int x, int y);
+/* 152 */
+EXTERN int Tk_PostscriptFontName(Tk_Font tkfont,
+ Tcl_DString *dsPtr);
+/* 153 */
+EXTERN void Tk_PreserveColormap(Display *display,
+ Colormap colormap);
+/* 154 */
+EXTERN void Tk_QueueWindowEvent(XEvent *eventPtr,
+ Tcl_QueuePosition position);
+/* 155 */
+EXTERN void Tk_RedrawImage(Tk_Image image, int imageX,
+ int imageY, int width, int height,
+ Drawable drawable, int drawableX,
+ int drawableY);
+/* 156 */
+EXTERN void Tk_ResizeWindow(Tk_Window tkwin, int width,
+ int height);
+/* 157 */
+EXTERN int Tk_RestackWindow(Tk_Window tkwin, int aboveBelow,
+ Tk_Window other);
+/* 158 */
+EXTERN Tk_RestrictProc * Tk_RestrictEvents(Tk_RestrictProc *proc,
+ ClientData arg, ClientData *prevArgPtr);
+/* 159 */
+EXTERN int Tk_SafeInit(Tcl_Interp *interp);
+/* 160 */
+EXTERN const char * Tk_SetAppName(Tk_Window tkwin, const char *name);
+/* 161 */
+EXTERN void Tk_SetBackgroundFromBorder(Tk_Window tkwin,
+ Tk_3DBorder border);
+/* 162 */
+EXTERN void Tk_SetClass(Tk_Window tkwin, const char *className);
+/* 163 */
+EXTERN void Tk_SetGrid(Tk_Window tkwin, int reqWidth,
+ int reqHeight, int gridWidth, int gridHeight);
+/* 164 */
+EXTERN void Tk_SetInternalBorder(Tk_Window tkwin, int width);
+/* 165 */
+EXTERN void Tk_SetWindowBackground(Tk_Window tkwin,
+ unsigned long pixel);
+/* 166 */
+EXTERN void Tk_SetWindowBackgroundPixmap(Tk_Window tkwin,
+ Pixmap pixmap);
+/* 167 */
+EXTERN void Tk_SetWindowBorder(Tk_Window tkwin,
+ unsigned long pixel);
+/* 168 */
+EXTERN void Tk_SetWindowBorderWidth(Tk_Window tkwin, int width);
+/* 169 */
+EXTERN void Tk_SetWindowBorderPixmap(Tk_Window tkwin,
+ Pixmap pixmap);
+/* 170 */
+EXTERN void Tk_SetWindowColormap(Tk_Window tkwin,
+ Colormap colormap);
+/* 171 */
+EXTERN int Tk_SetWindowVisual(Tk_Window tkwin, Visual *visual,
+ int depth, Colormap colormap);
+/* 172 */
+EXTERN void Tk_SizeOfBitmap(Display *display, Pixmap bitmap,
+ int *widthPtr, int *heightPtr);
+/* 173 */
+EXTERN void Tk_SizeOfImage(Tk_Image image, int *widthPtr,
+ int *heightPtr);
+/* 174 */
+EXTERN int Tk_StrictMotif(Tk_Window tkwin);
+/* 175 */
+EXTERN void Tk_TextLayoutToPostscript(Tcl_Interp *interp,
+ Tk_TextLayout layout);
+/* 176 */
+EXTERN int Tk_TextWidth(Tk_Font font, const char *str,
+ int numBytes);
+/* 177 */
+EXTERN void Tk_UndefineCursor(Tk_Window window);
+/* 178 */
+EXTERN void Tk_UnderlineChars(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(Display *display,
+ Drawable drawable, GC gc,
+ Tk_TextLayout layout, int x, int y,
+ int underline);
+/* 180 */
+EXTERN void Tk_Ungrab(Tk_Window tkwin);
+/* 181 */
+EXTERN void Tk_UnmaintainGeometry(Tk_Window slave,
+ Tk_Window master);
+/* 182 */
+EXTERN void Tk_UnmapWindow(Tk_Window tkwin);
+/* 183 */
+EXTERN void Tk_UnsetGrid(Tk_Window tkwin);
+/* 184 */
+EXTERN void Tk_UpdatePointer(Tk_Window tkwin, int x, int y,
+ int state);
+/* 185 */
+EXTERN Pixmap Tk_AllocBitmapFromObj(Tcl_Interp *interp,
+ Tk_Window tkwin, Tcl_Obj *objPtr);
+/* 186 */
+EXTERN Tk_3DBorder Tk_Alloc3DBorderFromObj(Tcl_Interp *interp,
+ Tk_Window tkwin, Tcl_Obj *objPtr);
+/* 187 */
+EXTERN XColor * Tk_AllocColorFromObj(Tcl_Interp *interp,
+ Tk_Window tkwin, Tcl_Obj *objPtr);
+/* 188 */
+EXTERN Tk_Cursor Tk_AllocCursorFromObj(Tcl_Interp *interp,
+ Tk_Window tkwin, Tcl_Obj *objPtr);
+/* 189 */
+EXTERN Tk_Font Tk_AllocFontFromObj(Tcl_Interp *interp,
+ Tk_Window tkwin, Tcl_Obj *objPtr);
+/* 190 */
+EXTERN Tk_OptionTable Tk_CreateOptionTable(Tcl_Interp *interp,
+ const Tk_OptionSpec *templatePtr);
+/* 191 */
+EXTERN void Tk_DeleteOptionTable(Tk_OptionTable optionTable);
+/* 192 */
+EXTERN void Tk_Free3DBorderFromObj(Tk_Window tkwin,
+ Tcl_Obj *objPtr);
+/* 193 */
+EXTERN void Tk_FreeBitmapFromObj(Tk_Window tkwin,
+ Tcl_Obj *objPtr);
+/* 194 */
+EXTERN void Tk_FreeColorFromObj(Tk_Window tkwin, Tcl_Obj *objPtr);
+/* 195 */
+EXTERN void Tk_FreeConfigOptions(char *recordPtr,
+ Tk_OptionTable optionToken, Tk_Window tkwin);
+/* 196 */
+EXTERN void Tk_FreeSavedOptions(Tk_SavedOptions *savePtr);
+/* 197 */
+EXTERN void Tk_FreeCursorFromObj(Tk_Window tkwin,
+ Tcl_Obj *objPtr);
+/* 198 */
+EXTERN void Tk_FreeFontFromObj(Tk_Window tkwin, Tcl_Obj *objPtr);
+/* 199 */
+EXTERN Tk_3DBorder Tk_Get3DBorderFromObj(Tk_Window tkwin,
+ Tcl_Obj *objPtr);
+/* 200 */
+EXTERN int Tk_GetAnchorFromObj(Tcl_Interp *interp,
+ Tcl_Obj *objPtr, Tk_Anchor *anchorPtr);
+/* 201 */
+EXTERN Pixmap Tk_GetBitmapFromObj(Tk_Window tkwin, Tcl_Obj *objPtr);
+/* 202 */
+EXTERN XColor * Tk_GetColorFromObj(Tk_Window tkwin, Tcl_Obj *objPtr);
+/* 203 */
+EXTERN Tk_Cursor Tk_GetCursorFromObj(Tk_Window tkwin, Tcl_Obj *objPtr);
+/* 204 */
+EXTERN Tcl_Obj * Tk_GetOptionInfo(Tcl_Interp *interp, char *recordPtr,
+ Tk_OptionTable optionTable, Tcl_Obj *namePtr,
+ Tk_Window tkwin);
+/* 205 */
+EXTERN Tcl_Obj * Tk_GetOptionValue(Tcl_Interp *interp,
+ char *recordPtr, Tk_OptionTable optionTable,
+ Tcl_Obj *namePtr, Tk_Window tkwin);
+/* 206 */
+EXTERN int Tk_GetJustifyFromObj(Tcl_Interp *interp,
+ Tcl_Obj *objPtr, Tk_Justify *justifyPtr);
+/* 207 */
+EXTERN int Tk_GetMMFromObj(Tcl_Interp *interp, Tk_Window tkwin,
+ Tcl_Obj *objPtr, double *doublePtr);
+/* 208 */
+EXTERN int Tk_GetPixelsFromObj(Tcl_Interp *interp,
+ Tk_Window tkwin, Tcl_Obj *objPtr,
+ int *intPtr);
+/* 209 */
+EXTERN int Tk_GetReliefFromObj(Tcl_Interp *interp,
+ Tcl_Obj *objPtr, int *resultPtr);
+/* 210 */
+EXTERN int Tk_GetScrollInfoObj(Tcl_Interp *interp, int objc,
+ Tcl_Obj *const objv[], double *dblPtr,
+ int *intPtr);
+/* 211 */
+EXTERN int Tk_InitOptions(Tcl_Interp *interp, char *recordPtr,
+ Tk_OptionTable optionToken, Tk_Window tkwin);
+/* 212 */
+EXTERN void Tk_MainEx(int argc, char **argv,
+ Tcl_AppInitProc *appInitProc,
+ Tcl_Interp *interp);
+/* 213 */
+EXTERN void Tk_RestoreSavedOptions(Tk_SavedOptions *savePtr);
+/* 214 */
+EXTERN 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);
+/* 215 */
+EXTERN void Tk_InitConsoleChannels(Tcl_Interp *interp);
+/* 216 */
+EXTERN int Tk_CreateConsoleWindow(Tcl_Interp *interp);
+/* 217 */
+EXTERN void Tk_CreateSmoothMethod(Tcl_Interp *interp,
+ const Tk_SmoothMethod *method);
+/* Slot 218 is reserved */
+/* Slot 219 is reserved */
+/* 220 */
+EXTERN int Tk_GetDash(Tcl_Interp *interp, const char *value,
+ Tk_Dash *dash);
+/* 221 */
+EXTERN void Tk_CreateOutline(Tk_Outline *outline);
+/* 222 */
+EXTERN void Tk_DeleteOutline(Display *display,
+ Tk_Outline *outline);
+/* 223 */
+EXTERN int Tk_ConfigOutlineGC(XGCValues *gcValues,
+ Tk_Canvas canvas, Tk_Item *item,
+ Tk_Outline *outline);
+/* 224 */
+EXTERN int Tk_ChangeOutlineGC(Tk_Canvas canvas, Tk_Item *item,
+ Tk_Outline *outline);
+/* 225 */
+EXTERN int Tk_ResetOutlineGC(Tk_Canvas canvas, Tk_Item *item,
+ Tk_Outline *outline);
+/* 226 */
+EXTERN int Tk_CanvasPsOutline(Tk_Canvas canvas, Tk_Item *item,
+ Tk_Outline *outline);
+/* 227 */
+EXTERN void Tk_SetTSOrigin(Tk_Window tkwin, GC gc, int x, int y);
+/* 228 */
+EXTERN int Tk_CanvasGetCoordFromObj(Tcl_Interp *interp,
+ Tk_Canvas canvas, Tcl_Obj *obj,
+ double *doublePtr);
+/* 229 */
+EXTERN void Tk_CanvasSetOffset(Tk_Canvas canvas, GC gc,
+ Tk_TSOffset *offset);
+/* 230 */
+EXTERN void Tk_DitherPhoto(Tk_PhotoHandle handle, int x, int y,
+ int width, int height);
+/* 231 */
+EXTERN int Tk_PostscriptBitmap(Tcl_Interp *interp,
+ Tk_Window tkwin, Tk_PostscriptInfo psInfo,
+ Pixmap bitmap, int startX, int startY,
+ int width, int height);
+/* 232 */
+EXTERN int Tk_PostscriptColor(Tcl_Interp *interp,
+ Tk_PostscriptInfo psInfo, XColor *colorPtr);
+/* 233 */
+EXTERN int Tk_PostscriptFont(Tcl_Interp *interp,
+ Tk_PostscriptInfo psInfo, Tk_Font font);
+/* 234 */
+EXTERN 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);
+/* 235 */
+EXTERN void Tk_PostscriptPath(Tcl_Interp *interp,
+ Tk_PostscriptInfo psInfo, double *coordPtr,
+ int numPoints);
+/* 236 */
+EXTERN int Tk_PostscriptStipple(Tcl_Interp *interp,
+ Tk_Window tkwin, Tk_PostscriptInfo psInfo,
+ Pixmap bitmap);
+/* 237 */
+EXTERN double Tk_PostscriptY(double y, Tk_PostscriptInfo psInfo);
+/* 238 */
+EXTERN int Tk_PostscriptPhoto(Tcl_Interp *interp,
+ Tk_PhotoImageBlock *blockPtr,
+ Tk_PostscriptInfo psInfo, int width,
+ int height);
+/* 239 */
+EXTERN void Tk_CreateClientMessageHandler(
+ Tk_ClientMessageProc *proc);
+/* 240 */
+EXTERN void Tk_DeleteClientMessageHandler(
+ Tk_ClientMessageProc *proc);
+/* 241 */
+EXTERN Tk_Window Tk_CreateAnonymousWindow(Tcl_Interp *interp,
+ Tk_Window parent, const char *screenName);
+/* 242 */
+EXTERN void Tk_SetClassProcs(Tk_Window tkwin,
+ const Tk_ClassProcs *procs,
+ ClientData instanceData);
+/* 243 */
+EXTERN void Tk_SetInternalBorderEx(Tk_Window tkwin, int left,
+ int right, int top, int bottom);
+/* 244 */
+EXTERN void Tk_SetMinimumRequestSize(Tk_Window tkwin,
+ int minWidth, int minHeight);
+/* 245 */
+EXTERN void Tk_SetCaretPos(Tk_Window tkwin, int x, int y,
+ int height);
+/* 246 */
+EXTERN void Tk_PhotoPutBlock_Panic(Tk_PhotoHandle handle,
+ Tk_PhotoImageBlock *blockPtr, int x, int y,
+ int width, int height, int compRule);
+/* 247 */
+EXTERN void Tk_PhotoPutZoomedBlock_Panic(Tk_PhotoHandle handle,
+ Tk_PhotoImageBlock *blockPtr, int x, int y,
+ int width, int height, int zoomX, int zoomY,
+ int subsampleX, int subsampleY, int compRule);
+/* 248 */
+EXTERN int Tk_CollapseMotionEvents(Display *display,
+ int collapse);
+/* 249 */
+EXTERN Tk_StyleEngine Tk_RegisterStyleEngine(const char *name,
+ Tk_StyleEngine parent);
+/* 250 */
+EXTERN Tk_StyleEngine Tk_GetStyleEngine(const char *name);
+/* 251 */
+EXTERN int Tk_RegisterStyledElement(Tk_StyleEngine engine,
+ Tk_ElementSpec *templatePtr);
+/* 252 */
+EXTERN int Tk_GetElementId(const char *name);
+/* 253 */
+EXTERN Tk_Style Tk_CreateStyle(const char *name,
+ Tk_StyleEngine engine, ClientData clientData);
+/* 254 */
+EXTERN Tk_Style Tk_GetStyle(Tcl_Interp *interp, const char *name);
+/* 255 */
+EXTERN void Tk_FreeStyle(Tk_Style style);
+/* 256 */
+EXTERN const char * Tk_NameOfStyle(Tk_Style style);
+/* 257 */
+EXTERN Tk_Style Tk_AllocStyleFromObj(Tcl_Interp *interp,
+ Tcl_Obj *objPtr);
+/* 258 */
+EXTERN Tk_Style Tk_GetStyleFromObj(Tcl_Obj *objPtr);
+/* 259 */
+EXTERN void Tk_FreeStyleFromObj(Tcl_Obj *objPtr);
+/* 260 */
+EXTERN Tk_StyledElement Tk_GetStyledElement(Tk_Style style, int elementId,
+ Tk_OptionTable optionTable);
+/* 261 */
+EXTERN void Tk_GetElementSize(Tk_Style style,
+ Tk_StyledElement element, char *recordPtr,
+ Tk_Window tkwin, int width, int height,
+ int inner, int *widthPtr, int *heightPtr);
+/* 262 */
+EXTERN void Tk_GetElementBox(Tk_Style style,
+ Tk_StyledElement element, char *recordPtr,
+ Tk_Window tkwin, int x, int y, int width,
+ int height, int inner, int *xPtr, int *yPtr,
+ int *widthPtr, int *heightPtr);
+/* 263 */
+EXTERN int Tk_GetElementBorderWidth(Tk_Style style,
+ Tk_StyledElement element, char *recordPtr,
+ Tk_Window tkwin);
+/* 264 */
+EXTERN void Tk_DrawElement(Tk_Style style,
+ Tk_StyledElement element, char *recordPtr,
+ Tk_Window tkwin, Drawable d, int x, int y,
+ int width, int height, int state);
+/* 265 */
+EXTERN int Tk_PhotoExpand(Tcl_Interp *interp,
+ Tk_PhotoHandle handle, int width, int height);
+/* 266 */
+EXTERN int Tk_PhotoPutBlock(Tcl_Interp *interp,
+ Tk_PhotoHandle handle,
+ Tk_PhotoImageBlock *blockPtr, int x, int y,
+ int width, int height, int compRule);
+/* 267 */
+EXTERN int Tk_PhotoPutZoomedBlock(Tcl_Interp *interp,
+ Tk_PhotoHandle handle,
+ Tk_PhotoImageBlock *blockPtr, int x, int y,
+ int width, int height, int zoomX, int zoomY,
+ int subsampleX, int subsampleY, int compRule);
+/* 268 */
+EXTERN int Tk_PhotoSetSize(Tcl_Interp *interp,
+ Tk_PhotoHandle handle, int width, int height);
+/* 269 */
+EXTERN long Tk_GetUserInactiveTime(Display *dpy);
+/* 270 */
+EXTERN void Tk_ResetUserInactiveTime(Display *dpy);
+/* 271 */
+EXTERN Tcl_Interp * Tk_Interp(Tk_Window tkwin);
+/* 272 */
+EXTERN void Tk_CreateOldImageType(const Tk_ImageType *typePtr);
+/* 273 */
+EXTERN void Tk_CreateOldPhotoImageFormat(
+ const Tk_PhotoImageFormat *formatPtr);
+
+typedef struct {
+ const struct TkPlatStubs *tkPlatStubs;
+ const struct TkIntStubs *tkIntStubs;
+ const struct TkIntPlatStubs *tkIntPlatStubs;
+ const struct TkIntXlibStubs *tkIntXlibStubs;
+} TkStubHooks;
+
+typedef struct TkStubs {
+ int magic;
+ const TkStubHooks *hooks;
+
+ void (*tk_MainLoop) (void); /* 0 */
+ XColor * (*tk_3DBorderColor) (Tk_3DBorder border); /* 1 */
+ GC (*tk_3DBorderGC) (Tk_Window tkwin, Tk_3DBorder border, int which); /* 2 */
+ 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); /* 3 */
+ void (*tk_3DVerticalBevel) (Tk_Window tkwin, Drawable drawable, Tk_3DBorder border, int x, int y, int width, int height, int leftBevel, int relief); /* 4 */
+ void (*tk_AddOption) (Tk_Window tkwin, const char *name, const char *value, int priority); /* 5 */
+ void (*tk_BindEvent) (Tk_BindingTable bindingTable, XEvent *eventPtr, Tk_Window tkwin, int numObjects, ClientData *objectPtr); /* 6 */
+ void (*tk_CanvasDrawableCoords) (Tk_Canvas canvas, double x, double y, short *drawableXPtr, short *drawableYPtr); /* 7 */
+ void (*tk_CanvasEventuallyRedraw) (Tk_Canvas canvas, int x1, int y1, int x2, int y2); /* 8 */
+ int (*tk_CanvasGetCoord) (Tcl_Interp *interp, Tk_Canvas canvas, const char *str, double *doublePtr); /* 9 */
+ Tk_CanvasTextInfo * (*tk_CanvasGetTextInfo) (Tk_Canvas canvas); /* 10 */
+ int (*tk_CanvasPsBitmap) (Tcl_Interp *interp, Tk_Canvas canvas, Pixmap bitmap, int x, int y, int width, int height); /* 11 */
+ int (*tk_CanvasPsColor) (Tcl_Interp *interp, Tk_Canvas canvas, XColor *colorPtr); /* 12 */
+ int (*tk_CanvasPsFont) (Tcl_Interp *interp, Tk_Canvas canvas, Tk_Font font); /* 13 */
+ void (*tk_CanvasPsPath) (Tcl_Interp *interp, Tk_Canvas canvas, double *coordPtr, int numPoints); /* 14 */
+ int (*tk_CanvasPsStipple) (Tcl_Interp *interp, Tk_Canvas canvas, Pixmap bitmap); /* 15 */
+ double (*tk_CanvasPsY) (Tk_Canvas canvas, double y); /* 16 */
+ void (*tk_CanvasSetStippleOrigin) (Tk_Canvas canvas, GC gc); /* 17 */
+ int (*tk_CanvasTagsParseProc) (ClientData clientData, Tcl_Interp *interp, Tk_Window tkwin, const char *value, char *widgRec, int offset); /* 18 */
+ CONST86 char * (*tk_CanvasTagsPrintProc) (ClientData clientData, Tk_Window tkwin, char *widgRec, int offset, Tcl_FreeProc **freeProcPtr); /* 19 */
+ Tk_Window (*tk_CanvasTkwin) (Tk_Canvas canvas); /* 20 */
+ void (*tk_CanvasWindowCoords) (Tk_Canvas canvas, double x, double y, short *screenXPtr, short *screenYPtr); /* 21 */
+ void (*tk_ChangeWindowAttributes) (Tk_Window tkwin, unsigned long valueMask, XSetWindowAttributes *attsPtr); /* 22 */
+ int (*tk_CharBbox) (Tk_TextLayout layout, int index, int *xPtr, int *yPtr, int *widthPtr, int *heightPtr); /* 23 */
+ void (*tk_ClearSelection) (Tk_Window tkwin, Atom selection); /* 24 */
+ int (*tk_ClipboardAppend) (Tcl_Interp *interp, Tk_Window tkwin, Atom target, Atom format, const char *buffer); /* 25 */
+ int (*tk_ClipboardClear) (Tcl_Interp *interp, Tk_Window tkwin); /* 26 */
+ int (*tk_ConfigureInfo) (Tcl_Interp *interp, Tk_Window tkwin, const Tk_ConfigSpec *specs, char *widgRec, const char *argvName, int flags); /* 27 */
+ int (*tk_ConfigureValue) (Tcl_Interp *interp, Tk_Window tkwin, const Tk_ConfigSpec *specs, char *widgRec, const char *argvName, int flags); /* 28 */
+ int (*tk_ConfigureWidget) (Tcl_Interp *interp, Tk_Window tkwin, const Tk_ConfigSpec *specs, int argc, CONST84 char **argv, char *widgRec, int flags); /* 29 */
+ void (*tk_ConfigureWindow) (Tk_Window tkwin, unsigned int valueMask, XWindowChanges *valuePtr); /* 30 */
+ Tk_TextLayout (*tk_ComputeTextLayout) (Tk_Font font, const char *str, int numChars, int wrapLength, Tk_Justify justify, int flags, int *widthPtr, int *heightPtr); /* 31 */
+ Tk_Window (*tk_CoordsToWindow) (int rootX, int rootY, Tk_Window tkwin); /* 32 */
+ unsigned long (*tk_CreateBinding) (Tcl_Interp *interp, Tk_BindingTable bindingTable, ClientData object, const char *eventStr, const char *script, int append); /* 33 */
+ Tk_BindingTable (*tk_CreateBindingTable) (Tcl_Interp *interp); /* 34 */
+ Tk_ErrorHandler (*tk_CreateErrorHandler) (Display *display, int errNum, int request, int minorCode, Tk_ErrorProc *errorProc, ClientData clientData); /* 35 */
+ void (*tk_CreateEventHandler) (Tk_Window token, unsigned long mask, Tk_EventProc *proc, ClientData clientData); /* 36 */
+ void (*tk_CreateGenericHandler) (Tk_GenericProc *proc, ClientData clientData); /* 37 */
+ void (*tk_CreateImageType) (const Tk_ImageType *typePtr); /* 38 */
+ void (*tk_CreateItemType) (Tk_ItemType *typePtr); /* 39 */
+ void (*tk_CreatePhotoImageFormat) (const Tk_PhotoImageFormat *formatPtr); /* 40 */
+ void (*tk_CreateSelHandler) (Tk_Window tkwin, Atom selection, Atom target, Tk_SelectionProc *proc, ClientData clientData, Atom format); /* 41 */
+ Tk_Window (*tk_CreateWindow) (Tcl_Interp *interp, Tk_Window parent, const char *name, const char *screenName); /* 42 */
+ Tk_Window (*tk_CreateWindowFromPath) (Tcl_Interp *interp, Tk_Window tkwin, const char *pathName, const char *screenName); /* 43 */
+ int (*tk_DefineBitmap) (Tcl_Interp *interp, const char *name, const void *source, int width, int height); /* 44 */
+ void (*tk_DefineCursor) (Tk_Window window, Tk_Cursor cursor); /* 45 */
+ void (*tk_DeleteAllBindings) (Tk_BindingTable bindingTable, ClientData object); /* 46 */
+ int (*tk_DeleteBinding) (Tcl_Interp *interp, Tk_BindingTable bindingTable, ClientData object, const char *eventStr); /* 47 */
+ void (*tk_DeleteBindingTable) (Tk_BindingTable bindingTable); /* 48 */
+ void (*tk_DeleteErrorHandler) (Tk_ErrorHandler handler); /* 49 */
+ void (*tk_DeleteEventHandler) (Tk_Window token, unsigned long mask, Tk_EventProc *proc, ClientData clientData); /* 50 */
+ void (*tk_DeleteGenericHandler) (Tk_GenericProc *proc, ClientData clientData); /* 51 */
+ void (*tk_DeleteImage) (Tcl_Interp *interp, const char *name); /* 52 */
+ void (*tk_DeleteSelHandler) (Tk_Window tkwin, Atom selection, Atom target); /* 53 */
+ void (*tk_DestroyWindow) (Tk_Window tkwin); /* 54 */
+ CONST84_RETURN char * (*tk_DisplayName) (Tk_Window tkwin); /* 55 */
+ int (*tk_DistanceToTextLayout) (Tk_TextLayout layout, int x, int y); /* 56 */
+ void (*tk_Draw3DPolygon) (Tk_Window tkwin, Drawable drawable, Tk_3DBorder border, XPoint *pointPtr, int numPoints, int borderWidth, int leftRelief); /* 57 */
+ void (*tk_Draw3DRectangle) (Tk_Window tkwin, Drawable drawable, Tk_3DBorder border, int x, int y, int width, int height, int borderWidth, int relief); /* 58 */
+ void (*tk_DrawChars) (Display *display, Drawable drawable, GC gc, Tk_Font tkfont, const char *source, int numBytes, int x, int y); /* 59 */
+ void (*tk_DrawFocusHighlight) (Tk_Window tkwin, GC gc, int width, Drawable drawable); /* 60 */
+ void (*tk_DrawTextLayout) (Display *display, Drawable drawable, GC gc, Tk_TextLayout layout, int x, int y, int firstChar, int lastChar); /* 61 */
+ void (*tk_Fill3DPolygon) (Tk_Window tkwin, Drawable drawable, Tk_3DBorder border, XPoint *pointPtr, int numPoints, int borderWidth, int leftRelief); /* 62 */
+ void (*tk_Fill3DRectangle) (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) (Tcl_Interp *interp, const char *imageName); /* 64 */
+ Font (*tk_FontId) (Tk_Font font); /* 65 */
+ void (*tk_Free3DBorder) (Tk_3DBorder border); /* 66 */
+ void (*tk_FreeBitmap) (Display *display, Pixmap bitmap); /* 67 */
+ void (*tk_FreeColor) (XColor *colorPtr); /* 68 */
+ void (*tk_FreeColormap) (Display *display, Colormap colormap); /* 69 */
+ void (*tk_FreeCursor) (Display *display, Tk_Cursor cursor); /* 70 */
+ void (*tk_FreeFont) (Tk_Font f); /* 71 */
+ void (*tk_FreeGC) (Display *display, GC gc); /* 72 */
+ void (*tk_FreeImage) (Tk_Image image); /* 73 */
+ void (*tk_FreeOptions) (const Tk_ConfigSpec *specs, char *widgRec, Display *display, int needFlags); /* 74 */
+ void (*tk_FreePixmap) (Display *display, Pixmap pixmap); /* 75 */
+ void (*tk_FreeTextLayout) (Tk_TextLayout textLayout); /* 76 */
+ void (*tk_FreeXId) (Display *display, XID xid); /* 77 */
+ GC (*tk_GCForColor) (XColor *colorPtr, Drawable drawable); /* 78 */
+ void (*tk_GeometryRequest) (Tk_Window tkwin, int reqWidth, int reqHeight); /* 79 */
+ Tk_3DBorder (*tk_Get3DBorder) (Tcl_Interp *interp, Tk_Window tkwin, Tk_Uid colorName); /* 80 */
+ void (*tk_GetAllBindings) (Tcl_Interp *interp, Tk_BindingTable bindingTable, ClientData object); /* 81 */
+ int (*tk_GetAnchor) (Tcl_Interp *interp, const char *str, Tk_Anchor *anchorPtr); /* 82 */
+ CONST84_RETURN char * (*tk_GetAtomName) (Tk_Window tkwin, Atom atom); /* 83 */
+ CONST84_RETURN char * (*tk_GetBinding) (Tcl_Interp *interp, Tk_BindingTable bindingTable, ClientData object, const char *eventStr); /* 84 */
+ Pixmap (*tk_GetBitmap) (Tcl_Interp *interp, Tk_Window tkwin, const char *str); /* 85 */
+ Pixmap (*tk_GetBitmapFromData) (Tcl_Interp *interp, Tk_Window tkwin, const void *source, int width, int height); /* 86 */
+ int (*tk_GetCapStyle) (Tcl_Interp *interp, const char *str, int *capPtr); /* 87 */
+ XColor * (*tk_GetColor) (Tcl_Interp *interp, Tk_Window tkwin, Tk_Uid name); /* 88 */
+ XColor * (*tk_GetColorByValue) (Tk_Window tkwin, XColor *colorPtr); /* 89 */
+ Colormap (*tk_GetColormap) (Tcl_Interp *interp, Tk_Window tkwin, const char *str); /* 90 */
+ Tk_Cursor (*tk_GetCursor) (Tcl_Interp *interp, Tk_Window tkwin, Tk_Uid str); /* 91 */
+ Tk_Cursor (*tk_GetCursorFromData) (Tcl_Interp *interp, Tk_Window tkwin, const char *source, const char *mask, int width, int height, int xHot, int yHot, Tk_Uid fg, Tk_Uid bg); /* 92 */
+ Tk_Font (*tk_GetFont) (Tcl_Interp *interp, Tk_Window tkwin, const char *str); /* 93 */
+ Tk_Font (*tk_GetFontFromObj) (Tk_Window tkwin, Tcl_Obj *objPtr); /* 94 */
+ void (*tk_GetFontMetrics) (Tk_Font font, Tk_FontMetrics *fmPtr); /* 95 */
+ GC (*tk_GetGC) (Tk_Window tkwin, unsigned long valueMask, XGCValues *valuePtr); /* 96 */
+ Tk_Image (*tk_GetImage) (Tcl_Interp *interp, Tk_Window tkwin, const char *name, Tk_ImageChangedProc *changeProc, ClientData clientData); /* 97 */
+ ClientData (*tk_GetImageMasterData) (Tcl_Interp *interp, const char *name, CONST86 Tk_ImageType **typePtrPtr); /* 98 */
+ Tk_ItemType * (*tk_GetItemTypes) (void); /* 99 */
+ int (*tk_GetJoinStyle) (Tcl_Interp *interp, const char *str, int *joinPtr); /* 100 */
+ int (*tk_GetJustify) (Tcl_Interp *interp, const char *str, Tk_Justify *justifyPtr); /* 101 */
+ int (*tk_GetNumMainWindows) (void); /* 102 */
+ Tk_Uid (*tk_GetOption) (Tk_Window tkwin, const char *name, const char *className); /* 103 */
+ int (*tk_GetPixels) (Tcl_Interp *interp, Tk_Window tkwin, const char *str, int *intPtr); /* 104 */
+ Pixmap (*tk_GetPixmap) (Display *display, Drawable d, int width, int height, int depth); /* 105 */
+ int (*tk_GetRelief) (Tcl_Interp *interp, const char *name, int *reliefPtr); /* 106 */
+ void (*tk_GetRootCoords) (Tk_Window tkwin, int *xPtr, int *yPtr); /* 107 */
+ int (*tk_GetScrollInfo) (Tcl_Interp *interp, int argc, CONST84 char **argv, double *dblPtr, int *intPtr); /* 108 */
+ int (*tk_GetScreenMM) (Tcl_Interp *interp, Tk_Window tkwin, const char *str, double *doublePtr); /* 109 */
+ int (*tk_GetSelection) (Tcl_Interp *interp, Tk_Window tkwin, Atom selection, Atom target, Tk_GetSelProc *proc, ClientData clientData); /* 110 */
+ Tk_Uid (*tk_GetUid) (const char *str); /* 111 */
+ Visual * (*tk_GetVisual) (Tcl_Interp *interp, Tk_Window tkwin, const char *str, int *depthPtr, Colormap *colormapPtr); /* 112 */
+ void (*tk_GetVRootGeometry) (Tk_Window tkwin, int *xPtr, int *yPtr, int *widthPtr, int *heightPtr); /* 113 */
+ int (*tk_Grab) (Tcl_Interp *interp, Tk_Window tkwin, int grabGlobal); /* 114 */
+ void (*tk_HandleEvent) (XEvent *eventPtr); /* 115 */
+ Tk_Window (*tk_IdToWindow) (Display *display, Window window); /* 116 */
+ void (*tk_ImageChanged) (Tk_ImageMaster master, int x, int y, int width, int height, int imageWidth, int imageHeight); /* 117 */
+ int (*tk_Init) (Tcl_Interp *interp); /* 118 */
+ Atom (*tk_InternAtom) (Tk_Window tkwin, const char *name); /* 119 */
+ int (*tk_IntersectTextLayout) (Tk_TextLayout layout, int x, int y, int width, int height); /* 120 */
+ void (*tk_MaintainGeometry) (Tk_Window slave, Tk_Window master, int x, int y, int width, int height); /* 121 */
+ Tk_Window (*tk_MainWindow) (Tcl_Interp *interp); /* 122 */
+ void (*tk_MakeWindowExist) (Tk_Window tkwin); /* 123 */
+ void (*tk_ManageGeometry) (Tk_Window tkwin, const Tk_GeomMgr *mgrPtr, ClientData clientData); /* 124 */
+ void (*tk_MapWindow) (Tk_Window tkwin); /* 125 */
+ int (*tk_MeasureChars) (Tk_Font tkfont, const char *source, int numBytes, int maxPixels, int flags, int *lengthPtr); /* 126 */
+ void (*tk_MoveResizeWindow) (Tk_Window tkwin, int x, int y, int width, int height); /* 127 */
+ void (*tk_MoveWindow) (Tk_Window tkwin, int x, int y); /* 128 */
+ void (*tk_MoveToplevelWindow) (Tk_Window tkwin, int x, int y); /* 129 */
+ CONST84_RETURN char * (*tk_NameOf3DBorder) (Tk_3DBorder border); /* 130 */
+ CONST84_RETURN char * (*tk_NameOfAnchor) (Tk_Anchor anchor); /* 131 */
+ CONST84_RETURN char * (*tk_NameOfBitmap) (Display *display, Pixmap bitmap); /* 132 */
+ CONST84_RETURN char * (*tk_NameOfCapStyle) (int cap); /* 133 */
+ CONST84_RETURN char * (*tk_NameOfColor) (XColor *colorPtr); /* 134 */
+ CONST84_RETURN char * (*tk_NameOfCursor) (Display *display, Tk_Cursor cursor); /* 135 */
+ CONST84_RETURN char * (*tk_NameOfFont) (Tk_Font font); /* 136 */
+ CONST84_RETURN char * (*tk_NameOfImage) (Tk_ImageMaster imageMaster); /* 137 */
+ CONST84_RETURN char * (*tk_NameOfJoinStyle) (int join); /* 138 */
+ CONST84_RETURN char * (*tk_NameOfJustify) (Tk_Justify justify); /* 139 */
+ CONST84_RETURN char * (*tk_NameOfRelief) (int relief); /* 140 */
+ Tk_Window (*tk_NameToWindow) (Tcl_Interp *interp, const char *pathName, Tk_Window tkwin); /* 141 */
+ void (*tk_OwnSelection) (Tk_Window tkwin, Atom selection, Tk_LostSelProc *proc, ClientData clientData); /* 142 */
+ int (*tk_ParseArgv) (Tcl_Interp *interp, Tk_Window tkwin, int *argcPtr, CONST84 char **argv, const Tk_ArgvInfo *argTable, int flags); /* 143 */
+ void (*tk_PhotoPutBlock_NoComposite) (Tk_PhotoHandle handle, Tk_PhotoImageBlock *blockPtr, int x, int y, int width, int height); /* 144 */
+ void (*tk_PhotoPutZoomedBlock_NoComposite) (Tk_PhotoHandle handle, Tk_PhotoImageBlock *blockPtr, int x, int y, int width, int height, int zoomX, int zoomY, int subsampleX, int subsampleY); /* 145 */
+ int (*tk_PhotoGetImage) (Tk_PhotoHandle handle, Tk_PhotoImageBlock *blockPtr); /* 146 */
+ void (*tk_PhotoBlank) (Tk_PhotoHandle handle); /* 147 */
+ void (*tk_PhotoExpand_Panic) (Tk_PhotoHandle handle, int width, int height); /* 148 */
+ void (*tk_PhotoGetSize) (Tk_PhotoHandle handle, int *widthPtr, int *heightPtr); /* 149 */
+ void (*tk_PhotoSetSize_Panic) (Tk_PhotoHandle handle, int width, int height); /* 150 */
+ int (*tk_PointToChar) (Tk_TextLayout layout, int x, int y); /* 151 */
+ int (*tk_PostscriptFontName) (Tk_Font tkfont, Tcl_DString *dsPtr); /* 152 */
+ void (*tk_PreserveColormap) (Display *display, Colormap colormap); /* 153 */
+ void (*tk_QueueWindowEvent) (XEvent *eventPtr, Tcl_QueuePosition position); /* 154 */
+ void (*tk_RedrawImage) (Tk_Image image, int imageX, int imageY, int width, int height, Drawable drawable, int drawableX, int drawableY); /* 155 */
+ void (*tk_ResizeWindow) (Tk_Window tkwin, int width, int height); /* 156 */
+ int (*tk_RestackWindow) (Tk_Window tkwin, int aboveBelow, Tk_Window other); /* 157 */
+ Tk_RestrictProc * (*tk_RestrictEvents) (Tk_RestrictProc *proc, ClientData arg, ClientData *prevArgPtr); /* 158 */
+ int (*tk_SafeInit) (Tcl_Interp *interp); /* 159 */
+ const char * (*tk_SetAppName) (Tk_Window tkwin, const char *name); /* 160 */
+ void (*tk_SetBackgroundFromBorder) (Tk_Window tkwin, Tk_3DBorder border); /* 161 */
+ void (*tk_SetClass) (Tk_Window tkwin, const char *className); /* 162 */
+ void (*tk_SetGrid) (Tk_Window tkwin, int reqWidth, int reqHeight, int gridWidth, int gridHeight); /* 163 */
+ void (*tk_SetInternalBorder) (Tk_Window tkwin, int width); /* 164 */
+ void (*tk_SetWindowBackground) (Tk_Window tkwin, unsigned long pixel); /* 165 */
+ void (*tk_SetWindowBackgroundPixmap) (Tk_Window tkwin, Pixmap pixmap); /* 166 */
+ void (*tk_SetWindowBorder) (Tk_Window tkwin, unsigned long pixel); /* 167 */
+ void (*tk_SetWindowBorderWidth) (Tk_Window tkwin, int width); /* 168 */
+ void (*tk_SetWindowBorderPixmap) (Tk_Window tkwin, Pixmap pixmap); /* 169 */
+ void (*tk_SetWindowColormap) (Tk_Window tkwin, Colormap colormap); /* 170 */
+ int (*tk_SetWindowVisual) (Tk_Window tkwin, Visual *visual, int depth, Colormap colormap); /* 171 */
+ void (*tk_SizeOfBitmap) (Display *display, Pixmap bitmap, int *widthPtr, int *heightPtr); /* 172 */
+ void (*tk_SizeOfImage) (Tk_Image image, int *widthPtr, int *heightPtr); /* 173 */
+ int (*tk_StrictMotif) (Tk_Window tkwin); /* 174 */
+ void (*tk_TextLayoutToPostscript) (Tcl_Interp *interp, Tk_TextLayout layout); /* 175 */
+ int (*tk_TextWidth) (Tk_Font font, const char *str, int numBytes); /* 176 */
+ void (*tk_UndefineCursor) (Tk_Window window); /* 177 */
+ void (*tk_UnderlineChars) (Display *display, Drawable drawable, GC gc, Tk_Font tkfont, const char *source, int x, int y, int firstByte, int lastByte); /* 178 */
+ void (*tk_UnderlineTextLayout) (Display *display, Drawable drawable, GC gc, Tk_TextLayout layout, int x, int y, int underline); /* 179 */
+ void (*tk_Ungrab) (Tk_Window tkwin); /* 180 */
+ void (*tk_UnmaintainGeometry) (Tk_Window slave, Tk_Window master); /* 181 */
+ void (*tk_UnmapWindow) (Tk_Window tkwin); /* 182 */
+ void (*tk_UnsetGrid) (Tk_Window tkwin); /* 183 */
+ void (*tk_UpdatePointer) (Tk_Window tkwin, int x, int y, int state); /* 184 */
+ Pixmap (*tk_AllocBitmapFromObj) (Tcl_Interp *interp, Tk_Window tkwin, Tcl_Obj *objPtr); /* 185 */
+ Tk_3DBorder (*tk_Alloc3DBorderFromObj) (Tcl_Interp *interp, Tk_Window tkwin, Tcl_Obj *objPtr); /* 186 */
+ XColor * (*tk_AllocColorFromObj) (Tcl_Interp *interp, Tk_Window tkwin, Tcl_Obj *objPtr); /* 187 */
+ Tk_Cursor (*tk_AllocCursorFromObj) (Tcl_Interp *interp, Tk_Window tkwin, Tcl_Obj *objPtr); /* 188 */
+ Tk_Font (*tk_AllocFontFromObj) (Tcl_Interp *interp, Tk_Window tkwin, Tcl_Obj *objPtr); /* 189 */
+ Tk_OptionTable (*tk_CreateOptionTable) (Tcl_Interp *interp, const Tk_OptionSpec *templatePtr); /* 190 */
+ void (*tk_DeleteOptionTable) (Tk_OptionTable optionTable); /* 191 */
+ void (*tk_Free3DBorderFromObj) (Tk_Window tkwin, Tcl_Obj *objPtr); /* 192 */
+ void (*tk_FreeBitmapFromObj) (Tk_Window tkwin, Tcl_Obj *objPtr); /* 193 */
+ void (*tk_FreeColorFromObj) (Tk_Window tkwin, Tcl_Obj *objPtr); /* 194 */
+ void (*tk_FreeConfigOptions) (char *recordPtr, Tk_OptionTable optionToken, Tk_Window tkwin); /* 195 */
+ void (*tk_FreeSavedOptions) (Tk_SavedOptions *savePtr); /* 196 */
+ void (*tk_FreeCursorFromObj) (Tk_Window tkwin, Tcl_Obj *objPtr); /* 197 */
+ void (*tk_FreeFontFromObj) (Tk_Window tkwin, Tcl_Obj *objPtr); /* 198 */
+ Tk_3DBorder (*tk_Get3DBorderFromObj) (Tk_Window tkwin, Tcl_Obj *objPtr); /* 199 */
+ int (*tk_GetAnchorFromObj) (Tcl_Interp *interp, Tcl_Obj *objPtr, Tk_Anchor *anchorPtr); /* 200 */
+ Pixmap (*tk_GetBitmapFromObj) (Tk_Window tkwin, Tcl_Obj *objPtr); /* 201 */
+ XColor * (*tk_GetColorFromObj) (Tk_Window tkwin, Tcl_Obj *objPtr); /* 202 */
+ Tk_Cursor (*tk_GetCursorFromObj) (Tk_Window tkwin, Tcl_Obj *objPtr); /* 203 */
+ Tcl_Obj * (*tk_GetOptionInfo) (Tcl_Interp *interp, char *recordPtr, Tk_OptionTable optionTable, Tcl_Obj *namePtr, Tk_Window tkwin); /* 204 */
+ Tcl_Obj * (*tk_GetOptionValue) (Tcl_Interp *interp, char *recordPtr, Tk_OptionTable optionTable, Tcl_Obj *namePtr, Tk_Window tkwin); /* 205 */
+ int (*tk_GetJustifyFromObj) (Tcl_Interp *interp, Tcl_Obj *objPtr, Tk_Justify *justifyPtr); /* 206 */
+ int (*tk_GetMMFromObj) (Tcl_Interp *interp, Tk_Window tkwin, Tcl_Obj *objPtr, double *doublePtr); /* 207 */
+ int (*tk_GetPixelsFromObj) (Tcl_Interp *interp, Tk_Window tkwin, Tcl_Obj *objPtr, int *intPtr); /* 208 */
+ int (*tk_GetReliefFromObj) (Tcl_Interp *interp, Tcl_Obj *objPtr, int *resultPtr); /* 209 */
+ int (*tk_GetScrollInfoObj) (Tcl_Interp *interp, int objc, Tcl_Obj *const objv[], double *dblPtr, int *intPtr); /* 210 */
+ int (*tk_InitOptions) (Tcl_Interp *interp, char *recordPtr, Tk_OptionTable optionToken, Tk_Window tkwin); /* 211 */
+ void (*tk_MainEx) (int argc, char **argv, Tcl_AppInitProc *appInitProc, Tcl_Interp *interp); /* 212 */
+ void (*tk_RestoreSavedOptions) (Tk_SavedOptions *savePtr); /* 213 */
+ 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); /* 214 */
+ void (*tk_InitConsoleChannels) (Tcl_Interp *interp); /* 215 */
+ int (*tk_CreateConsoleWindow) (Tcl_Interp *interp); /* 216 */
+ void (*tk_CreateSmoothMethod) (Tcl_Interp *interp, const Tk_SmoothMethod *method); /* 217 */
+ void (*reserved218)(void);
+ void (*reserved219)(void);
+ int (*tk_GetDash) (Tcl_Interp *interp, const char *value, Tk_Dash *dash); /* 220 */
+ void (*tk_CreateOutline) (Tk_Outline *outline); /* 221 */
+ void (*tk_DeleteOutline) (Display *display, Tk_Outline *outline); /* 222 */
+ int (*tk_ConfigOutlineGC) (XGCValues *gcValues, Tk_Canvas canvas, Tk_Item *item, Tk_Outline *outline); /* 223 */
+ int (*tk_ChangeOutlineGC) (Tk_Canvas canvas, Tk_Item *item, Tk_Outline *outline); /* 224 */
+ int (*tk_ResetOutlineGC) (Tk_Canvas canvas, Tk_Item *item, Tk_Outline *outline); /* 225 */
+ int (*tk_CanvasPsOutline) (Tk_Canvas canvas, Tk_Item *item, Tk_Outline *outline); /* 226 */
+ void (*tk_SetTSOrigin) (Tk_Window tkwin, GC gc, int x, int y); /* 227 */
+ int (*tk_CanvasGetCoordFromObj) (Tcl_Interp *interp, Tk_Canvas canvas, Tcl_Obj *obj, double *doublePtr); /* 228 */
+ void (*tk_CanvasSetOffset) (Tk_Canvas canvas, GC gc, Tk_TSOffset *offset); /* 229 */
+ void (*tk_DitherPhoto) (Tk_PhotoHandle handle, int x, int y, int width, int height); /* 230 */
+ int (*tk_PostscriptBitmap) (Tcl_Interp *interp, Tk_Window tkwin, Tk_PostscriptInfo psInfo, Pixmap bitmap, int startX, int startY, int width, int height); /* 231 */
+ int (*tk_PostscriptColor) (Tcl_Interp *interp, Tk_PostscriptInfo psInfo, XColor *colorPtr); /* 232 */
+ int (*tk_PostscriptFont) (Tcl_Interp *interp, Tk_PostscriptInfo psInfo, Tk_Font font); /* 233 */
+ 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); /* 234 */
+ void (*tk_PostscriptPath) (Tcl_Interp *interp, Tk_PostscriptInfo psInfo, double *coordPtr, int numPoints); /* 235 */
+ int (*tk_PostscriptStipple) (Tcl_Interp *interp, Tk_Window tkwin, Tk_PostscriptInfo psInfo, Pixmap bitmap); /* 236 */
+ double (*tk_PostscriptY) (double y, Tk_PostscriptInfo psInfo); /* 237 */
+ int (*tk_PostscriptPhoto) (Tcl_Interp *interp, Tk_PhotoImageBlock *blockPtr, Tk_PostscriptInfo psInfo, int width, int height); /* 238 */
+ void (*tk_CreateClientMessageHandler) (Tk_ClientMessageProc *proc); /* 239 */
+ void (*tk_DeleteClientMessageHandler) (Tk_ClientMessageProc *proc); /* 240 */
+ Tk_Window (*tk_CreateAnonymousWindow) (Tcl_Interp *interp, Tk_Window parent, const char *screenName); /* 241 */
+ void (*tk_SetClassProcs) (Tk_Window tkwin, const Tk_ClassProcs *procs, ClientData instanceData); /* 242 */
+ void (*tk_SetInternalBorderEx) (Tk_Window tkwin, int left, int right, int top, int bottom); /* 243 */
+ void (*tk_SetMinimumRequestSize) (Tk_Window tkwin, int minWidth, int minHeight); /* 244 */
+ void (*tk_SetCaretPos) (Tk_Window tkwin, int x, int y, int height); /* 245 */
+ void (*tk_PhotoPutBlock_Panic) (Tk_PhotoHandle handle, Tk_PhotoImageBlock *blockPtr, int x, int y, int width, int height, int compRule); /* 246 */
+ void (*tk_PhotoPutZoomedBlock_Panic) (Tk_PhotoHandle handle, Tk_PhotoImageBlock *blockPtr, int x, int y, int width, int height, int zoomX, int zoomY, int subsampleX, int subsampleY, int compRule); /* 247 */
+ int (*tk_CollapseMotionEvents) (Display *display, int collapse); /* 248 */
+ Tk_StyleEngine (*tk_RegisterStyleEngine) (const char *name, Tk_StyleEngine parent); /* 249 */
+ Tk_StyleEngine (*tk_GetStyleEngine) (const char *name); /* 250 */
+ int (*tk_RegisterStyledElement) (Tk_StyleEngine engine, Tk_ElementSpec *templatePtr); /* 251 */
+ int (*tk_GetElementId) (const char *name); /* 252 */
+ Tk_Style (*tk_CreateStyle) (const char *name, Tk_StyleEngine engine, ClientData clientData); /* 253 */
+ Tk_Style (*tk_GetStyle) (Tcl_Interp *interp, const char *name); /* 254 */
+ void (*tk_FreeStyle) (Tk_Style style); /* 255 */
+ const char * (*tk_NameOfStyle) (Tk_Style style); /* 256 */
+ Tk_Style (*tk_AllocStyleFromObj) (Tcl_Interp *interp, Tcl_Obj *objPtr); /* 257 */
+ Tk_Style (*tk_GetStyleFromObj) (Tcl_Obj *objPtr); /* 258 */
+ void (*tk_FreeStyleFromObj) (Tcl_Obj *objPtr); /* 259 */
+ Tk_StyledElement (*tk_GetStyledElement) (Tk_Style style, int elementId, Tk_OptionTable optionTable); /* 260 */
+ void (*tk_GetElementSize) (Tk_Style style, Tk_StyledElement element, char *recordPtr, Tk_Window tkwin, int width, int height, int inner, int *widthPtr, int *heightPtr); /* 261 */
+ void (*tk_GetElementBox) (Tk_Style style, Tk_StyledElement element, char *recordPtr, Tk_Window tkwin, int x, int y, int width, int height, int inner, int *xPtr, int *yPtr, int *widthPtr, int *heightPtr); /* 262 */
+ int (*tk_GetElementBorderWidth) (Tk_Style style, Tk_StyledElement element, char *recordPtr, Tk_Window tkwin); /* 263 */
+ void (*tk_DrawElement) (Tk_Style style, Tk_StyledElement element, char *recordPtr, Tk_Window tkwin, Drawable d, int x, int y, int width, int height, int state); /* 264 */
+ int (*tk_PhotoExpand) (Tcl_Interp *interp, Tk_PhotoHandle handle, int width, int height); /* 265 */
+ int (*tk_PhotoPutBlock) (Tcl_Interp *interp, Tk_PhotoHandle handle, Tk_PhotoImageBlock *blockPtr, int x, int y, int width, int height, int compRule); /* 266 */
+ int (*tk_PhotoPutZoomedBlock) (Tcl_Interp *interp, Tk_PhotoHandle handle, Tk_PhotoImageBlock *blockPtr, int x, int y, int width, int height, int zoomX, int zoomY, int subsampleX, int subsampleY, int compRule); /* 267 */
+ int (*tk_PhotoSetSize) (Tcl_Interp *interp, Tk_PhotoHandle handle, int width, int height); /* 268 */
+ long (*tk_GetUserInactiveTime) (Display *dpy); /* 269 */
+ void (*tk_ResetUserInactiveTime) (Display *dpy); /* 270 */
+ Tcl_Interp * (*tk_Interp) (Tk_Window tkwin); /* 271 */
+ void (*tk_CreateOldImageType) (const Tk_ImageType *typePtr); /* 272 */
+ void (*tk_CreateOldPhotoImageFormat) (const Tk_PhotoImageFormat *formatPtr); /* 273 */
+} TkStubs;
+
+extern const TkStubs *tkStubsPtr;
+
+#ifdef __cplusplus
+}
+#endif
+
+#if defined(USE_TK_STUBS)
+
+/*
+ * Inline function declarations:
+ */
+
+#define Tk_MainLoop \
+ (tkStubsPtr->tk_MainLoop) /* 0 */
+#define Tk_3DBorderColor \
+ (tkStubsPtr->tk_3DBorderColor) /* 1 */
+#define Tk_3DBorderGC \
+ (tkStubsPtr->tk_3DBorderGC) /* 2 */
+#define Tk_3DHorizontalBevel \
+ (tkStubsPtr->tk_3DHorizontalBevel) /* 3 */
+#define Tk_3DVerticalBevel \
+ (tkStubsPtr->tk_3DVerticalBevel) /* 4 */
+#define Tk_AddOption \
+ (tkStubsPtr->tk_AddOption) /* 5 */
+#define Tk_BindEvent \
+ (tkStubsPtr->tk_BindEvent) /* 6 */
+#define Tk_CanvasDrawableCoords \
+ (tkStubsPtr->tk_CanvasDrawableCoords) /* 7 */
+#define Tk_CanvasEventuallyRedraw \
+ (tkStubsPtr->tk_CanvasEventuallyRedraw) /* 8 */
+#define Tk_CanvasGetCoord \
+ (tkStubsPtr->tk_CanvasGetCoord) /* 9 */
+#define Tk_CanvasGetTextInfo \
+ (tkStubsPtr->tk_CanvasGetTextInfo) /* 10 */
+#define Tk_CanvasPsBitmap \
+ (tkStubsPtr->tk_CanvasPsBitmap) /* 11 */
+#define Tk_CanvasPsColor \
+ (tkStubsPtr->tk_CanvasPsColor) /* 12 */
+#define Tk_CanvasPsFont \
+ (tkStubsPtr->tk_CanvasPsFont) /* 13 */
+#define Tk_CanvasPsPath \
+ (tkStubsPtr->tk_CanvasPsPath) /* 14 */
+#define Tk_CanvasPsStipple \
+ (tkStubsPtr->tk_CanvasPsStipple) /* 15 */
+#define Tk_CanvasPsY \
+ (tkStubsPtr->tk_CanvasPsY) /* 16 */
+#define Tk_CanvasSetStippleOrigin \
+ (tkStubsPtr->tk_CanvasSetStippleOrigin) /* 17 */
+#define Tk_CanvasTagsParseProc \
+ (tkStubsPtr->tk_CanvasTagsParseProc) /* 18 */
+#define Tk_CanvasTagsPrintProc \
+ (tkStubsPtr->tk_CanvasTagsPrintProc) /* 19 */
+#define Tk_CanvasTkwin \
+ (tkStubsPtr->tk_CanvasTkwin) /* 20 */
+#define Tk_CanvasWindowCoords \
+ (tkStubsPtr->tk_CanvasWindowCoords) /* 21 */
+#define Tk_ChangeWindowAttributes \
+ (tkStubsPtr->tk_ChangeWindowAttributes) /* 22 */
+#define Tk_CharBbox \
+ (tkStubsPtr->tk_CharBbox) /* 23 */
+#define Tk_ClearSelection \
+ (tkStubsPtr->tk_ClearSelection) /* 24 */
+#define Tk_ClipboardAppend \
+ (tkStubsPtr->tk_ClipboardAppend) /* 25 */
+#define Tk_ClipboardClear \
+ (tkStubsPtr->tk_ClipboardClear) /* 26 */
+#define Tk_ConfigureInfo \
+ (tkStubsPtr->tk_ConfigureInfo) /* 27 */
+#define Tk_ConfigureValue \
+ (tkStubsPtr->tk_ConfigureValue) /* 28 */
+#define Tk_ConfigureWidget \
+ (tkStubsPtr->tk_ConfigureWidget) /* 29 */
+#define Tk_ConfigureWindow \
+ (tkStubsPtr->tk_ConfigureWindow) /* 30 */
+#define Tk_ComputeTextLayout \
+ (tkStubsPtr->tk_ComputeTextLayout) /* 31 */
+#define Tk_CoordsToWindow \
+ (tkStubsPtr->tk_CoordsToWindow) /* 32 */
+#define Tk_CreateBinding \
+ (tkStubsPtr->tk_CreateBinding) /* 33 */
+#define Tk_CreateBindingTable \
+ (tkStubsPtr->tk_CreateBindingTable) /* 34 */
+#define Tk_CreateErrorHandler \
+ (tkStubsPtr->tk_CreateErrorHandler) /* 35 */
+#define Tk_CreateEventHandler \
+ (tkStubsPtr->tk_CreateEventHandler) /* 36 */
+#define Tk_CreateGenericHandler \
+ (tkStubsPtr->tk_CreateGenericHandler) /* 37 */
+#define Tk_CreateImageType \
+ (tkStubsPtr->tk_CreateImageType) /* 38 */
+#define Tk_CreateItemType \
+ (tkStubsPtr->tk_CreateItemType) /* 39 */
+#define Tk_CreatePhotoImageFormat \
+ (tkStubsPtr->tk_CreatePhotoImageFormat) /* 40 */
+#define Tk_CreateSelHandler \
+ (tkStubsPtr->tk_CreateSelHandler) /* 41 */
+#define Tk_CreateWindow \
+ (tkStubsPtr->tk_CreateWindow) /* 42 */
+#define Tk_CreateWindowFromPath \
+ (tkStubsPtr->tk_CreateWindowFromPath) /* 43 */
+#define Tk_DefineBitmap \
+ (tkStubsPtr->tk_DefineBitmap) /* 44 */
+#define Tk_DefineCursor \
+ (tkStubsPtr->tk_DefineCursor) /* 45 */
+#define Tk_DeleteAllBindings \
+ (tkStubsPtr->tk_DeleteAllBindings) /* 46 */
+#define Tk_DeleteBinding \
+ (tkStubsPtr->tk_DeleteBinding) /* 47 */
+#define Tk_DeleteBindingTable \
+ (tkStubsPtr->tk_DeleteBindingTable) /* 48 */
+#define Tk_DeleteErrorHandler \
+ (tkStubsPtr->tk_DeleteErrorHandler) /* 49 */
+#define Tk_DeleteEventHandler \
+ (tkStubsPtr->tk_DeleteEventHandler) /* 50 */
+#define Tk_DeleteGenericHandler \
+ (tkStubsPtr->tk_DeleteGenericHandler) /* 51 */
+#define Tk_DeleteImage \
+ (tkStubsPtr->tk_DeleteImage) /* 52 */
+#define Tk_DeleteSelHandler \
+ (tkStubsPtr->tk_DeleteSelHandler) /* 53 */
+#define Tk_DestroyWindow \
+ (tkStubsPtr->tk_DestroyWindow) /* 54 */
+#define Tk_DisplayName \
+ (tkStubsPtr->tk_DisplayName) /* 55 */
+#define Tk_DistanceToTextLayout \
+ (tkStubsPtr->tk_DistanceToTextLayout) /* 56 */
+#define Tk_Draw3DPolygon \
+ (tkStubsPtr->tk_Draw3DPolygon) /* 57 */
+#define Tk_Draw3DRectangle \
+ (tkStubsPtr->tk_Draw3DRectangle) /* 58 */
+#define Tk_DrawChars \
+ (tkStubsPtr->tk_DrawChars) /* 59 */
+#define Tk_DrawFocusHighlight \
+ (tkStubsPtr->tk_DrawFocusHighlight) /* 60 */
+#define Tk_DrawTextLayout \
+ (tkStubsPtr->tk_DrawTextLayout) /* 61 */
+#define Tk_Fill3DPolygon \
+ (tkStubsPtr->tk_Fill3DPolygon) /* 62 */
+#define Tk_Fill3DRectangle \
+ (tkStubsPtr->tk_Fill3DRectangle) /* 63 */
+#define Tk_FindPhoto \
+ (tkStubsPtr->tk_FindPhoto) /* 64 */
+#define Tk_FontId \
+ (tkStubsPtr->tk_FontId) /* 65 */
+#define Tk_Free3DBorder \
+ (tkStubsPtr->tk_Free3DBorder) /* 66 */
+#define Tk_FreeBitmap \
+ (tkStubsPtr->tk_FreeBitmap) /* 67 */
+#define Tk_FreeColor \
+ (tkStubsPtr->tk_FreeColor) /* 68 */
+#define Tk_FreeColormap \
+ (tkStubsPtr->tk_FreeColormap) /* 69 */
+#define Tk_FreeCursor \
+ (tkStubsPtr->tk_FreeCursor) /* 70 */
+#define Tk_FreeFont \
+ (tkStubsPtr->tk_FreeFont) /* 71 */
+#define Tk_FreeGC \
+ (tkStubsPtr->tk_FreeGC) /* 72 */
+#define Tk_FreeImage \
+ (tkStubsPtr->tk_FreeImage) /* 73 */
+#define Tk_FreeOptions \
+ (tkStubsPtr->tk_FreeOptions) /* 74 */
+#define Tk_FreePixmap \
+ (tkStubsPtr->tk_FreePixmap) /* 75 */
+#define Tk_FreeTextLayout \
+ (tkStubsPtr->tk_FreeTextLayout) /* 76 */
+#define Tk_FreeXId \
+ (tkStubsPtr->tk_FreeXId) /* 77 */
+#define Tk_GCForColor \
+ (tkStubsPtr->tk_GCForColor) /* 78 */
+#define Tk_GeometryRequest \
+ (tkStubsPtr->tk_GeometryRequest) /* 79 */
+#define Tk_Get3DBorder \
+ (tkStubsPtr->tk_Get3DBorder) /* 80 */
+#define Tk_GetAllBindings \
+ (tkStubsPtr->tk_GetAllBindings) /* 81 */
+#define Tk_GetAnchor \
+ (tkStubsPtr->tk_GetAnchor) /* 82 */
+#define Tk_GetAtomName \
+ (tkStubsPtr->tk_GetAtomName) /* 83 */
+#define Tk_GetBinding \
+ (tkStubsPtr->tk_GetBinding) /* 84 */
+#define Tk_GetBitmap \
+ (tkStubsPtr->tk_GetBitmap) /* 85 */
+#define Tk_GetBitmapFromData \
+ (tkStubsPtr->tk_GetBitmapFromData) /* 86 */
+#define Tk_GetCapStyle \
+ (tkStubsPtr->tk_GetCapStyle) /* 87 */
+#define Tk_GetColor \
+ (tkStubsPtr->tk_GetColor) /* 88 */
+#define Tk_GetColorByValue \
+ (tkStubsPtr->tk_GetColorByValue) /* 89 */
+#define Tk_GetColormap \
+ (tkStubsPtr->tk_GetColormap) /* 90 */
+#define Tk_GetCursor \
+ (tkStubsPtr->tk_GetCursor) /* 91 */
+#define Tk_GetCursorFromData \
+ (tkStubsPtr->tk_GetCursorFromData) /* 92 */
+#define Tk_GetFont \
+ (tkStubsPtr->tk_GetFont) /* 93 */
+#define Tk_GetFontFromObj \
+ (tkStubsPtr->tk_GetFontFromObj) /* 94 */
+#define Tk_GetFontMetrics \
+ (tkStubsPtr->tk_GetFontMetrics) /* 95 */
+#define Tk_GetGC \
+ (tkStubsPtr->tk_GetGC) /* 96 */
+#define Tk_GetImage \
+ (tkStubsPtr->tk_GetImage) /* 97 */
+#define Tk_GetImageMasterData \
+ (tkStubsPtr->tk_GetImageMasterData) /* 98 */
+#define Tk_GetItemTypes \
+ (tkStubsPtr->tk_GetItemTypes) /* 99 */
+#define Tk_GetJoinStyle \
+ (tkStubsPtr->tk_GetJoinStyle) /* 100 */
+#define Tk_GetJustify \
+ (tkStubsPtr->tk_GetJustify) /* 101 */
+#define Tk_GetNumMainWindows \
+ (tkStubsPtr->tk_GetNumMainWindows) /* 102 */
+#define Tk_GetOption \
+ (tkStubsPtr->tk_GetOption) /* 103 */
+#define Tk_GetPixels \
+ (tkStubsPtr->tk_GetPixels) /* 104 */
+#define Tk_GetPixmap \
+ (tkStubsPtr->tk_GetPixmap) /* 105 */
+#define Tk_GetRelief \
+ (tkStubsPtr->tk_GetRelief) /* 106 */
+#define Tk_GetRootCoords \
+ (tkStubsPtr->tk_GetRootCoords) /* 107 */
+#define Tk_GetScrollInfo \
+ (tkStubsPtr->tk_GetScrollInfo) /* 108 */
+#define Tk_GetScreenMM \
+ (tkStubsPtr->tk_GetScreenMM) /* 109 */
+#define Tk_GetSelection \
+ (tkStubsPtr->tk_GetSelection) /* 110 */
+#define Tk_GetUid \
+ (tkStubsPtr->tk_GetUid) /* 111 */
+#define Tk_GetVisual \
+ (tkStubsPtr->tk_GetVisual) /* 112 */
+#define Tk_GetVRootGeometry \
+ (tkStubsPtr->tk_GetVRootGeometry) /* 113 */
+#define Tk_Grab \
+ (tkStubsPtr->tk_Grab) /* 114 */
+#define Tk_HandleEvent \
+ (tkStubsPtr->tk_HandleEvent) /* 115 */
+#define Tk_IdToWindow \
+ (tkStubsPtr->tk_IdToWindow) /* 116 */
+#define Tk_ImageChanged \
+ (tkStubsPtr->tk_ImageChanged) /* 117 */
+#define Tk_Init \
+ (tkStubsPtr->tk_Init) /* 118 */
+#define Tk_InternAtom \
+ (tkStubsPtr->tk_InternAtom) /* 119 */
+#define Tk_IntersectTextLayout \
+ (tkStubsPtr->tk_IntersectTextLayout) /* 120 */
+#define Tk_MaintainGeometry \
+ (tkStubsPtr->tk_MaintainGeometry) /* 121 */
+#define Tk_MainWindow \
+ (tkStubsPtr->tk_MainWindow) /* 122 */
+#define Tk_MakeWindowExist \
+ (tkStubsPtr->tk_MakeWindowExist) /* 123 */
+#define Tk_ManageGeometry \
+ (tkStubsPtr->tk_ManageGeometry) /* 124 */
+#define Tk_MapWindow \
+ (tkStubsPtr->tk_MapWindow) /* 125 */
+#define Tk_MeasureChars \
+ (tkStubsPtr->tk_MeasureChars) /* 126 */
+#define Tk_MoveResizeWindow \
+ (tkStubsPtr->tk_MoveResizeWindow) /* 127 */
+#define Tk_MoveWindow \
+ (tkStubsPtr->tk_MoveWindow) /* 128 */
+#define Tk_MoveToplevelWindow \
+ (tkStubsPtr->tk_MoveToplevelWindow) /* 129 */
+#define Tk_NameOf3DBorder \
+ (tkStubsPtr->tk_NameOf3DBorder) /* 130 */
+#define Tk_NameOfAnchor \
+ (tkStubsPtr->tk_NameOfAnchor) /* 131 */
+#define Tk_NameOfBitmap \
+ (tkStubsPtr->tk_NameOfBitmap) /* 132 */
+#define Tk_NameOfCapStyle \
+ (tkStubsPtr->tk_NameOfCapStyle) /* 133 */
+#define Tk_NameOfColor \
+ (tkStubsPtr->tk_NameOfColor) /* 134 */
+#define Tk_NameOfCursor \
+ (tkStubsPtr->tk_NameOfCursor) /* 135 */
+#define Tk_NameOfFont \
+ (tkStubsPtr->tk_NameOfFont) /* 136 */
+#define Tk_NameOfImage \
+ (tkStubsPtr->tk_NameOfImage) /* 137 */
+#define Tk_NameOfJoinStyle \
+ (tkStubsPtr->tk_NameOfJoinStyle) /* 138 */
+#define Tk_NameOfJustify \
+ (tkStubsPtr->tk_NameOfJustify) /* 139 */
+#define Tk_NameOfRelief \
+ (tkStubsPtr->tk_NameOfRelief) /* 140 */
+#define Tk_NameToWindow \
+ (tkStubsPtr->tk_NameToWindow) /* 141 */
+#define Tk_OwnSelection \
+ (tkStubsPtr->tk_OwnSelection) /* 142 */
+#define Tk_ParseArgv \
+ (tkStubsPtr->tk_ParseArgv) /* 143 */
+#define Tk_PhotoPutBlock_NoComposite \
+ (tkStubsPtr->tk_PhotoPutBlock_NoComposite) /* 144 */
+#define Tk_PhotoPutZoomedBlock_NoComposite \
+ (tkStubsPtr->tk_PhotoPutZoomedBlock_NoComposite) /* 145 */
+#define Tk_PhotoGetImage \
+ (tkStubsPtr->tk_PhotoGetImage) /* 146 */
+#define Tk_PhotoBlank \
+ (tkStubsPtr->tk_PhotoBlank) /* 147 */
+#define Tk_PhotoExpand_Panic \
+ (tkStubsPtr->tk_PhotoExpand_Panic) /* 148 */
+#define Tk_PhotoGetSize \
+ (tkStubsPtr->tk_PhotoGetSize) /* 149 */
+#define Tk_PhotoSetSize_Panic \
+ (tkStubsPtr->tk_PhotoSetSize_Panic) /* 150 */
+#define Tk_PointToChar \
+ (tkStubsPtr->tk_PointToChar) /* 151 */
+#define Tk_PostscriptFontName \
+ (tkStubsPtr->tk_PostscriptFontName) /* 152 */
+#define Tk_PreserveColormap \
+ (tkStubsPtr->tk_PreserveColormap) /* 153 */
+#define Tk_QueueWindowEvent \
+ (tkStubsPtr->tk_QueueWindowEvent) /* 154 */
+#define Tk_RedrawImage \
+ (tkStubsPtr->tk_RedrawImage) /* 155 */
+#define Tk_ResizeWindow \
+ (tkStubsPtr->tk_ResizeWindow) /* 156 */
+#define Tk_RestackWindow \
+ (tkStubsPtr->tk_RestackWindow) /* 157 */
+#define Tk_RestrictEvents \
+ (tkStubsPtr->tk_RestrictEvents) /* 158 */
+#define Tk_SafeInit \
+ (tkStubsPtr->tk_SafeInit) /* 159 */
+#define Tk_SetAppName \
+ (tkStubsPtr->tk_SetAppName) /* 160 */
+#define Tk_SetBackgroundFromBorder \
+ (tkStubsPtr->tk_SetBackgroundFromBorder) /* 161 */
+#define Tk_SetClass \
+ (tkStubsPtr->tk_SetClass) /* 162 */
+#define Tk_SetGrid \
+ (tkStubsPtr->tk_SetGrid) /* 163 */
+#define Tk_SetInternalBorder \
+ (tkStubsPtr->tk_SetInternalBorder) /* 164 */
+#define Tk_SetWindowBackground \
+ (tkStubsPtr->tk_SetWindowBackground) /* 165 */
+#define Tk_SetWindowBackgroundPixmap \
+ (tkStubsPtr->tk_SetWindowBackgroundPixmap) /* 166 */
+#define Tk_SetWindowBorder \
+ (tkStubsPtr->tk_SetWindowBorder) /* 167 */
+#define Tk_SetWindowBorderWidth \
+ (tkStubsPtr->tk_SetWindowBorderWidth) /* 168 */
+#define Tk_SetWindowBorderPixmap \
+ (tkStubsPtr->tk_SetWindowBorderPixmap) /* 169 */
+#define Tk_SetWindowColormap \
+ (tkStubsPtr->tk_SetWindowColormap) /* 170 */
+#define Tk_SetWindowVisual \
+ (tkStubsPtr->tk_SetWindowVisual) /* 171 */
+#define Tk_SizeOfBitmap \
+ (tkStubsPtr->tk_SizeOfBitmap) /* 172 */
+#define Tk_SizeOfImage \
+ (tkStubsPtr->tk_SizeOfImage) /* 173 */
+#define Tk_StrictMotif \
+ (tkStubsPtr->tk_StrictMotif) /* 174 */
+#define Tk_TextLayoutToPostscript \
+ (tkStubsPtr->tk_TextLayoutToPostscript) /* 175 */
+#define Tk_TextWidth \
+ (tkStubsPtr->tk_TextWidth) /* 176 */
+#define Tk_UndefineCursor \
+ (tkStubsPtr->tk_UndefineCursor) /* 177 */
+#define Tk_UnderlineChars \
+ (tkStubsPtr->tk_UnderlineChars) /* 178 */
+#define Tk_UnderlineTextLayout \
+ (tkStubsPtr->tk_UnderlineTextLayout) /* 179 */
+#define Tk_Ungrab \
+ (tkStubsPtr->tk_Ungrab) /* 180 */
+#define Tk_UnmaintainGeometry \
+ (tkStubsPtr->tk_UnmaintainGeometry) /* 181 */
+#define Tk_UnmapWindow \
+ (tkStubsPtr->tk_UnmapWindow) /* 182 */
+#define Tk_UnsetGrid \
+ (tkStubsPtr->tk_UnsetGrid) /* 183 */
+#define Tk_UpdatePointer \
+ (tkStubsPtr->tk_UpdatePointer) /* 184 */
+#define Tk_AllocBitmapFromObj \
+ (tkStubsPtr->tk_AllocBitmapFromObj) /* 185 */
+#define Tk_Alloc3DBorderFromObj \
+ (tkStubsPtr->tk_Alloc3DBorderFromObj) /* 186 */
+#define Tk_AllocColorFromObj \
+ (tkStubsPtr->tk_AllocColorFromObj) /* 187 */
+#define Tk_AllocCursorFromObj \
+ (tkStubsPtr->tk_AllocCursorFromObj) /* 188 */
+#define Tk_AllocFontFromObj \
+ (tkStubsPtr->tk_AllocFontFromObj) /* 189 */
+#define Tk_CreateOptionTable \
+ (tkStubsPtr->tk_CreateOptionTable) /* 190 */
+#define Tk_DeleteOptionTable \
+ (tkStubsPtr->tk_DeleteOptionTable) /* 191 */
+#define Tk_Free3DBorderFromObj \
+ (tkStubsPtr->tk_Free3DBorderFromObj) /* 192 */
+#define Tk_FreeBitmapFromObj \
+ (tkStubsPtr->tk_FreeBitmapFromObj) /* 193 */
+#define Tk_FreeColorFromObj \
+ (tkStubsPtr->tk_FreeColorFromObj) /* 194 */
+#define Tk_FreeConfigOptions \
+ (tkStubsPtr->tk_FreeConfigOptions) /* 195 */
+#define Tk_FreeSavedOptions \
+ (tkStubsPtr->tk_FreeSavedOptions) /* 196 */
+#define Tk_FreeCursorFromObj \
+ (tkStubsPtr->tk_FreeCursorFromObj) /* 197 */
+#define Tk_FreeFontFromObj \
+ (tkStubsPtr->tk_FreeFontFromObj) /* 198 */
+#define Tk_Get3DBorderFromObj \
+ (tkStubsPtr->tk_Get3DBorderFromObj) /* 199 */
+#define Tk_GetAnchorFromObj \
+ (tkStubsPtr->tk_GetAnchorFromObj) /* 200 */
+#define Tk_GetBitmapFromObj \
+ (tkStubsPtr->tk_GetBitmapFromObj) /* 201 */
+#define Tk_GetColorFromObj \
+ (tkStubsPtr->tk_GetColorFromObj) /* 202 */
+#define Tk_GetCursorFromObj \
+ (tkStubsPtr->tk_GetCursorFromObj) /* 203 */
+#define Tk_GetOptionInfo \
+ (tkStubsPtr->tk_GetOptionInfo) /* 204 */
+#define Tk_GetOptionValue \
+ (tkStubsPtr->tk_GetOptionValue) /* 205 */
+#define Tk_GetJustifyFromObj \
+ (tkStubsPtr->tk_GetJustifyFromObj) /* 206 */
+#define Tk_GetMMFromObj \
+ (tkStubsPtr->tk_GetMMFromObj) /* 207 */
+#define Tk_GetPixelsFromObj \
+ (tkStubsPtr->tk_GetPixelsFromObj) /* 208 */
+#define Tk_GetReliefFromObj \
+ (tkStubsPtr->tk_GetReliefFromObj) /* 209 */
+#define Tk_GetScrollInfoObj \
+ (tkStubsPtr->tk_GetScrollInfoObj) /* 210 */
+#define Tk_InitOptions \
+ (tkStubsPtr->tk_InitOptions) /* 211 */
+#define Tk_MainEx \
+ (tkStubsPtr->tk_MainEx) /* 212 */
+#define Tk_RestoreSavedOptions \
+ (tkStubsPtr->tk_RestoreSavedOptions) /* 213 */
+#define Tk_SetOptions \
+ (tkStubsPtr->tk_SetOptions) /* 214 */
+#define Tk_InitConsoleChannels \
+ (tkStubsPtr->tk_InitConsoleChannels) /* 215 */
+#define Tk_CreateConsoleWindow \
+ (tkStubsPtr->tk_CreateConsoleWindow) /* 216 */
+#define Tk_CreateSmoothMethod \
+ (tkStubsPtr->tk_CreateSmoothMethod) /* 217 */
+/* Slot 218 is reserved */
+/* Slot 219 is reserved */
+#define Tk_GetDash \
+ (tkStubsPtr->tk_GetDash) /* 220 */
+#define Tk_CreateOutline \
+ (tkStubsPtr->tk_CreateOutline) /* 221 */
+#define Tk_DeleteOutline \
+ (tkStubsPtr->tk_DeleteOutline) /* 222 */
+#define Tk_ConfigOutlineGC \
+ (tkStubsPtr->tk_ConfigOutlineGC) /* 223 */
+#define Tk_ChangeOutlineGC \
+ (tkStubsPtr->tk_ChangeOutlineGC) /* 224 */
+#define Tk_ResetOutlineGC \
+ (tkStubsPtr->tk_ResetOutlineGC) /* 225 */
+#define Tk_CanvasPsOutline \
+ (tkStubsPtr->tk_CanvasPsOutline) /* 226 */
+#define Tk_SetTSOrigin \
+ (tkStubsPtr->tk_SetTSOrigin) /* 227 */
+#define Tk_CanvasGetCoordFromObj \
+ (tkStubsPtr->tk_CanvasGetCoordFromObj) /* 228 */
+#define Tk_CanvasSetOffset \
+ (tkStubsPtr->tk_CanvasSetOffset) /* 229 */
+#define Tk_DitherPhoto \
+ (tkStubsPtr->tk_DitherPhoto) /* 230 */
+#define Tk_PostscriptBitmap \
+ (tkStubsPtr->tk_PostscriptBitmap) /* 231 */
+#define Tk_PostscriptColor \
+ (tkStubsPtr->tk_PostscriptColor) /* 232 */
+#define Tk_PostscriptFont \
+ (tkStubsPtr->tk_PostscriptFont) /* 233 */
+#define Tk_PostscriptImage \
+ (tkStubsPtr->tk_PostscriptImage) /* 234 */
+#define Tk_PostscriptPath \
+ (tkStubsPtr->tk_PostscriptPath) /* 235 */
+#define Tk_PostscriptStipple \
+ (tkStubsPtr->tk_PostscriptStipple) /* 236 */
+#define Tk_PostscriptY \
+ (tkStubsPtr->tk_PostscriptY) /* 237 */
+#define Tk_PostscriptPhoto \
+ (tkStubsPtr->tk_PostscriptPhoto) /* 238 */
+#define Tk_CreateClientMessageHandler \
+ (tkStubsPtr->tk_CreateClientMessageHandler) /* 239 */
+#define Tk_DeleteClientMessageHandler \
+ (tkStubsPtr->tk_DeleteClientMessageHandler) /* 240 */
+#define Tk_CreateAnonymousWindow \
+ (tkStubsPtr->tk_CreateAnonymousWindow) /* 241 */
+#define Tk_SetClassProcs \
+ (tkStubsPtr->tk_SetClassProcs) /* 242 */
+#define Tk_SetInternalBorderEx \
+ (tkStubsPtr->tk_SetInternalBorderEx) /* 243 */
+#define Tk_SetMinimumRequestSize \
+ (tkStubsPtr->tk_SetMinimumRequestSize) /* 244 */
+#define Tk_SetCaretPos \
+ (tkStubsPtr->tk_SetCaretPos) /* 245 */
+#define Tk_PhotoPutBlock_Panic \
+ (tkStubsPtr->tk_PhotoPutBlock_Panic) /* 246 */
+#define Tk_PhotoPutZoomedBlock_Panic \
+ (tkStubsPtr->tk_PhotoPutZoomedBlock_Panic) /* 247 */
+#define Tk_CollapseMotionEvents \
+ (tkStubsPtr->tk_CollapseMotionEvents) /* 248 */
+#define Tk_RegisterStyleEngine \
+ (tkStubsPtr->tk_RegisterStyleEngine) /* 249 */
+#define Tk_GetStyleEngine \
+ (tkStubsPtr->tk_GetStyleEngine) /* 250 */
+#define Tk_RegisterStyledElement \
+ (tkStubsPtr->tk_RegisterStyledElement) /* 251 */
+#define Tk_GetElementId \
+ (tkStubsPtr->tk_GetElementId) /* 252 */
+#define Tk_CreateStyle \
+ (tkStubsPtr->tk_CreateStyle) /* 253 */
+#define Tk_GetStyle \
+ (tkStubsPtr->tk_GetStyle) /* 254 */
+#define Tk_FreeStyle \
+ (tkStubsPtr->tk_FreeStyle) /* 255 */
+#define Tk_NameOfStyle \
+ (tkStubsPtr->tk_NameOfStyle) /* 256 */
+#define Tk_AllocStyleFromObj \
+ (tkStubsPtr->tk_AllocStyleFromObj) /* 257 */
+#define Tk_GetStyleFromObj \
+ (tkStubsPtr->tk_GetStyleFromObj) /* 258 */
+#define Tk_FreeStyleFromObj \
+ (tkStubsPtr->tk_FreeStyleFromObj) /* 259 */
+#define Tk_GetStyledElement \
+ (tkStubsPtr->tk_GetStyledElement) /* 260 */
+#define Tk_GetElementSize \
+ (tkStubsPtr->tk_GetElementSize) /* 261 */
+#define Tk_GetElementBox \
+ (tkStubsPtr->tk_GetElementBox) /* 262 */
+#define Tk_GetElementBorderWidth \
+ (tkStubsPtr->tk_GetElementBorderWidth) /* 263 */
+#define Tk_DrawElement \
+ (tkStubsPtr->tk_DrawElement) /* 264 */
+#define Tk_PhotoExpand \
+ (tkStubsPtr->tk_PhotoExpand) /* 265 */
+#define Tk_PhotoPutBlock \
+ (tkStubsPtr->tk_PhotoPutBlock) /* 266 */
+#define Tk_PhotoPutZoomedBlock \
+ (tkStubsPtr->tk_PhotoPutZoomedBlock) /* 267 */
+#define Tk_PhotoSetSize \
+ (tkStubsPtr->tk_PhotoSetSize) /* 268 */
+#define Tk_GetUserInactiveTime \
+ (tkStubsPtr->tk_GetUserInactiveTime) /* 269 */
+#define Tk_ResetUserInactiveTime \
+ (tkStubsPtr->tk_ResetUserInactiveTime) /* 270 */
+#define Tk_Interp \
+ (tkStubsPtr->tk_Interp) /* 271 */
+#define Tk_CreateOldImageType \
+ (tkStubsPtr->tk_CreateOldImageType) /* 272 */
+#define Tk_CreateOldPhotoImageFormat \
+ (tkStubsPtr->tk_CreateOldPhotoImageFormat) /* 273 */
+
+#endif /* defined(USE_TK_STUBS) */
+
+/* !END!: Do not edit above this line. */
+
+/* Functions that don't belong in the stub table */
+#undef Tk_MainEx
+#undef Tk_Init
+#undef Tk_SafeInit
+#undef Tk_CreateConsoleWindow
+
+#if defined(_WIN32) && defined(UNICODE)
+# define Tk_MainEx Tk_MainExW
+ EXTERN void Tk_MainExW(int argc, wchar_t **argv,
+ Tcl_AppInitProc *appInitProc, Tcl_Interp *interp);
+#endif
+
+#undef TCL_STORAGE_CLASS
+#define TCL_STORAGE_CLASS DLLIMPORT
+
+#endif /* _TKDECLS */
diff --git a/tk8.6/generic/tkEntry.c b/tk8.6/generic/tkEntry.c
new file mode 100644
index 0000000..ea8d7f1
--- /dev/null
+++ b/tk8.6/generic/tkEntry.c
@@ -0,0 +1,4491 @@
+/*
+ * tkEntry.c --
+ *
+ * This module implements entry and spinbox widgets for the Tk toolkit.
+ * An entry displays a string and allows the string to be edited. A
+ * spinbox expands on the entry by adding up/down buttons that control
+ * the value of the entry widget.
+ *
+ * Copyright (c) 1990-1994 The Regents of the University of California.
+ * Copyright (c) 1994-1997 Sun Microsystems, Inc.
+ * Copyright (c) 2000 Ajuba Solutions.
+ * Copyright (c) 2002 ActiveState Corporation.
+ *
+ * See the file "license.terms" for information on usage and redistribution of
+ * this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ */
+
+#include "tkInt.h"
+#include "default.h"
+#include "tkEntry.h"
+
+/*
+ * The following macro defines how many extra pixels to leave on each side of
+ * the text in the entry.
+ */
+
+#define XPAD 1
+#define YPAD 1
+
+/*
+ * A comparison function for double values. For Spinboxes.
+ */
+
+#define MIN_DBL_VAL 1E-9
+#define DOUBLES_EQ(d1, d2) (fabs((d1) - (d2)) < MIN_DBL_VAL)
+
+
+static const char *const stateStrings[] = {
+ "disabled", "normal", "readonly", NULL
+};
+
+/*
+ * Definitions for -validate option values:
+ */
+
+static const char *const validateStrings[] = {
+ "all", "key", "focus", "focusin", "focusout", "none", NULL
+};
+enum validateType {
+ VALIDATE_ALL, VALIDATE_KEY, VALIDATE_FOCUS,
+ VALIDATE_FOCUSIN, VALIDATE_FOCUSOUT, VALIDATE_NONE,
+ /*
+ * These extra enums are for use with EntryValidateChange
+ */
+ VALIDATE_FORCED, VALIDATE_DELETE, VALIDATE_INSERT, VALIDATE_BUTTON
+};
+#define DEF_ENTRY_VALIDATE "none"
+#define DEF_ENTRY_INVALIDCMD ""
+
+/*
+ * Information used for Entry objv parsing.
+ */
+
+static const Tk_OptionSpec entryOptSpec[] = {
+ {TK_OPTION_BORDER, "-background", "background", "Background",
+ DEF_ENTRY_BG_COLOR, -1, Tk_Offset(Entry, normalBorder),
+ 0, DEF_ENTRY_BG_MONO, 0},
+ {TK_OPTION_SYNONYM, "-bd", NULL, NULL,
+ NULL, 0, -1, 0, "-borderwidth", 0},
+ {TK_OPTION_SYNONYM, "-bg", NULL, NULL,
+ NULL, 0, -1, 0, "-background", 0},
+ {TK_OPTION_PIXELS, "-borderwidth", "borderWidth", "BorderWidth",
+ DEF_ENTRY_BORDER_WIDTH, -1, Tk_Offset(Entry, borderWidth), 0, 0, 0},
+ {TK_OPTION_CURSOR, "-cursor", "cursor", "Cursor",
+ DEF_ENTRY_CURSOR, -1, Tk_Offset(Entry, cursor),
+ TK_OPTION_NULL_OK, 0, 0},
+ {TK_OPTION_BORDER, "-disabledbackground", "disabledBackground",
+ "DisabledBackground", DEF_ENTRY_DISABLED_BG_COLOR, -1,
+ Tk_Offset(Entry, disabledBorder), TK_OPTION_NULL_OK,
+ (ClientData) DEF_ENTRY_DISABLED_BG_MONO, 0},
+ {TK_OPTION_COLOR, "-disabledforeground", "disabledForeground",
+ "DisabledForeground", DEF_ENTRY_DISABLED_FG, -1,
+ Tk_Offset(Entry, dfgColorPtr), TK_OPTION_NULL_OK, 0, 0},
+ {TK_OPTION_BOOLEAN, "-exportselection", "exportSelection",
+ "ExportSelection", DEF_ENTRY_EXPORT_SELECTION, -1,
+ Tk_Offset(Entry, exportSelection), 0, 0, 0},
+ {TK_OPTION_SYNONYM, "-fg", "foreground", NULL,
+ NULL, 0, -1, 0, "-foreground", 0},
+ {TK_OPTION_FONT, "-font", "font", "Font",
+ DEF_ENTRY_FONT, -1, Tk_Offset(Entry, tkfont), 0, 0, 0},
+ {TK_OPTION_COLOR, "-foreground", "foreground", "Foreground",
+ DEF_ENTRY_FG, -1, Tk_Offset(Entry, fgColorPtr), 0, 0, 0},
+ {TK_OPTION_COLOR, "-highlightbackground", "highlightBackground",
+ "HighlightBackground", DEF_ENTRY_HIGHLIGHT_BG,
+ -1, Tk_Offset(Entry, highlightBgColorPtr), 0, 0, 0},
+ {TK_OPTION_COLOR, "-highlightcolor", "highlightColor", "HighlightColor",
+ DEF_ENTRY_HIGHLIGHT, -1, Tk_Offset(Entry, highlightColorPtr), 0, 0, 0},
+ {TK_OPTION_PIXELS, "-highlightthickness", "highlightThickness",
+ "HighlightThickness", DEF_ENTRY_HIGHLIGHT_WIDTH, -1,
+ Tk_Offset(Entry, highlightWidth), 0, 0, 0},
+ {TK_OPTION_BORDER, "-insertbackground", "insertBackground", "Foreground",
+ DEF_ENTRY_INSERT_BG, -1, Tk_Offset(Entry, insertBorder), 0, 0, 0},
+ {TK_OPTION_PIXELS, "-insertborderwidth", "insertBorderWidth",
+ "BorderWidth", DEF_ENTRY_INSERT_BD_COLOR, -1,
+ Tk_Offset(Entry, insertBorderWidth), 0,
+ (ClientData) DEF_ENTRY_INSERT_BD_MONO, 0},
+ {TK_OPTION_INT, "-insertofftime", "insertOffTime", "OffTime",
+ DEF_ENTRY_INSERT_OFF_TIME, -1, Tk_Offset(Entry, insertOffTime),
+ 0, 0, 0},
+ {TK_OPTION_INT, "-insertontime", "insertOnTime", "OnTime",
+ DEF_ENTRY_INSERT_ON_TIME, -1, Tk_Offset(Entry, insertOnTime), 0, 0, 0},
+ {TK_OPTION_PIXELS, "-insertwidth", "insertWidth", "InsertWidth",
+ DEF_ENTRY_INSERT_WIDTH, -1, Tk_Offset(Entry, insertWidth), 0, 0, 0},
+ {TK_OPTION_STRING, "-invalidcommand", "invalidCommand", "InvalidCommand",
+ DEF_ENTRY_INVALIDCMD, -1, Tk_Offset(Entry, invalidCmd),
+ TK_OPTION_NULL_OK, 0, 0},
+ {TK_OPTION_SYNONYM, "-invcmd", NULL, NULL,
+ NULL, 0, -1, 0, "-invalidcommand", 0},
+ {TK_OPTION_JUSTIFY, "-justify", "justify", "Justify",
+ DEF_ENTRY_JUSTIFY, -1, Tk_Offset(Entry, justify), 0, 0, 0},
+ {TK_OPTION_BORDER, "-readonlybackground", "readonlyBackground",
+ "ReadonlyBackground", DEF_ENTRY_READONLY_BG_COLOR, -1,
+ Tk_Offset(Entry, readonlyBorder), TK_OPTION_NULL_OK,
+ (ClientData) DEF_ENTRY_READONLY_BG_MONO, 0},
+ {TK_OPTION_RELIEF, "-relief", "relief", "Relief",
+ DEF_ENTRY_RELIEF, -1, Tk_Offset(Entry, relief), 0, 0, 0},
+ {TK_OPTION_BORDER, "-selectbackground", "selectBackground", "Foreground",
+ DEF_ENTRY_SELECT_COLOR, -1, Tk_Offset(Entry, selBorder),
+ 0, DEF_ENTRY_SELECT_MONO, 0},
+ {TK_OPTION_PIXELS, "-selectborderwidth", "selectBorderWidth",
+ "BorderWidth", DEF_ENTRY_SELECT_BD_COLOR, -1,
+ Tk_Offset(Entry, selBorderWidth),
+ 0, DEF_ENTRY_SELECT_BD_MONO, 0},
+ {TK_OPTION_COLOR, "-selectforeground", "selectForeground", "Background",
+ DEF_ENTRY_SELECT_FG_COLOR, -1, Tk_Offset(Entry, selFgColorPtr),
+ TK_OPTION_NULL_OK, 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, 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, validateStrings, 0},
+ {TK_OPTION_STRING, "-validatecommand", "validateCommand","ValidateCommand",
+ NULL, -1, Tk_Offset(Entry, validateCmd), TK_OPTION_NULL_OK, 0, 0},
+ {TK_OPTION_SYNONYM, "-vcmd", NULL, NULL,
+ NULL, 0, -1, 0, "-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, NULL, NULL, NULL, NULL, 0, -1, 0, 0, 0}
+};
+
+/*
+ * Information used for Spinbox objv parsing.
+ */
+
+#define DEF_SPINBOX_REPEAT_DELAY "400"
+#define DEF_SPINBOX_REPEAT_INTERVAL "100"
+
+#define DEF_SPINBOX_CMD ""
+
+#define DEF_SPINBOX_FROM "0"
+#define DEF_SPINBOX_TO "0"
+#define DEF_SPINBOX_INCREMENT "1"
+#define DEF_SPINBOX_FORMAT ""
+
+#define DEF_SPINBOX_VALUES ""
+#define DEF_SPINBOX_WRAP "0"
+
+static const Tk_OptionSpec sbOptSpec[] = {
+ {TK_OPTION_BORDER, "-activebackground", "activeBackground", "Background",
+ DEF_BUTTON_ACTIVE_BG_COLOR, -1, Tk_Offset(Spinbox, activeBorder),
+ 0, DEF_BUTTON_ACTIVE_BG_MONO, 0},
+ {TK_OPTION_BORDER, "-background", "background", "Background",
+ DEF_ENTRY_BG_COLOR, -1, Tk_Offset(Entry, normalBorder),
+ 0, DEF_ENTRY_BG_MONO, 0},
+ {TK_OPTION_SYNONYM, "-bd", NULL, NULL,
+ NULL, 0, -1, 0, "-borderwidth", 0},
+ {TK_OPTION_SYNONYM, "-bg", NULL, NULL,
+ NULL, 0, -1, 0, "-background", 0},
+ {TK_OPTION_PIXELS, "-borderwidth", "borderWidth", "BorderWidth",
+ DEF_ENTRY_BORDER_WIDTH, -1, Tk_Offset(Entry, borderWidth), 0, 0, 0},
+ {TK_OPTION_BORDER, "-buttonbackground", "Button.background", "Background",
+ DEF_BUTTON_BG_COLOR, -1, Tk_Offset(Spinbox, buttonBorder),
+ 0, DEF_BUTTON_BG_MONO, 0},
+ {TK_OPTION_CURSOR, "-buttoncursor", "Button.cursor", "Cursor",
+ DEF_BUTTON_CURSOR, -1, Tk_Offset(Spinbox, bCursor),
+ TK_OPTION_NULL_OK, 0, 0},
+ {TK_OPTION_RELIEF, "-buttondownrelief", "Button.relief", "Relief",
+ DEF_BUTTON_RELIEF, -1, Tk_Offset(Spinbox, bdRelief), 0, 0, 0},
+ {TK_OPTION_RELIEF, "-buttonuprelief", "Button.relief", "Relief",
+ DEF_BUTTON_RELIEF, -1, Tk_Offset(Spinbox, buRelief), 0, 0, 0},
+ {TK_OPTION_STRING, "-command", "command", "Command",
+ DEF_SPINBOX_CMD, -1, Tk_Offset(Spinbox, command),
+ TK_OPTION_NULL_OK, 0, 0},
+ {TK_OPTION_CURSOR, "-cursor", "cursor", "Cursor",
+ DEF_ENTRY_CURSOR, -1, Tk_Offset(Entry, cursor),
+ TK_OPTION_NULL_OK, 0, 0},
+ {TK_OPTION_BORDER, "-disabledbackground", "disabledBackground",
+ "DisabledBackground", DEF_ENTRY_DISABLED_BG_COLOR, -1,
+ Tk_Offset(Entry, disabledBorder), TK_OPTION_NULL_OK,
+ (ClientData) DEF_ENTRY_DISABLED_BG_MONO, 0},
+ {TK_OPTION_COLOR, "-disabledforeground", "disabledForeground",
+ "DisabledForeground", DEF_ENTRY_DISABLED_FG, -1,
+ Tk_Offset(Entry, dfgColorPtr), TK_OPTION_NULL_OK, 0, 0},
+ {TK_OPTION_BOOLEAN, "-exportselection", "exportSelection",
+ "ExportSelection", DEF_ENTRY_EXPORT_SELECTION, -1,
+ Tk_Offset(Entry, exportSelection), 0, 0, 0},
+ {TK_OPTION_SYNONYM, "-fg", "foreground", NULL,
+ NULL, 0, -1, 0, "-foreground", 0},
+ {TK_OPTION_FONT, "-font", "font", "Font",
+ DEF_ENTRY_FONT, -1, Tk_Offset(Entry, tkfont), 0, 0, 0},
+ {TK_OPTION_COLOR, "-foreground", "foreground", "Foreground",
+ DEF_ENTRY_FG, -1, Tk_Offset(Entry, fgColorPtr), 0, 0, 0},
+ {TK_OPTION_STRING, "-format", "format", "Format",
+ DEF_SPINBOX_FORMAT, -1, Tk_Offset(Spinbox, reqFormat),
+ TK_OPTION_NULL_OK, 0, 0},
+ {TK_OPTION_DOUBLE, "-from", "from", "From",
+ DEF_SPINBOX_FROM, -1, Tk_Offset(Spinbox, fromValue), 0, 0, 0},
+ {TK_OPTION_COLOR, "-highlightbackground", "highlightBackground",
+ "HighlightBackground", DEF_ENTRY_HIGHLIGHT_BG,
+ -1, Tk_Offset(Entry, highlightBgColorPtr), 0, 0, 0},
+ {TK_OPTION_COLOR, "-highlightcolor", "highlightColor", "HighlightColor",
+ DEF_ENTRY_HIGHLIGHT, -1, Tk_Offset(Entry, highlightColorPtr), 0, 0, 0},
+ {TK_OPTION_PIXELS, "-highlightthickness", "highlightThickness",
+ "HighlightThickness", DEF_ENTRY_HIGHLIGHT_WIDTH, -1,
+ Tk_Offset(Entry, highlightWidth), 0, 0, 0},
+ {TK_OPTION_DOUBLE, "-increment", "increment", "Increment",
+ DEF_SPINBOX_INCREMENT, -1, Tk_Offset(Spinbox, increment), 0, 0, 0},
+ {TK_OPTION_BORDER, "-insertbackground", "insertBackground", "Foreground",
+ DEF_ENTRY_INSERT_BG, -1, Tk_Offset(Entry, insertBorder), 0, 0, 0},
+ {TK_OPTION_PIXELS, "-insertborderwidth", "insertBorderWidth",
+ "BorderWidth", DEF_ENTRY_INSERT_BD_COLOR, -1,
+ Tk_Offset(Entry, insertBorderWidth), 0,
+ (ClientData) DEF_ENTRY_INSERT_BD_MONO, 0},
+ {TK_OPTION_INT, "-insertofftime", "insertOffTime", "OffTime",
+ DEF_ENTRY_INSERT_OFF_TIME, -1, Tk_Offset(Entry, insertOffTime),
+ 0, 0, 0},
+ {TK_OPTION_INT, "-insertontime", "insertOnTime", "OnTime",
+ DEF_ENTRY_INSERT_ON_TIME, -1, Tk_Offset(Entry, insertOnTime), 0, 0, 0},
+ {TK_OPTION_PIXELS, "-insertwidth", "insertWidth", "InsertWidth",
+ DEF_ENTRY_INSERT_WIDTH, -1, Tk_Offset(Entry, insertWidth), 0, 0, 0},
+ {TK_OPTION_STRING, "-invalidcommand", "invalidCommand", "InvalidCommand",
+ DEF_ENTRY_INVALIDCMD, -1, Tk_Offset(Entry, invalidCmd),
+ TK_OPTION_NULL_OK, 0, 0},
+ {TK_OPTION_SYNONYM, "-invcmd", NULL, NULL,
+ NULL, 0, -1, 0, "-invalidcommand", 0},
+ {TK_OPTION_JUSTIFY, "-justify", "justify", "Justify",
+ DEF_ENTRY_JUSTIFY, -1, Tk_Offset(Entry, justify), 0, 0, 0},
+ {TK_OPTION_RELIEF, "-relief", "relief", "Relief",
+ DEF_ENTRY_RELIEF, -1, Tk_Offset(Entry, relief), 0, 0, 0},
+ {TK_OPTION_BORDER, "-readonlybackground", "readonlyBackground",
+ "ReadonlyBackground", DEF_ENTRY_READONLY_BG_COLOR, -1,
+ Tk_Offset(Entry, readonlyBorder), TK_OPTION_NULL_OK,
+ (ClientData) DEF_ENTRY_READONLY_BG_MONO, 0},
+ {TK_OPTION_INT, "-repeatdelay", "repeatDelay", "RepeatDelay",
+ DEF_SPINBOX_REPEAT_DELAY, -1, Tk_Offset(Spinbox, repeatDelay),
+ 0, 0, 0},
+ {TK_OPTION_INT, "-repeatinterval", "repeatInterval", "RepeatInterval",
+ DEF_SPINBOX_REPEAT_INTERVAL, -1, Tk_Offset(Spinbox, repeatInterval),
+ 0, 0, 0},
+ {TK_OPTION_BORDER, "-selectbackground", "selectBackground", "Foreground",
+ DEF_ENTRY_SELECT_COLOR, -1, Tk_Offset(Entry, selBorder),
+ 0, DEF_ENTRY_SELECT_MONO, 0},
+ {TK_OPTION_PIXELS, "-selectborderwidth", "selectBorderWidth",
+ "BorderWidth", DEF_ENTRY_SELECT_BD_COLOR, -1,
+ Tk_Offset(Entry, selBorderWidth),
+ 0, DEF_ENTRY_SELECT_BD_MONO, 0},
+ {TK_OPTION_COLOR, "-selectforeground", "selectForeground", "Background",
+ DEF_ENTRY_SELECT_FG_COLOR, -1, Tk_Offset(Entry, selFgColorPtr),
+ TK_OPTION_NULL_OK, DEF_ENTRY_SELECT_FG_MONO, 0},
+ {TK_OPTION_STRING_TABLE, "-state", "state", "State",
+ DEF_ENTRY_STATE, -1, Tk_Offset(Entry, state),
+ 0, 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_DOUBLE, "-to", "to", "To",
+ DEF_SPINBOX_TO, -1, Tk_Offset(Spinbox, toValue), 0, 0, 0},
+ {TK_OPTION_STRING_TABLE, "-validate", "validate", "Validate",
+ DEF_ENTRY_VALIDATE, -1, Tk_Offset(Entry, validate),
+ 0, validateStrings, 0},
+ {TK_OPTION_STRING, "-validatecommand", "validateCommand","ValidateCommand",
+ NULL, -1, Tk_Offset(Entry, validateCmd), TK_OPTION_NULL_OK, 0, 0},
+ {TK_OPTION_STRING, "-values", "values", "Values",
+ DEF_SPINBOX_VALUES, -1, Tk_Offset(Spinbox, valueStr),
+ TK_OPTION_NULL_OK, 0, 0},
+ {TK_OPTION_SYNONYM, "-vcmd", NULL, NULL,
+ NULL, 0, -1, 0, "-validatecommand", 0},
+ {TK_OPTION_INT, "-width", "width", "Width",
+ DEF_ENTRY_WIDTH, -1, Tk_Offset(Entry, prefWidth), 0, 0, 0},
+ {TK_OPTION_BOOLEAN, "-wrap", "wrap", "Wrap",
+ DEF_SPINBOX_WRAP, -1, Tk_Offset(Spinbox, wrap), 0, 0, 0},
+ {TK_OPTION_STRING, "-xscrollcommand", "xScrollCommand", "ScrollCommand",
+ DEF_ENTRY_SCROLL_COMMAND, -1, Tk_Offset(Entry, scrollCmd),
+ TK_OPTION_NULL_OK, 0, 0},
+ {TK_OPTION_END, NULL, NULL, NULL, NULL, 0, -1, 0, 0, 0}
+};
+
+/*
+ * The following tables define the entry widget commands (and sub-commands)
+ * and map the indexes into the string tables into enumerated types used to
+ * dispatch the entry widget command.
+ */
+
+static const char *const entryCmdNames[] = {
+ "bbox", "cget", "configure", "delete", "get", "icursor", "index",
+ "insert", "scan", "selection", "validate", "xview", NULL
+};
+
+enum entryCmd {
+ COMMAND_BBOX, COMMAND_CGET, COMMAND_CONFIGURE, COMMAND_DELETE,
+ COMMAND_GET, COMMAND_ICURSOR, COMMAND_INDEX, COMMAND_INSERT,
+ COMMAND_SCAN, COMMAND_SELECTION, COMMAND_VALIDATE, COMMAND_XVIEW
+};
+
+static const char *const selCmdNames[] = {
+ "adjust", "clear", "from", "present", "range", "to", NULL
+};
+
+enum selCmd {
+ SELECTION_ADJUST, SELECTION_CLEAR, SELECTION_FROM,
+ SELECTION_PRESENT, SELECTION_RANGE, SELECTION_TO
+};
+
+/*
+ * The following tables define the spinbox widget commands (and sub-commands)
+ * and map the indexes into the string tables into enumerated types used to
+ * dispatch the spinbox widget command.
+ */
+
+static const char *const sbCmdNames[] = {
+ "bbox", "cget", "configure", "delete", "get", "icursor", "identify",
+ "index", "insert", "invoke", "scan", "selection", "set",
+ "validate", "xview", NULL
+};
+
+enum sbCmd {
+ SB_CMD_BBOX, SB_CMD_CGET, SB_CMD_CONFIGURE, SB_CMD_DELETE,
+ SB_CMD_GET, SB_CMD_ICURSOR, SB_CMD_IDENTIFY, SB_CMD_INDEX,
+ SB_CMD_INSERT, SB_CMD_INVOKE, SB_CMD_SCAN, SB_CMD_SELECTION,
+ SB_CMD_SET, SB_CMD_VALIDATE, SB_CMD_XVIEW
+};
+
+static const char *const sbSelCmdNames[] = {
+ "adjust", "clear", "element", "from", "present", "range", "to", NULL
+};
+
+enum sbselCmd {
+ SB_SEL_ADJUST, SB_SEL_CLEAR, SB_SEL_ELEMENT, SB_SEL_FROM,
+ SB_SEL_PRESENT, SB_SEL_RANGE, SB_SEL_TO
+};
+
+/*
+ * Extra for selection of elements
+ */
+
+/*
+ * This is the string array corresponding to the enum in selelement. If you
+ * modify them, you must modify the strings here.
+ */
+
+static const char *const selElementNames[] = {
+ "none", "buttondown", "buttonup", NULL, "entry"
+};
+
+/*
+ * Flags for GetEntryIndex function:
+ */
+
+#define ZERO_OK 1
+#define LAST_PLUS_ONE_OK 2
+
+/*
+ * Forward declarations for functions defined later in this file:
+ */
+
+static int ConfigureEntry(Tcl_Interp *interp, Entry *entryPtr,
+ int objc, Tcl_Obj *const objv[]);
+static int DeleteChars(Entry *entryPtr, int index, int count);
+static void DestroyEntry(void *memPtr);
+static void DisplayEntry(ClientData clientData);
+static void EntryBlinkProc(ClientData clientData);
+static void EntryCmdDeletedProc(ClientData clientData);
+static void EntryComputeGeometry(Entry *entryPtr);
+static void EntryEventProc(ClientData clientData,
+ XEvent *eventPtr);
+static void EntryFocusProc(Entry *entryPtr, int gotFocus);
+static int EntryFetchSelection(ClientData clientData, int offset,
+ char *buffer, int maxBytes);
+static void EntryLostSelection(ClientData clientData);
+static void EventuallyRedraw(Entry *entryPtr);
+static void EntryScanTo(Entry *entryPtr, int y);
+static void EntrySetValue(Entry *entryPtr, const char *value);
+static void EntrySelectTo(Entry *entryPtr, int index);
+static char * EntryTextVarProc(ClientData clientData,
+ Tcl_Interp *interp, const char *name1,
+ const char *name2, int flags);
+static void EntryUpdateScrollbar(Entry *entryPtr);
+static int EntryValidate(Entry *entryPtr, char *cmd);
+static int EntryValidateChange(Entry *entryPtr, const char *change,
+ const char *newStr, int index, int type);
+static void ExpandPercents(Entry *entryPtr, const char *before,
+ const char *change, const char *newStr, int index,
+ int type, Tcl_DString *dsPtr);
+static int EntryValueChanged(Entry *entryPtr,
+ const char *newValue);
+static void EntryVisibleRange(Entry *entryPtr,
+ double *firstPtr, double *lastPtr);
+static int EntryWidgetObjCmd(ClientData clientData,
+ Tcl_Interp *interp, int objc,
+ Tcl_Obj *const objv[]);
+static void EntryWorldChanged(ClientData instanceData);
+static int GetEntryIndex(Tcl_Interp *interp, Entry *entryPtr,
+ const char *string, int *indexPtr);
+static int InsertChars(Entry *entryPtr, int index, const char *string);
+
+/*
+ * These forward declarations are the spinbox specific ones:
+ */
+
+static int SpinboxWidgetObjCmd(ClientData clientData,
+ Tcl_Interp *interp, int objc,
+ Tcl_Obj *const objv[]);
+static int GetSpinboxElement(Spinbox *sbPtr, int x, int y);
+static int SpinboxInvoke(Tcl_Interp *interp, Spinbox *sbPtr,
+ int element);
+static int ComputeFormat(Spinbox *sbPtr);
+
+/*
+ * The structure below defines widget class behavior by means of functions
+ * that can be invoked from generic window code.
+ */
+
+static const Tk_ClassProcs entryClass = {
+ sizeof(Tk_ClassProcs), /* size */
+ EntryWorldChanged, /* worldChangedProc */
+ NULL, /* createProc */
+ NULL /* modalProc */
+};
+
+/*
+ *--------------------------------------------------------------
+ *
+ * Tk_EntryObjCmd --
+ *
+ * This function is invoked to process the "entry" Tcl command. See the
+ * user documentation for details on what it does.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * See the user documentation.
+ *
+ *--------------------------------------------------------------
+ */
+
+int
+Tk_EntryObjCmd(
+ ClientData clientData, /* NULL. */
+ Tcl_Interp *interp, /* Current interpreter. */
+ int objc, /* Number of arguments. */
+ Tcl_Obj *const objv[]) /* Argument objects. */
+{
+ register Entry *entryPtr;
+ Tk_OptionTable optionTable;
+ Tk_Window tkwin;
+ char *tmp;
+
+ if (objc < 2) {
+ Tcl_WrongNumArgs(interp, 1, objv, "pathName ?-option value ...?");
+ return TCL_ERROR;
+ }
+
+ tkwin = Tk_CreateWindowFromPath(interp, Tk_MainWindow(interp),
+ Tcl_GetString(objv[1]), NULL);
+ if (tkwin == NULL) {
+ return TCL_ERROR;
+ }
+
+ /*
+ * Create the option table for this widget class. If it has already been
+ * created, Tk will return the cached value.
+ */
+
+ optionTable = Tk_CreateOptionTable(interp, entryOptSpec);
+
+ /*
+ * Initialize the fields of the structure that won't be initialized by
+ * ConfigureEntry, or that ConfigureEntry requires to be initialized
+ * already (e.g. resource pointers). Only the non-NULL/0 data must be
+ * initialized as memset covers the rest.
+ */
+
+ entryPtr = ckalloc(sizeof(Entry));
+ memset(entryPtr, 0, sizeof(Entry));
+
+ entryPtr->tkwin = tkwin;
+ entryPtr->display = Tk_Display(tkwin);
+ entryPtr->interp = interp;
+ entryPtr->widgetCmd = Tcl_CreateObjCommand(interp,
+ Tk_PathName(entryPtr->tkwin), EntryWidgetObjCmd, entryPtr,
+ EntryCmdDeletedProc);
+ entryPtr->optionTable = optionTable;
+ entryPtr->type = TK_ENTRY;
+ tmp = ckalloc(1);
+ tmp[0] = '\0';
+ entryPtr->string = tmp;
+ entryPtr->selectFirst = -1;
+ entryPtr->selectLast = -1;
+
+ entryPtr->cursor = None;
+ entryPtr->exportSelection = 1;
+ entryPtr->justify = TK_JUSTIFY_LEFT;
+ entryPtr->relief = TK_RELIEF_FLAT;
+ entryPtr->state = STATE_NORMAL;
+ entryPtr->displayString = entryPtr->string;
+ entryPtr->inset = XPAD;
+ entryPtr->textGC = None;
+ entryPtr->selTextGC = None;
+ entryPtr->highlightGC = None;
+ entryPtr->avgWidth = 1;
+ entryPtr->validate = VALIDATE_NONE;
+
+ /*
+ * Keep a hold of the associated tkwin until we destroy the entry,
+ * otherwise Tk might free it while we still need it.
+ */
+
+ Tcl_Preserve(entryPtr->tkwin);
+
+ Tk_SetClass(entryPtr->tkwin, "Entry");
+ Tk_SetClassProcs(entryPtr->tkwin, &entryClass, entryPtr);
+ Tk_CreateEventHandler(entryPtr->tkwin,
+ ExposureMask|StructureNotifyMask|FocusChangeMask,
+ EntryEventProc, entryPtr);
+ Tk_CreateSelHandler(entryPtr->tkwin, XA_PRIMARY, XA_STRING,
+ EntryFetchSelection, entryPtr, XA_STRING);
+
+ if ((Tk_InitOptions(interp, (char *) entryPtr, optionTable, tkwin)
+ != TCL_OK) ||
+ (ConfigureEntry(interp, entryPtr, objc-2, objv+2) != TCL_OK)) {
+ Tk_DestroyWindow(entryPtr->tkwin);
+ return TCL_ERROR;
+ }
+
+ Tcl_SetObjResult(interp, TkNewWindowObj(entryPtr->tkwin));
+ return TCL_OK;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * EntryWidgetObjCmd --
+ *
+ * This function is invoked to process the Tcl command that corresponds
+ * to a widget managed by this module. See the user documentation for
+ * details on what it does.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * See the user documentation.
+ *
+ *--------------------------------------------------------------
+ */
+
+static int
+EntryWidgetObjCmd(
+ ClientData clientData, /* Information about entry widget. */
+ Tcl_Interp *interp, /* Current interpreter. */
+ int objc, /* Number of arguments. */
+ Tcl_Obj *const objv[]) /* Argument objects. */
+{
+ Entry *entryPtr = clientData;
+ int cmdIndex, selIndex, result;
+ Tcl_Obj *objPtr;
+
+ if (objc < 2) {
+ Tcl_WrongNumArgs(interp, 1, objv, "option ?arg ...?");
+ return TCL_ERROR;
+ }
+
+ /*
+ * Parse the widget command by looking up the second token in the list of
+ * valid command names.
+ */
+
+ result = Tcl_GetIndexFromObj(interp, objv[1], entryCmdNames, "option", 0,
+ &cmdIndex);
+ if (result != TCL_OK) {
+ return result;
+ }
+
+ Tcl_Preserve(entryPtr);
+ switch ((enum entryCmd) cmdIndex) {
+ case COMMAND_BBOX: {
+ int index, x, y, width, height;
+ Tcl_Obj *bbox[4];
+
+ if (objc != 3) {
+ Tcl_WrongNumArgs(interp, 2, objv, "index");
+ goto error;
+ }
+ if (GetEntryIndex(interp, entryPtr, Tcl_GetString(objv[2]),
+ &index) != TCL_OK) {
+ goto error;
+ }
+ if ((index == entryPtr->numChars) && (index > 0)) {
+ index--;
+ }
+ Tk_CharBbox(entryPtr->textLayout, index, &x, &y, &width, &height);
+ bbox[0] = Tcl_NewIntObj(x + entryPtr->layoutX);
+ bbox[1] = Tcl_NewIntObj(y + entryPtr->layoutY);
+ bbox[2] = Tcl_NewIntObj(width);
+ bbox[3] = Tcl_NewIntObj(height);
+ Tcl_SetObjResult(interp, Tcl_NewListObj(4, bbox));
+ break;
+ }
+
+ case COMMAND_CGET:
+ if (objc != 3) {
+ Tcl_WrongNumArgs(interp, 2, objv, "option");
+ goto error;
+ }
+
+ objPtr = Tk_GetOptionValue(interp, (char *) entryPtr,
+ entryPtr->optionTable, objv[2], entryPtr->tkwin);
+ if (objPtr == NULL) {
+ goto error;
+ }
+ Tcl_SetObjResult(interp, objPtr);
+ break;
+
+ case COMMAND_CONFIGURE:
+ if (objc <= 3) {
+ objPtr = Tk_GetOptionInfo(interp, (char *) entryPtr,
+ entryPtr->optionTable,
+ (objc == 3) ? objv[2] : NULL,
+ entryPtr->tkwin);
+ if (objPtr == NULL) {
+ goto error;
+ }
+ Tcl_SetObjResult(interp, objPtr);
+ } else {
+ result = ConfigureEntry(interp, entryPtr, objc-2, objv+2);
+ }
+ break;
+
+ case COMMAND_DELETE: {
+ int first, last, code;
+
+ if ((objc < 3) || (objc > 4)) {
+ Tcl_WrongNumArgs(interp, 2, objv, "firstIndex ?lastIndex?");
+ goto error;
+ }
+ if (GetEntryIndex(interp, entryPtr, Tcl_GetString(objv[2]),
+ &first) != TCL_OK) {
+ goto error;
+ }
+ if (objc == 3) {
+ last = first + 1;
+ } else if (GetEntryIndex(interp, entryPtr, Tcl_GetString(objv[3]),
+ &last) != TCL_OK) {
+ goto error;
+ }
+ if ((last >= first) && (entryPtr->state == STATE_NORMAL)) {
+ code = DeleteChars(entryPtr, first, last - first);
+ if (code != TCL_OK) {
+ goto error;
+ }
+ }
+ break;
+ }
+
+ case COMMAND_GET:
+ if (objc != 2) {
+ Tcl_WrongNumArgs(interp, 2, objv, NULL);
+ goto error;
+ }
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(entryPtr->string, -1));
+ break;
+
+ case COMMAND_ICURSOR:
+ if (objc != 3) {
+ Tcl_WrongNumArgs(interp, 2, objv, "pos");
+ goto error;
+ }
+ if (GetEntryIndex(interp, entryPtr, Tcl_GetString(objv[2]),
+ &entryPtr->insertPos) != TCL_OK) {
+ goto error;
+ }
+ EventuallyRedraw(entryPtr);
+ break;
+
+ case COMMAND_INDEX: {
+ int index;
+
+ if (objc != 3) {
+ Tcl_WrongNumArgs(interp, 2, objv, "string");
+ goto error;
+ }
+ if (GetEntryIndex(interp, entryPtr, Tcl_GetString(objv[2]),
+ &index) != TCL_OK) {
+ goto error;
+ }
+ Tcl_SetObjResult(interp, Tcl_NewIntObj(index));
+ break;
+ }
+
+ case COMMAND_INSERT: {
+ int index, code;
+
+ if (objc != 4) {
+ Tcl_WrongNumArgs(interp, 2, objv, "index text");
+ goto error;
+ }
+ if (GetEntryIndex(interp, entryPtr, Tcl_GetString(objv[2]),
+ &index) != TCL_OK) {
+ goto error;
+ }
+ if (entryPtr->state == STATE_NORMAL) {
+ code = InsertChars(entryPtr, index, Tcl_GetString(objv[3]));
+ if (code != TCL_OK) {
+ goto error;
+ }
+ }
+ break;
+ }
+
+ case COMMAND_SCAN: {
+ int x;
+ const char *minorCmd;
+
+ if (objc != 4) {
+ Tcl_WrongNumArgs(interp, 2, objv, "mark|dragto x");
+ goto error;
+ }
+ if (Tcl_GetIntFromObj(interp, objv[3], &x) != TCL_OK) {
+ goto error;
+ }
+
+ minorCmd = Tcl_GetString(objv[2]);
+ if (minorCmd[0] == 'm'
+ && (strncmp(minorCmd, "mark", strlen(minorCmd)) == 0)) {
+ entryPtr->scanMarkX = x;
+ entryPtr->scanMarkIndex = entryPtr->leftIndex;
+ } else if ((minorCmd[0] == 'd')
+ && (strncmp(minorCmd, "dragto", strlen(minorCmd)) == 0)) {
+ EntryScanTo(entryPtr, x);
+ } else {
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "bad scan option \"%s\": must be mark or dragto",
+ minorCmd));
+ Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "INDEX", "scan option",
+ minorCmd, NULL);
+ goto error;
+ }
+ break;
+ }
+
+ case COMMAND_SELECTION: {
+ int index, index2;
+
+ if (objc < 3) {
+ Tcl_WrongNumArgs(interp, 2, objv, "option ?index?");
+ goto error;
+ }
+
+ /*
+ * Parse the selection sub-command, using the command table
+ * "selCmdNames" defined above.
+ */
+
+ result = Tcl_GetIndexFromObj(interp, objv[2], selCmdNames,
+ "selection option", 0, &selIndex);
+ if (result != TCL_OK) {
+ goto error;
+ }
+
+ /*
+ * Disabled entries don't allow the selection to be modified, but
+ * 'selection present' must return a boolean.
+ */
+
+ if ((entryPtr->state == STATE_DISABLED)
+ && (selIndex != SELECTION_PRESENT)) {
+ goto done;
+ }
+
+ switch (selIndex) {
+ case SELECTION_ADJUST:
+ if (objc != 4) {
+ Tcl_WrongNumArgs(interp, 3, objv, "index");
+ goto error;
+ }
+ if (GetEntryIndex(interp, entryPtr,
+ Tcl_GetString(objv[3]), &index) != TCL_OK) {
+ goto error;
+ }
+ if (entryPtr->selectFirst >= 0) {
+ int half1, half2;
+
+ half1 = (entryPtr->selectFirst + entryPtr->selectLast)/2;
+ half2 = (entryPtr->selectFirst + entryPtr->selectLast + 1)/2;
+ if (index < half1) {
+ entryPtr->selectAnchor = entryPtr->selectLast;
+ } else if (index > half2) {
+ entryPtr->selectAnchor = entryPtr->selectFirst;
+ } else {
+ /*
+ * We're at about the halfway point in the selection; just
+ * keep the existing anchor.
+ */
+ }
+ }
+ EntrySelectTo(entryPtr, index);
+ break;
+
+ case SELECTION_CLEAR:
+ if (objc != 3) {
+ Tcl_WrongNumArgs(interp, 3, objv, NULL);
+ goto error;
+ }
+ if (entryPtr->selectFirst >= 0) {
+ entryPtr->selectFirst = -1;
+ entryPtr->selectLast = -1;
+ EventuallyRedraw(entryPtr);
+ }
+ goto done;
+
+ case SELECTION_FROM:
+ if (objc != 4) {
+ Tcl_WrongNumArgs(interp, 3, objv, "index");
+ goto error;
+ }
+ if (GetEntryIndex(interp, entryPtr,
+ Tcl_GetString(objv[3]), &index) != TCL_OK) {
+ goto error;
+ }
+ entryPtr->selectAnchor = index;
+ break;
+
+ case SELECTION_PRESENT:
+ if (objc != 3) {
+ Tcl_WrongNumArgs(interp, 3, objv, NULL);
+ goto error;
+ }
+ Tcl_SetObjResult(interp,
+ Tcl_NewBooleanObj(entryPtr->selectFirst >= 0));
+ 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, entryPtr);
+ entryPtr->flags |= GOT_SELECTION;
+ }
+ EventuallyRedraw(entryPtr);
+ break;
+
+ case SELECTION_TO:
+ if (objc != 4) {
+ Tcl_WrongNumArgs(interp, 3, objv, "index");
+ goto error;
+ }
+ if (GetEntryIndex(interp, entryPtr,
+ Tcl_GetString(objv[3]), &index) != TCL_OK) {
+ goto error;
+ }
+ EntrySelectTo(entryPtr, index);
+ break;
+ }
+ break;
+ }
+
+ case COMMAND_VALIDATE: {
+ int code;
+
+ if (objc != 2) {
+ Tcl_WrongNumArgs(interp, 2, objv, NULL);
+ goto error;
+ }
+ selIndex = entryPtr->validate;
+ entryPtr->validate = VALIDATE_ALL;
+ code = EntryValidateChange(entryPtr, 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;
+ Tcl_Obj *span[2];
+
+ EntryVisibleRange(entryPtr, &first, &last);
+ span[0] = Tcl_NewDoubleObj(first);
+ span[1] = Tcl_NewDoubleObj(last);
+ Tcl_SetObjResult(interp, Tcl_NewListObj(2, span));
+ goto done;
+ } else if (objc == 3) {
+ if (GetEntryIndex(interp, entryPtr, Tcl_GetString(objv[2]),
+ &index) != TCL_OK) {
+ goto error;
+ }
+ } else {
+ double fraction;
+ int count;
+
+ index = entryPtr->leftIndex;
+ switch (Tk_GetScrollInfoObj(interp, objc, objv, &fraction,
+ &count)) {
+ case TK_SCROLL_ERROR:
+ goto error;
+ case TK_SCROLL_MOVETO:
+ index = (int) ((fraction * entryPtr->numChars) + 0.5);
+ break;
+ case TK_SCROLL_PAGES: {
+ int charsPerPage;
+
+ charsPerPage = ((Tk_Width(entryPtr->tkwin)
+ - 2 * entryPtr->inset) / entryPtr->avgWidth) - 2;
+ if (charsPerPage < 1) {
+ charsPerPage = 1;
+ }
+ index += count * charsPerPage;
+ break;
+ }
+ case TK_SCROLL_UNITS:
+ index += count;
+ break;
+ }
+ }
+ if (index >= entryPtr->numChars) {
+ index = entryPtr->numChars - 1;
+ }
+ if (index < 0) {
+ index = 0;
+ }
+ entryPtr->leftIndex = index;
+ entryPtr->flags |= UPDATE_SCROLLBAR;
+ EntryComputeGeometry(entryPtr);
+ EventuallyRedraw(entryPtr);
+ break;
+ }
+ }
+
+ done:
+ Tcl_Release(entryPtr);
+ return result;
+
+ error:
+ Tcl_Release(entryPtr);
+ return TCL_ERROR;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * DestroyEntry --
+ *
+ * This function is invoked by Tcl_EventuallyFree or Tcl_Release to clean
+ * up the internal structure of an entry at a safe time (when no-one is
+ * using it anymore).
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Everything associated with the entry is freed up.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+DestroyEntry(
+ void *memPtr) /* Info about entry widget. */
+{
+ Entry *entryPtr = memPtr;
+
+ /*
+ * Free up all the stuff that requires special handling, then let
+ * Tk_FreeOptions handle all the standard option-related stuff.
+ */
+
+ ckfree((char *)entryPtr->string);
+ if (entryPtr->textVarName != NULL) {
+ Tcl_UntraceVar2(entryPtr->interp, entryPtr->textVarName,
+ NULL, TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS,
+ EntryTextVarProc, entryPtr);
+ entryPtr->flags &= ~ENTRY_VAR_TRACED;
+ }
+ if (entryPtr->textGC != None) {
+ Tk_FreeGC(entryPtr->display, entryPtr->textGC);
+ }
+ if (entryPtr->selTextGC != None) {
+ Tk_FreeGC(entryPtr->display, entryPtr->selTextGC);
+ }
+ Tcl_DeleteTimerHandler(entryPtr->insertBlinkHandler);
+ if (entryPtr->displayString != entryPtr->string) {
+ ckfree((char *)entryPtr->displayString);
+ }
+ if (entryPtr->type == TK_SPINBOX) {
+ Spinbox *sbPtr = (Spinbox *) entryPtr;
+
+ if (sbPtr->listObj != NULL) {
+ Tcl_DecrRefCount(sbPtr->listObj);
+ sbPtr->listObj = NULL;
+ }
+ if (sbPtr->formatBuf) {
+ ckfree(sbPtr->formatBuf);
+ }
+ }
+ Tk_FreeTextLayout(entryPtr->textLayout);
+ Tk_FreeConfigOptions((char *) entryPtr, entryPtr->optionTable,
+ entryPtr->tkwin);
+ Tcl_Release(entryPtr->tkwin);
+ entryPtr->tkwin = NULL;
+
+ ckfree(entryPtr);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ConfigureEntry --
+ *
+ * This function is called to process an argv/argc list, plus the Tk
+ * option database, in order to configure (or reconfigure) an entry
+ * widget.
+ *
+ * Results:
+ * The return value is a standard Tcl result. If TCL_ERROR is returned,
+ * then the interp's result contains an error message.
+ *
+ * Side effects:
+ * Configuration information, such as colors, border width, etc. get set
+ * for entryPtr; old resources get freed, if there were any.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+ConfigureEntry(
+ Tcl_Interp *interp, /* Used for error reporting. */
+ Entry *entryPtr, /* Information about widget; may or may not
+ * already have values for some fields. */
+ int objc, /* Number of valid entries in argv. */
+ Tcl_Obj *const objv[]) /* Argument objects. */
+{
+ Tk_SavedOptions savedOptions;
+ Tk_3DBorder border;
+ Tcl_Obj *errorResult = NULL;
+ Spinbox *sbPtr = (Spinbox *) entryPtr;
+ /* Only used when this widget is of type
+ * TK_SPINBOX */
+ char *oldValues = NULL; /* lint initialization */
+ char *oldFormat = NULL; /* lint initialization */
+ int error;
+ int oldExport = 0; /* lint initialization */
+ int valuesChanged = 0; /* lint initialization */
+ double oldFrom = 0.0; /* lint initialization */
+ double oldTo = 0.0; /* lint initialization */
+ int code;
+
+ /*
+ * Eliminate any existing trace on a variable monitored by the entry.
+ */
+
+ if ((entryPtr->textVarName != NULL)
+ && (entryPtr->flags & ENTRY_VAR_TRACED)) {
+ Tcl_UntraceVar2(interp, entryPtr->textVarName, NULL,
+ TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS,
+ EntryTextVarProc, entryPtr);
+ entryPtr->flags &= ~ENTRY_VAR_TRACED;
+ }
+
+ /*
+ * Store old values that we need to effect certain behavior if they change
+ * value.
+ */
+
+ oldExport = entryPtr->exportSelection;
+ if (entryPtr->type == TK_SPINBOX) {
+ oldValues = sbPtr->valueStr;
+ oldFormat = sbPtr->reqFormat;
+ oldFrom = sbPtr->fromValue;
+ oldTo = sbPtr->toValue;
+ }
+
+ for (error = 0; error <= 1; error++) {
+ if (!error) {
+ /*
+ * First pass: set options to new values.
+ */
+
+ if (Tk_SetOptions(interp, (char *) entryPtr,
+ entryPtr->optionTable, objc, objv,
+ entryPtr->tkwin, &savedOptions, NULL) != TCL_OK) {
+ continue;
+ }
+ } else {
+ /*
+ * Second pass: restore options to old values.
+ */
+
+ errorResult = Tcl_GetObjResult(interp);
+ Tcl_IncrRefCount(errorResult);
+ Tk_RestoreSavedOptions(&savedOptions);
+ }
+
+ /*
+ * A few other options also need special processing, such as parsing
+ * the geometry and setting the background from a 3-D border.
+ */
+
+ if ((entryPtr->state == STATE_DISABLED) &&
+ (entryPtr->disabledBorder != NULL)) {
+ border = entryPtr->disabledBorder;
+ } else if ((entryPtr->state == STATE_READONLY) &&
+ (entryPtr->readonlyBorder != NULL)) {
+ border = entryPtr->readonlyBorder;
+ } else {
+ border = entryPtr->normalBorder;
+ }
+ Tk_SetBackgroundFromBorder(entryPtr->tkwin, border);
+
+ if (entryPtr->insertWidth <= 0) {
+ entryPtr->insertWidth = 2;
+ }
+ if (entryPtr->insertBorderWidth > entryPtr->insertWidth/2) {
+ entryPtr->insertBorderWidth = entryPtr->insertWidth/2;
+ }
+
+ if (entryPtr->type == TK_SPINBOX) {
+ if (sbPtr->fromValue > sbPtr->toValue) {
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "-to value must be greater than -from value",
+ -1));
+ Tcl_SetErrorCode(interp, "TK", "SPINBOX", "RANGE_SANITY",
+ NULL);
+ continue;
+ }
+
+ if (sbPtr->reqFormat && (oldFormat != sbPtr->reqFormat)) {
+ /*
+ * Make sure that the given format is somewhat correct, and
+ * calculate the minimum space we'll need for the values as
+ * strings.
+ */
+
+ int min, max;
+ size_t formatLen, formatSpace = TCL_DOUBLE_SPACE;
+ char fbuf[4], *fmt = sbPtr->reqFormat;
+
+ formatLen = strlen(fmt);
+ if ((fmt[0] != '%') || (fmt[formatLen-1] != 'f')) {
+ badFormatOpt:
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "bad spinbox format specifier \"%s\"",
+ sbPtr->reqFormat));
+ Tcl_SetErrorCode(interp, "TK", "SPINBOX", "FORMAT_SANITY",
+ NULL);
+ continue;
+ }
+ if ((sscanf(fmt, "%%%d.%d%[f]", &min, &max, fbuf) == 3)
+ && (max >= 0)) {
+ formatSpace = min + max + 1;
+ } else if (((sscanf(fmt, "%%.%d%[f]", &min, fbuf) == 2)
+ || (sscanf(fmt, "%%%d%[f]", &min, fbuf) == 2)
+ || (sscanf(fmt, "%%%d.%[f]", &min, fbuf) == 2))
+ && (min >= 0)) {
+ formatSpace = min + 1;
+ } else {
+ goto badFormatOpt;
+ }
+ if (formatSpace < TCL_DOUBLE_SPACE) {
+ formatSpace = TCL_DOUBLE_SPACE;
+ }
+ sbPtr->formatBuf = ckrealloc(sbPtr->formatBuf, formatSpace);
+
+ /*
+ * We perturb the value of oldFrom to allow us to go into the
+ * branch below that will reformat the displayed value.
+ */
+
+ oldFrom = sbPtr->fromValue - 1;
+ }
+
+ /*
+ * See if we have to rearrange our listObj data.
+ */
+
+ if (oldValues != sbPtr->valueStr) {
+ if (sbPtr->listObj != NULL) {
+ Tcl_DecrRefCount(sbPtr->listObj);
+ }
+ sbPtr->listObj = NULL;
+ if (sbPtr->valueStr != NULL) {
+ Tcl_Obj *newObjPtr;
+ int nelems;
+
+ newObjPtr = Tcl_NewStringObj(sbPtr->valueStr, -1);
+ if (Tcl_ListObjLength(interp, newObjPtr, &nelems)
+ != TCL_OK) {
+ valuesChanged = -1;
+ continue;
+ }
+ sbPtr->listObj = newObjPtr;
+ Tcl_IncrRefCount(sbPtr->listObj);
+ sbPtr->nElements = nelems;
+ sbPtr->eIndex = 0;
+ valuesChanged++;
+ }
+ }
+ }
+
+ /*
+ * Restart the cursor timing sequence in case the on-time or off-time
+ * just changed. Set validate temporarily to none, so the configure
+ * doesn't cause it to be triggered.
+ */
+
+ if (entryPtr->flags & GOT_FOCUS) {
+ int validate = entryPtr->validate;
+
+ entryPtr->validate = VALIDATE_NONE;
+ EntryFocusProc(entryPtr, 1);
+ entryPtr->validate = validate;
+ }
+
+ /*
+ * Claim the selection if we've suddenly started exporting it.
+ */
+
+ if (entryPtr->exportSelection && (!oldExport)
+ && (entryPtr->selectFirst != -1)
+ && !(entryPtr->flags & GOT_SELECTION)) {
+ Tk_OwnSelection(entryPtr->tkwin, XA_PRIMARY, EntryLostSelection,
+ entryPtr);
+ entryPtr->flags |= GOT_SELECTION;
+ }
+
+ /*
+ * Recompute the window's geometry and arrange for it to be
+ * redisplayed.
+ */
+
+ Tk_SetInternalBorder(entryPtr->tkwin,
+ entryPtr->borderWidth + entryPtr->highlightWidth);
+ if (entryPtr->highlightWidth <= 0) {
+ entryPtr->highlightWidth = 0;
+ }
+ entryPtr->inset = entryPtr->highlightWidth
+ + entryPtr->borderWidth + XPAD;
+ break;
+ }
+ if (!error) {
+ Tk_FreeSavedOptions(&savedOptions);
+ }
+
+ /*
+ * If the entry is tied to the value of a variable, create the variable if
+ * it doesn't exist, and set the entry's value from the variable's value.
+ */
+
+ if (entryPtr->textVarName != NULL) {
+ const char *value;
+
+ value = Tcl_GetVar2(interp, entryPtr->textVarName, NULL, TCL_GLOBAL_ONLY);
+ if (value == NULL) {
+
+ /*
+ * Since any trace on the textvariable was eliminated above,
+ * the only possible reason for EntryValueChanged to return
+ * an error is that the textvariable lives in a namespace
+ * that does not (yet) exist. Indeed, namespaces are not
+ * automatically created as needed. Don't trap this error
+ * here, better do it below when attempting to trace the
+ * variable.
+ */
+
+ EntryValueChanged(entryPtr, NULL);
+ } else {
+ EntrySetValue(entryPtr, value);
+ }
+ }
+
+ if (entryPtr->type == TK_SPINBOX) {
+ ComputeFormat(sbPtr);
+
+ if (valuesChanged > 0) {
+ Tcl_Obj *objPtr;
+
+ /*
+ * No check for error return, because there shouldn't be one given
+ * the check for valid list above.
+ */
+
+ Tcl_ListObjIndex(interp, sbPtr->listObj, 0, &objPtr);
+
+ /*
+ * No check for error return here as well, because any possible
+ * error will be trapped below when attempting tracing.
+ */
+
+ EntryValueChanged(entryPtr, Tcl_GetString(objPtr));
+ } else if ((sbPtr->valueStr == NULL)
+ && !DOUBLES_EQ(sbPtr->fromValue, sbPtr->toValue)
+ && (!DOUBLES_EQ(sbPtr->fromValue, oldFrom)
+ || !DOUBLES_EQ(sbPtr->toValue, oldTo))) {
+ /*
+ * If the valueStr is empty and -from && -to are specified, check
+ * to see if the current string is within the range. If not, it
+ * will be constrained to the nearest edge. If the current string
+ * isn't a double value, we set it to -from.
+ */
+
+ double dvalue;
+
+ if (sscanf(entryPtr->string, "%lf", &dvalue) <= 0) {
+ /* Scan failure */
+ dvalue = sbPtr->fromValue;
+ } else if (dvalue > sbPtr->toValue) {
+ dvalue = sbPtr->toValue;
+ } else if (dvalue < sbPtr->fromValue) {
+ dvalue = sbPtr->fromValue;
+ }
+ sprintf(sbPtr->formatBuf, sbPtr->valueFormat, dvalue);
+
+ /*
+ * No check for error return here as well, because any possible
+ * error will be trapped below when attempting tracing.
+ */
+
+ EntryValueChanged(entryPtr, sbPtr->formatBuf);
+ }
+ }
+
+ /*
+ * Set up a trace on the variable's value after we've possibly constrained
+ * the value according to new -from/-to values.
+ */
+
+ if ((entryPtr->textVarName != NULL)
+ && !(entryPtr->flags & ENTRY_VAR_TRACED)) {
+ code = Tcl_TraceVar2(interp, entryPtr->textVarName,
+ NULL, TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS,
+ EntryTextVarProc, entryPtr);
+ if (code != TCL_OK) {
+ return TCL_ERROR;
+ }
+ entryPtr->flags |= ENTRY_VAR_TRACED;
+ }
+
+ EntryWorldChanged(entryPtr);
+ if (error) {
+ Tcl_SetObjResult(interp, errorResult);
+ Tcl_DecrRefCount(errorResult);
+ return TCL_ERROR;
+ } else {
+ return TCL_OK;
+ }
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * EntryWorldChanged --
+ *
+ * This function is called when the world has changed in some way and the
+ * widget needs to recompute all its graphics contexts and determine its
+ * new geometry.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Entry will be relayed out and redisplayed.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+static void
+EntryWorldChanged(
+ ClientData instanceData) /* Information about widget. */
+{
+ XGCValues gcValues;
+ GC gc = None;
+ unsigned long mask;
+ Tk_3DBorder border;
+ XColor *colorPtr;
+ Entry *entryPtr = instanceData;
+
+ entryPtr->avgWidth = Tk_TextWidth(entryPtr->tkfont, "0", 1);
+ if (entryPtr->avgWidth == 0) {
+ entryPtr->avgWidth = 1;
+ }
+
+ if (entryPtr->type == TK_SPINBOX) {
+ /*
+ * Compute the button width for a spinbox
+ */
+
+ entryPtr->xWidth = entryPtr->avgWidth + 2 * (1+XPAD);
+ if (entryPtr->xWidth < 11) {
+ entryPtr->xWidth = 11; /* we want a min visible size */
+ }
+ }
+
+ /*
+ * Default background and foreground are from the normal state. In a
+ * disabled state, both of those may be overridden; in the readonly state,
+ * the background may be overridden.
+ */
+
+ border = entryPtr->normalBorder;
+ colorPtr = entryPtr->fgColorPtr;
+ switch (entryPtr->state) {
+ case STATE_DISABLED:
+ if (entryPtr->disabledBorder != NULL) {
+ border = entryPtr->disabledBorder;
+ }
+ if (entryPtr->dfgColorPtr != NULL) {
+ colorPtr = entryPtr->dfgColorPtr;
+ }
+ break;
+ case STATE_READONLY:
+ if (entryPtr->readonlyBorder != NULL) {
+ border = entryPtr->readonlyBorder;
+ }
+ break;
+ }
+
+ Tk_SetBackgroundFromBorder(entryPtr->tkwin, border);
+ gcValues.foreground = colorPtr->pixel;
+ gcValues.font = Tk_FontId(entryPtr->tkfont);
+ gcValues.graphics_exposures = False;
+ mask = GCForeground | GCFont | GCGraphicsExposures;
+ gc = Tk_GetGC(entryPtr->tkwin, mask, &gcValues);
+ if (entryPtr->textGC != None) {
+ Tk_FreeGC(entryPtr->display, entryPtr->textGC);
+ }
+ entryPtr->textGC = gc;
+
+ if (entryPtr->selFgColorPtr != NULL) {
+ gcValues.foreground = entryPtr->selFgColorPtr->pixel;
+ }
+ gcValues.font = Tk_FontId(entryPtr->tkfont);
+ mask = GCForeground | GCFont;
+ gc = Tk_GetGC(entryPtr->tkwin, mask, &gcValues);
+ if (entryPtr->selTextGC != None) {
+ Tk_FreeGC(entryPtr->display, entryPtr->selTextGC);
+ }
+ entryPtr->selTextGC = gc;
+
+ /*
+ * Recompute the window's geometry and arrange for it to be redisplayed.
+ */
+
+ EntryComputeGeometry(entryPtr);
+ entryPtr->flags |= UPDATE_SCROLLBAR;
+ EventuallyRedraw(entryPtr);
+}
+
+#ifndef MAC_OSX_TK
+/*
+ *--------------------------------------------------------------
+ *
+ * TkpDrawEntryBorderAndFocus --
+ *
+ * This function redraws the border of an entry widget. It overrides the
+ * generic border drawing code if the entry widget parameters are such
+ * that the native widget drawing is a good fit. This version just
+ * returns 0, so platforms that don't do special native drawing don't
+ * have to implement it.
+ *
+ * Results:
+ * 1 if it has drawn the border, 0 if not.
+ *
+ * Side effects:
+ * May draw the entry border into pixmap.
+ *
+ *--------------------------------------------------------------
+ */
+
+int
+TkpDrawEntryBorderAndFocus(
+ Entry *entryPtr,
+ Drawable pixmap,
+ int isSpinbox)
+{
+ return 0;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * TkpDrawSpinboxButtons --
+ *
+ * This function redraws the buttons of an spinbox widget. It overrides
+ * the generic button drawing code if the spinbox widget parameters are
+ * such that the native widget drawing is a good fit. This version just
+ * returns 0, so platforms that don't do special native drawing don't
+ * have to implement it.
+ *
+ * Results:
+ * 1 if it has drawn the border, 0 if not.
+ *
+ * Side effects:
+ * May draw the entry border into pixmap.
+ *
+ *--------------------------------------------------------------
+ */
+
+int
+TkpDrawSpinboxButtons(
+ Spinbox *sbPtr,
+ Pixmap pixmap)
+{
+ return 0;
+}
+#endif /* Not MAC_OSX_TK */
+
+/*
+ *--------------------------------------------------------------
+ *
+ * DisplayEntry --
+ *
+ * This function redraws the contents of an entry window.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Information appears on the screen.
+ *
+ *--------------------------------------------------------------
+ */
+
+static void
+DisplayEntry(
+ ClientData clientData) /* Information about window. */
+{
+ Entry *entryPtr = clientData;
+ Tk_Window tkwin = entryPtr->tkwin;
+ int baseY, selStartX, selEndX, cursorX;
+ int showSelection, xBound;
+ Tk_FontMetrics fm;
+ Pixmap pixmap;
+ Tk_3DBorder border;
+
+ entryPtr->flags &= ~REDRAW_PENDING;
+ if ((entryPtr->flags & ENTRY_DELETED) || !Tk_IsMapped(tkwin)) {
+ return;
+ }
+
+ Tk_GetFontMetrics(entryPtr->tkfont, &fm);
+
+ /*
+ * Update the scrollbar if that's needed.
+ */
+
+ if (entryPtr->flags & UPDATE_SCROLLBAR) {
+ entryPtr->flags &= ~UPDATE_SCROLLBAR;
+
+ /*
+ * Preserve/Release because updating the scrollbar can have the
+ * side-effect of destroying or unmapping the entry widget.
+ */
+
+ Tcl_Preserve(entryPtr);
+ EntryUpdateScrollbar(entryPtr);
+
+ if ((entryPtr->flags & ENTRY_DELETED) || !Tk_IsMapped(tkwin)) {
+ Tcl_Release(entryPtr);
+ return;
+ }
+ Tcl_Release(entryPtr);
+ }
+
+#ifndef TK_NO_DOUBLE_BUFFERING
+ /*
+ * In order to avoid screen flashes, this function redraws the textual
+ * area of the entry into off-screen memory, then copies it back on-screen
+ * in a single operation. This means there's no point in time where the
+ * on-screen image has been cleared.
+ */
+
+ pixmap = Tk_GetPixmap(entryPtr->display, Tk_WindowId(tkwin),
+ Tk_Width(tkwin), Tk_Height(tkwin), Tk_Depth(tkwin));
+#else
+ pixmap = Tk_WindowId(tkwin);
+#endif /* TK_NO_DOUBLE_BUFFERING */
+
+ /*
+ * Compute x-coordinate of the pixel just after last visible one, plus
+ * vertical position of baseline of text.
+ */
+
+ xBound = Tk_Width(tkwin) - entryPtr->inset - entryPtr->xWidth;
+ baseY = (Tk_Height(tkwin) + fm.ascent - fm.descent) / 2;
+
+ /*
+ * Hide the selection whenever we don't have the focus, unless we
+ * always want to show selection.
+ */
+ if (TkpAlwaysShowSelection(entryPtr->tkwin)) {
+ showSelection = 1;
+ } else {
+ showSelection = (entryPtr->flags & GOT_FOCUS);
+ }
+
+ /*
+ * Draw the background in three layers. From bottom to top the layers are:
+ * normal background, selection background, and insertion cursor
+ * background.
+ */
+
+ if ((entryPtr->state == STATE_DISABLED) &&
+ (entryPtr->disabledBorder != NULL)) {
+ border = entryPtr->disabledBorder;
+ } else if ((entryPtr->state == STATE_READONLY) &&
+ (entryPtr->readonlyBorder != NULL)) {
+ border = entryPtr->readonlyBorder;
+ } else {
+ border = entryPtr->normalBorder;
+ }
+ Tk_Fill3DRectangle(tkwin, pixmap, border,
+ 0, 0, Tk_Width(tkwin), Tk_Height(tkwin), 0, TK_RELIEF_FLAT);
+
+ if (showSelection && (entryPtr->state != STATE_DISABLED)
+ && (entryPtr->selectLast > entryPtr->leftIndex)) {
+ if (entryPtr->selectFirst <= entryPtr->leftIndex) {
+ selStartX = entryPtr->leftX;
+ } else {
+ Tk_CharBbox(entryPtr->textLayout, entryPtr->selectFirst,
+ &selStartX, NULL, NULL, NULL);
+ selStartX += entryPtr->layoutX;
+ }
+ if ((selStartX - entryPtr->selBorderWidth) < xBound) {
+ Tk_CharBbox(entryPtr->textLayout, entryPtr->selectLast,
+ &selEndX, NULL, NULL, NULL);
+ selEndX += entryPtr->layoutX;
+ Tk_Fill3DRectangle(tkwin, pixmap, entryPtr->selBorder,
+ selStartX - entryPtr->selBorderWidth,
+ baseY - fm.ascent - entryPtr->selBorderWidth,
+ (selEndX - selStartX) + 2*entryPtr->selBorderWidth,
+ (fm.ascent + fm.descent) + 2*entryPtr->selBorderWidth,
+ entryPtr->selBorderWidth,
+#ifndef MAC_OSX_TK
+ TK_RELIEF_RAISED
+#else
+ MAC_OSX_ENTRY_SELECT_RELIEF
+#endif
+ );
+ }
+ }
+
+ /*
+ * Draw a special background for the insertion cursor, overriding even the
+ * selection background. As a special hack to keep the cursor visible when
+ * the insertion cursor color is the same as the color for selected text
+ * (e.g., on mono displays), write background in the cursor area (instead
+ * of nothing) when the cursor isn't on. Otherwise the selection would
+ * hide the cursor.
+ */
+
+ if ((entryPtr->state == STATE_NORMAL) && (entryPtr->flags & GOT_FOCUS)) {
+ Tk_CharBbox(entryPtr->textLayout, entryPtr->insertPos, &cursorX, NULL,
+ NULL, NULL);
+ cursorX += entryPtr->layoutX;
+ cursorX -= (entryPtr->insertWidth == 1) ? 1 : (entryPtr->insertWidth)/2;
+ Tk_SetCaretPos(entryPtr->tkwin, cursorX, baseY - fm.ascent,
+ fm.ascent + fm.descent);
+ if (entryPtr->insertPos >= entryPtr->leftIndex && cursorX < xBound) {
+ if (entryPtr->flags & CURSOR_ON) {
+ Tk_Fill3DRectangle(tkwin, pixmap, entryPtr->insertBorder,
+ cursorX, baseY - fm.ascent, entryPtr->insertWidth,
+ fm.ascent + fm.descent, entryPtr->insertBorderWidth,
+ TK_RELIEF_RAISED);
+ } else if (entryPtr->insertBorder == entryPtr->selBorder) {
+ Tk_Fill3DRectangle(tkwin, pixmap, border, cursorX,
+ baseY - fm.ascent, entryPtr->insertWidth,
+ fm.ascent + fm.descent, 0, TK_RELIEF_FLAT);
+ }
+ }
+ }
+
+ /*
+ * Draw the text in two pieces: first the unselected portion, then the
+ * selected portion on top of it.
+ */
+
+ Tk_DrawTextLayout(entryPtr->display, pixmap, entryPtr->textGC,
+ entryPtr->textLayout, entryPtr->layoutX, entryPtr->layoutY,
+ entryPtr->leftIndex, entryPtr->numChars);
+
+ if (showSelection && (entryPtr->state != STATE_DISABLED)
+ && (entryPtr->selTextGC != entryPtr->textGC)
+ && (entryPtr->selectFirst < entryPtr->selectLast)) {
+ int selFirst;
+
+ if (entryPtr->selectFirst < entryPtr->leftIndex) {
+ selFirst = entryPtr->leftIndex;
+ } else {
+ selFirst = entryPtr->selectFirst;
+ }
+ Tk_DrawTextLayout(entryPtr->display, pixmap, entryPtr->selTextGC,
+ entryPtr->textLayout, entryPtr->layoutX, entryPtr->layoutY,
+ selFirst, entryPtr->selectLast);
+ }
+
+ if (entryPtr->type == TK_SPINBOX) {
+ int startx, height, inset, pad, tHeight, xWidth;
+ Spinbox *sbPtr = (Spinbox *) entryPtr;
+
+ /*
+ * Draw the spin button controls.
+ */
+
+ if (TkpDrawSpinboxButtons(sbPtr, pixmap) == 0) {
+ xWidth = entryPtr->xWidth;
+ pad = XPAD + 1;
+ inset = entryPtr->inset - XPAD;
+ startx = Tk_Width(tkwin) - (xWidth + inset);
+ height = (Tk_Height(tkwin) - 2*inset)/2;
+#if 0
+ Tk_Fill3DRectangle(tkwin, pixmap, sbPtr->buttonBorder,
+ startx, inset, xWidth, height, 1, sbPtr->buRelief);
+ Tk_Fill3DRectangle(tkwin, pixmap, sbPtr->buttonBorder,
+ startx, inset+height, xWidth, height, 1, sbPtr->bdRelief);
+#else
+ Tk_Fill3DRectangle(tkwin, pixmap, sbPtr->buttonBorder,
+ startx, inset, xWidth, height, 1,
+ (sbPtr->selElement == SEL_BUTTONUP) ?
+ TK_RELIEF_SUNKEN : TK_RELIEF_RAISED);
+ Tk_Fill3DRectangle(tkwin, pixmap, sbPtr->buttonBorder,
+ startx, inset+height, xWidth, height, 1,
+ (sbPtr->selElement == SEL_BUTTONDOWN) ?
+ TK_RELIEF_SUNKEN : TK_RELIEF_RAISED);
+#endif
+
+ xWidth -= 2*pad;
+
+ /*
+ * Only draw the triangles if we have enough display space
+ */
+
+ if ((xWidth > 1)) {
+ XPoint points[3];
+ int starty, space, offset;
+
+ space = height - 2*pad;
+
+ /*
+ * Ensure width of triangle is odd to guarantee a sharp tip
+ */
+
+ if (!(xWidth % 2)) {
+ xWidth++;
+ }
+ tHeight = (xWidth + 1) / 2;
+ if (tHeight > space) {
+ tHeight = space;
+ }
+ space = (space - tHeight) / 2;
+ startx += pad;
+ starty = inset + height - pad - space;
+ offset = (sbPtr->selElement == SEL_BUTTONUP);
+
+ /*
+ * The points are slightly different for the up and down
+ * arrows because (for *.x), we need to account for a bug in
+ * the way XFillPolygon draws triangles, and we want to shift
+ * the arrows differently when allowing for depressed
+ * behavior.
+ */
+
+ points[0].x = startx + offset;
+ points[0].y = starty + (offset ? 0 : -1);
+ points[1].x = startx + xWidth/2 + offset;
+ points[1].y = starty - tHeight + (offset ? 0 : -1);
+ points[2].x = startx + xWidth + offset;
+ points[2].y = points[0].y;
+ XFillPolygon(entryPtr->display, pixmap, entryPtr->textGC,
+ points, 3, Convex, CoordModeOrigin);
+
+ starty = inset + height + pad + space;
+ offset = (sbPtr->selElement == SEL_BUTTONDOWN);
+ points[0].x = startx + 1 + offset;
+ points[0].y = starty + (offset ? 1 : 0);
+ points[1].x = startx + xWidth/2 + offset;
+ points[1].y = starty + tHeight + (offset ? 0 : -1);
+ points[2].x = startx - 1 + xWidth + offset;
+ points[2].y = points[0].y;
+ XFillPolygon(entryPtr->display, pixmap, entryPtr->textGC,
+ points, 3, Convex, CoordModeOrigin);
+ }
+ }
+ }
+
+ /*
+ * Draw the border and focus highlight last, so they will overwrite any
+ * text that extends past the viewable part of the window.
+ */
+
+ if (!TkpDrawEntryBorderAndFocus(entryPtr, pixmap,
+ (entryPtr->type == TK_SPINBOX))) {
+ xBound = entryPtr->highlightWidth;
+ if (entryPtr->relief != TK_RELIEF_FLAT) {
+ Tk_Draw3DRectangle(tkwin, pixmap, border, xBound, xBound,
+ Tk_Width(tkwin) - 2 * xBound,
+ Tk_Height(tkwin) - 2 * xBound,
+ entryPtr->borderWidth, entryPtr->relief);
+ }
+ if (xBound > 0) {
+ GC fgGC, bgGC;
+
+ bgGC = Tk_GCForColor(entryPtr->highlightBgColorPtr, pixmap);
+ if (entryPtr->flags & GOT_FOCUS) {
+ fgGC = Tk_GCForColor(entryPtr->highlightColorPtr, pixmap);
+ TkpDrawHighlightBorder(tkwin, fgGC, bgGC, xBound, pixmap);
+ } else {
+ TkpDrawHighlightBorder(tkwin, bgGC, bgGC, xBound, pixmap);
+ }
+ }
+ }
+
+#ifndef TK_NO_DOUBLE_BUFFERING
+ /*
+ * Everything's been redisplayed; now copy the pixmap onto the screen and
+ * free up the pixmap.
+ */
+
+ XCopyArea(entryPtr->display, pixmap, Tk_WindowId(tkwin), entryPtr->textGC,
+ 0, 0, (unsigned) Tk_Width(tkwin), (unsigned) Tk_Height(tkwin),
+ 0, 0);
+ Tk_FreePixmap(entryPtr->display, pixmap);
+#endif /* TK_NO_DOUBLE_BUFFERING */
+ entryPtr->flags &= ~BORDER_NEEDED;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * EntryComputeGeometry --
+ *
+ * This function is invoked to recompute information about where in its
+ * window an entry's string will be displayed. It also computes the
+ * requested size for the window.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The leftX and tabOrigin fields are recomputed for entryPtr, and
+ * leftIndex may be adjusted. Tk_GeometryRequest is called to register
+ * the desired dimensions for the window.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+EntryComputeGeometry(
+ Entry *entryPtr) /* Widget record for entry. */
+{
+ int totalLength, overflow, maxOffScreen, rightX;
+ int height, width, i;
+ Tk_FontMetrics fm;
+ char *p;
+
+ if (entryPtr->displayString != entryPtr->string) {
+ ckfree((char *)entryPtr->displayString);
+ entryPtr->displayString = entryPtr->string;
+ entryPtr->numDisplayBytes = entryPtr->numBytes;
+ }
+
+ /*
+ * If we're displaying a special character instead of the value of the
+ * entry, recompute the displayString.
+ */
+
+ if (entryPtr->showChar != NULL) {
+ Tcl_UniChar ch;
+ char buf[TCL_UTF_MAX];
+ int size;
+
+ /*
+ * Normalize the special character so we can safely duplicate it in
+ * the display string. If we didn't do this, then two malformed
+ * characters might end up looking like one valid UTF character in the
+ * resulting string.
+ */
+
+ Tcl_UtfToUniChar(entryPtr->showChar, &ch);
+ size = Tcl_UniCharToUtf(ch, buf);
+
+ entryPtr->numDisplayBytes = entryPtr->numChars * size;
+ p = ckalloc(entryPtr->numDisplayBytes + 1);
+ entryPtr->displayString = p;
+
+ for (i = entryPtr->numChars; --i >= 0; ) {
+ p += Tcl_UniCharToUtf(ch, p);
+ }
+ *p = '\0';
+ }
+
+ Tk_FreeTextLayout(entryPtr->textLayout);
+ entryPtr->textLayout = Tk_ComputeTextLayout(entryPtr->tkfont,
+ entryPtr->displayString, entryPtr->numChars, 0,
+ entryPtr->justify, TK_IGNORE_NEWLINES, &totalLength, &height);
+
+ entryPtr->layoutY = (Tk_Height(entryPtr->tkwin) - height) / 2;
+
+ /*
+ * Recompute where the leftmost character on the display will be drawn
+ * (entryPtr->leftX) and adjust leftIndex if necessary so that we don't
+ * let characters hang off the edge of the window unless the entire window
+ * is full.
+ */
+
+ overflow = totalLength -
+ (Tk_Width(entryPtr->tkwin) - 2*entryPtr->inset - entryPtr->xWidth);
+ if (overflow <= 0) {
+ entryPtr->leftIndex = 0;
+ if (entryPtr->justify == TK_JUSTIFY_LEFT) {
+ entryPtr->leftX = entryPtr->inset;
+ } else if (entryPtr->justify == TK_JUSTIFY_RIGHT) {
+ entryPtr->leftX = Tk_Width(entryPtr->tkwin) - entryPtr->inset
+ - entryPtr->xWidth - totalLength;
+ } else {
+ entryPtr->leftX = (Tk_Width(entryPtr->tkwin)
+ - entryPtr->xWidth - totalLength)/2;
+ }
+ entryPtr->layoutX = entryPtr->leftX;
+ } else {
+ /*
+ * The whole string can't fit in the window. Compute the maximum
+ * number of characters that may be off-screen to the left without
+ * leaving empty space on the right of the window, then don't let
+ * leftIndex be any greater than that.
+ */
+
+ maxOffScreen = Tk_PointToChar(entryPtr->textLayout, overflow, 0);
+ Tk_CharBbox(entryPtr->textLayout, maxOffScreen,
+ &rightX, NULL, NULL, NULL);
+ if (rightX < overflow) {
+ maxOffScreen++;
+ }
+ if (entryPtr->leftIndex > maxOffScreen) {
+ entryPtr->leftIndex = maxOffScreen;
+ }
+ Tk_CharBbox(entryPtr->textLayout, entryPtr->leftIndex, &rightX,
+ NULL, NULL, NULL);
+ entryPtr->leftX = entryPtr->inset;
+ entryPtr->layoutX = entryPtr->leftX - rightX;
+ }
+
+ Tk_GetFontMetrics(entryPtr->tkfont, &fm);
+ height = fm.linespace + 2*entryPtr->inset + 2*(YPAD-XPAD);
+ if (entryPtr->prefWidth > 0) {
+ width = entryPtr->prefWidth*entryPtr->avgWidth + 2*entryPtr->inset;
+ } else if (totalLength == 0) {
+ width = entryPtr->avgWidth + 2*entryPtr->inset;
+ } else {
+ width = totalLength + 2*entryPtr->inset;
+ }
+
+ /*
+ * Add one extra length for the spin buttons
+ */
+ width += entryPtr->xWidth;
+
+ Tk_GeometryRequest(entryPtr->tkwin, width, height);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * InsertChars --
+ *
+ * Add new characters to an entry widget.
+ *
+ * Results:
+ * A standard Tcl result. If an error occurred then an error message is
+ * left in the interp's result.
+ *
+ * Side effects:
+ * New information gets added to entryPtr; it will be redisplayed soon,
+ * but not necessarily immediately.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+InsertChars(
+ Entry *entryPtr, /* Entry that is to get the new elements. */
+ int index, /* Add the new elements before this character
+ * index. */
+ const char *value) /* New characters to add (NULL-terminated
+ * string). */
+{
+ ptrdiff_t byteIndex;
+ size_t byteCount, newByteCount;
+ int oldChars, charsAdded;
+ const char *string;
+ char *newStr;
+
+ string = entryPtr->string;
+ byteIndex = Tcl_UtfAtIndex(string, index) - string;
+ byteCount = strlen(value);
+ if (byteCount == 0) {
+ return TCL_OK;
+ }
+
+ newByteCount = entryPtr->numBytes + byteCount + 1;
+ newStr = ckalloc(newByteCount);
+ memcpy(newStr, string, byteIndex);
+ strcpy(newStr + byteIndex, value);
+ strcpy(newStr + byteIndex + byteCount, string + byteIndex);
+
+ if ((entryPtr->validate == VALIDATE_KEY ||
+ entryPtr->validate == VALIDATE_ALL) &&
+ EntryValidateChange(entryPtr, value, newStr, index,
+ VALIDATE_INSERT) != TCL_OK) {
+ ckfree(newStr);
+ return TCL_OK;
+ }
+
+ ckfree((char *)string);
+ entryPtr->string = newStr;
+
+ /*
+ * 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(newStr, -1);
+ charsAdded = entryPtr->numChars - oldChars;
+ entryPtr->numBytes += byteCount;
+
+ if (entryPtr->displayString == string) {
+ entryPtr->displayString = newStr;
+ entryPtr->numDisplayBytes = entryPtr->numBytes;
+ }
+
+ /*
+ * Inserting characters invalidates all indexes into the string. Touch up
+ * the indexes so that they still refer to the same characters (at new
+ * positions). When updating the selection end-points, don't include the
+ * new text in the selection unless it was completely surrounded by the
+ * selection.
+ */
+
+ if (entryPtr->selectFirst >= index) {
+ entryPtr->selectFirst += charsAdded;
+ }
+ if (entryPtr->selectLast > index) {
+ entryPtr->selectLast += charsAdded;
+ }
+ if ((entryPtr->selectAnchor > index) || (entryPtr->selectFirst >= index)) {
+ entryPtr->selectAnchor += charsAdded;
+ }
+ if (entryPtr->leftIndex > index) {
+ entryPtr->leftIndex += charsAdded;
+ }
+ if (entryPtr->insertPos >= index) {
+ entryPtr->insertPos += charsAdded;
+ }
+ return EntryValueChanged(entryPtr, NULL);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * DeleteChars --
+ *
+ * Remove one or more characters from an entry widget.
+ *
+ * Results:
+ * A standard Tcl result. If an error occurred then an error message is
+ * left in the interp's result.
+ *
+ * Side effects:
+ * Memory gets freed, the entry gets modified and (eventually)
+ * redisplayed.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+DeleteChars(
+ Entry *entryPtr, /* Entry widget to modify. */
+ int index, /* Index of first character to delete. */
+ int count) /* How many characters to delete. */
+{
+ int byteIndex, byteCount, newByteCount;
+ const char *string;
+ char *newStr, *toDelete;
+
+ if ((index + count) > entryPtr->numChars) {
+ count = entryPtr->numChars - index;
+ }
+ if (count <= 0) {
+ return TCL_OK;
+ }
+
+ string = entryPtr->string;
+ byteIndex = Tcl_UtfAtIndex(string, index) - string;
+ byteCount = Tcl_UtfAtIndex(string + byteIndex, count) - (string+byteIndex);
+
+ newByteCount = entryPtr->numBytes + 1 - byteCount;
+ newStr = ckalloc(newByteCount);
+ memcpy(newStr, string, (size_t) byteIndex);
+ strcpy(newStr + byteIndex, string + byteIndex + byteCount);
+
+ toDelete = ckalloc(byteCount + 1);
+ memcpy(toDelete, string + byteIndex, (size_t) byteCount);
+ toDelete[byteCount] = '\0';
+
+ if ((entryPtr->validate == VALIDATE_KEY ||
+ entryPtr->validate == VALIDATE_ALL) &&
+ EntryValidateChange(entryPtr, toDelete, newStr, index,
+ VALIDATE_DELETE) != TCL_OK) {
+ ckfree(newStr);
+ ckfree(toDelete);
+ return TCL_OK;
+ }
+
+ ckfree(toDelete);
+ ckfree((char *)entryPtr->string);
+ entryPtr->string = newStr;
+ entryPtr->numChars -= count;
+ entryPtr->numBytes -= byteCount;
+
+ if (entryPtr->displayString == string) {
+ entryPtr->displayString = newStr;
+ entryPtr->numDisplayBytes = entryPtr->numBytes;
+ }
+
+ /*
+ * Deleting characters results in the remaining characters being
+ * renumbered. Update the various indexes into the string to reflect this
+ * change.
+ */
+
+ if (entryPtr->selectFirst >= index) {
+ if (entryPtr->selectFirst >= (index + count)) {
+ entryPtr->selectFirst -= count;
+ } else {
+ entryPtr->selectFirst = index;
+ }
+ }
+ if (entryPtr->selectLast >= index) {
+ if (entryPtr->selectLast >= (index + count)) {
+ entryPtr->selectLast -= count;
+ } else {
+ entryPtr->selectLast = index;
+ }
+ }
+ if (entryPtr->selectLast <= entryPtr->selectFirst) {
+ entryPtr->selectFirst = -1;
+ entryPtr->selectLast = -1;
+ }
+ if (entryPtr->selectAnchor >= index) {
+ if (entryPtr->selectAnchor >= (index+count)) {
+ entryPtr->selectAnchor -= count;
+ } else {
+ entryPtr->selectAnchor = index;
+ }
+ }
+ if (entryPtr->leftIndex > index) {
+ if (entryPtr->leftIndex >= (index + count)) {
+ entryPtr->leftIndex -= count;
+ } else {
+ entryPtr->leftIndex = index;
+ }
+ }
+ if (entryPtr->insertPos >= index) {
+ if (entryPtr->insertPos >= (index + count)) {
+ entryPtr->insertPos -= count;
+ } else {
+ entryPtr->insertPos = index;
+ }
+ }
+ return EntryValueChanged(entryPtr, NULL);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * EntryValueChanged --
+ *
+ * This function is invoked when characters are inserted into an entry or
+ * deleted from it. It updates the entry's associated variable, if there
+ * is one, and does other bookkeeping such as arranging for redisplay.
+ *
+ * Results:
+ * A standard Tcl result. If an error occurred then an error message is
+ * left in the interp's result.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+EntryValueChanged(
+ Entry *entryPtr, /* Entry whose value just changed. */
+ const char *newValue) /* If this value is not NULL, we first force
+ * the value of the entry to this. */
+{
+ if (newValue != NULL) {
+ EntrySetValue(entryPtr, newValue);
+ }
+
+ if (entryPtr->textVarName == NULL) {
+ newValue = NULL;
+ } else {
+ newValue = Tcl_SetVar2(entryPtr->interp, entryPtr->textVarName,
+ NULL, entryPtr->string, TCL_GLOBAL_ONLY|TCL_LEAVE_ERR_MSG);
+ }
+
+ if ((newValue != NULL) && (strcmp(newValue, entryPtr->string) != 0)) {
+ /*
+ * The value of the variable is different than what we asked for.
+ * This means that a trace on the variable modified it. In this case
+ * our trace function wasn't invoked since the modification came while
+ * a trace was already active on the variable. So, update our value to
+ * reflect the variable's latest value.
+ */
+
+ EntrySetValue(entryPtr, newValue);
+ } else {
+ /*
+ * Arrange for redisplay.
+ */
+
+ entryPtr->flags |= UPDATE_SCROLLBAR;
+ EntryComputeGeometry(entryPtr);
+ EventuallyRedraw(entryPtr);
+ }
+
+ /*
+ * An error may have happened when setting the textvariable in case there
+ * is a trace on that variable and the trace proc triggered an error.
+ * Another possibility is that the textvariable is in a namespace that
+ * does not (yet) exist.
+ * Signal this error.
+ */
+
+ if ((entryPtr->textVarName != NULL) && (newValue == NULL)) {
+ return TCL_ERROR;
+ }
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * EntrySetValue --
+ *
+ * Replace the contents of a text entry with a given value. This function
+ * is invoked when updating the entry from the entry's associated
+ * variable.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The string displayed in the entry will change. The selection,
+ * insertion point, and view may have to be adjusted to keep them within
+ * the bounds of the new string. Note: this function does *not* update
+ * the entry's associated variable, since that could result in an
+ * infinite loop.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+EntrySetValue(
+ Entry *entryPtr, /* Entry whose value is to be changed. */
+ const char *value) /* New text to display in entry. */
+{
+ const char *oldSource;
+ int valueLen, malloced = 0;
+
+ if (strcmp(value, entryPtr->string) == 0) {
+ return;
+ }
+ valueLen = strlen(value);
+
+ if (entryPtr->flags & VALIDATE_VAR) {
+ entryPtr->flags |= VALIDATE_ABORT;
+ } else {
+ /*
+ * If we validate, we create a copy of the value, as it may point to
+ * volatile memory, like the value of the -textvar which may get freed
+ * during validation
+ */
+
+ char *tmp = ckalloc(valueLen + 1);
+
+ strcpy(tmp, value);
+ value = tmp;
+ malloced = 1;
+
+ entryPtr->flags |= VALIDATE_VAR;
+ (void) EntryValidateChange(entryPtr, NULL, value, -1,
+ VALIDATE_FORCED);
+ entryPtr->flags &= ~VALIDATE_VAR;
+
+ /*
+ * If VALIDATE_ABORT has been set, then this operation should be
+ * aborted because the validatecommand did something else instead
+ */
+
+ if (entryPtr->flags & VALIDATE_ABORT) {
+ entryPtr->flags &= ~VALIDATE_ABORT;
+ ckfree((char *)value);
+ return;
+ }
+ }
+
+ oldSource = entryPtr->string;
+ ckfree((char *)entryPtr->string);
+
+ if (malloced) {
+ entryPtr->string = value;
+ } else {
+ char *tmp = ckalloc(valueLen + 1);
+
+ strcpy(tmp, value);
+ entryPtr->string = tmp;
+ }
+ entryPtr->numBytes = valueLen;
+ entryPtr->numChars = Tcl_NumUtfChars(value, valueLen);
+
+ if (entryPtr->displayString == oldSource) {
+ entryPtr->displayString = entryPtr->string;
+ entryPtr->numDisplayBytes = entryPtr->numBytes;
+ }
+
+ if (entryPtr->selectFirst >= 0) {
+ if (entryPtr->selectFirst >= entryPtr->numChars) {
+ entryPtr->selectFirst = -1;
+ entryPtr->selectLast = -1;
+ } else if (entryPtr->selectLast > entryPtr->numChars) {
+ entryPtr->selectLast = entryPtr->numChars;
+ }
+ }
+ if (entryPtr->leftIndex >= entryPtr->numChars) {
+ if (entryPtr->numChars > 0) {
+ entryPtr->leftIndex = entryPtr->numChars - 1;
+ } else {
+ entryPtr->leftIndex = 0;
+ }
+ }
+ if (entryPtr->insertPos > entryPtr->numChars) {
+ entryPtr->insertPos = entryPtr->numChars;
+ }
+
+ entryPtr->flags |= UPDATE_SCROLLBAR;
+ EntryComputeGeometry(entryPtr);
+ EventuallyRedraw(entryPtr);
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * EntryEventProc --
+ *
+ * This function is invoked by the Tk dispatcher for various events on
+ * entries.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * When the window gets deleted, internal structures get cleaned up.
+ * When it gets exposed, it is redisplayed.
+ *
+ *--------------------------------------------------------------
+ */
+
+static void
+EntryEventProc(
+ ClientData clientData, /* Information about window. */
+ XEvent *eventPtr) /* Information about event. */
+{
+ Entry *entryPtr = clientData;
+
+ if ((entryPtr->type == TK_SPINBOX) && (eventPtr->type == MotionNotify)) {
+ Spinbox *sbPtr = clientData;
+ int elem;
+
+ elem = GetSpinboxElement(sbPtr, eventPtr->xmotion.x,
+ eventPtr->xmotion.y);
+ if (elem != sbPtr->curElement) {
+ Tk_Cursor cursor;
+
+ sbPtr->curElement = elem;
+ if (elem == SEL_ENTRY) {
+ cursor = entryPtr->cursor;
+ } else if ((elem == SEL_BUTTONDOWN) || (elem == SEL_BUTTONUP)) {
+ cursor = sbPtr->bCursor;
+ } else {
+ cursor = None;
+ }
+ if (cursor != None) {
+ Tk_DefineCursor(entryPtr->tkwin, cursor);
+ } else {
+ Tk_UndefineCursor(entryPtr->tkwin);
+ }
+ }
+ return;
+ }
+
+ switch (eventPtr->type) {
+ case Expose:
+ EventuallyRedraw(entryPtr);
+ entryPtr->flags |= BORDER_NEEDED;
+ break;
+ case DestroyNotify:
+ if (!(entryPtr->flags & ENTRY_DELETED)) {
+ entryPtr->flags |= (ENTRY_DELETED | VALIDATE_ABORT);
+ Tcl_DeleteCommandFromToken(entryPtr->interp, entryPtr->widgetCmd);
+ if (entryPtr->flags & REDRAW_PENDING) {
+ Tcl_CancelIdleCall(DisplayEntry, clientData);
+ }
+ Tcl_EventuallyFree(clientData, (Tcl_FreeProc *) DestroyEntry);
+ }
+ break;
+ case ConfigureNotify:
+ Tcl_Preserve(entryPtr);
+ entryPtr->flags |= UPDATE_SCROLLBAR;
+ EntryComputeGeometry(entryPtr);
+ EventuallyRedraw(entryPtr);
+ Tcl_Release(entryPtr);
+ break;
+ case FocusIn:
+ case FocusOut:
+ if (eventPtr->xfocus.detail != NotifyInferior) {
+ EntryFocusProc(entryPtr, (eventPtr->type == FocusIn));
+ }
+ break;
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * EntryCmdDeletedProc --
+ *
+ * This function is invoked when a widget command is deleted. If the
+ * widget isn't already in the process of being destroyed, this command
+ * destroys it.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The widget is destroyed.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+EntryCmdDeletedProc(
+ ClientData clientData) /* Pointer to widget record for widget. */
+{
+ Entry *entryPtr = clientData;
+
+ /*
+ * This function 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 function destroys the
+ * widget.
+ */
+
+ if (!(entryPtr->flags & ENTRY_DELETED)) {
+ Tk_DestroyWindow(entryPtr->tkwin);
+ }
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * GetEntryIndex --
+ *
+ * Parse an index into an entry and return either its value or an error.
+ *
+ * Results:
+ * A standard Tcl result. If all went well, then *indexPtr is filled in
+ * with the character index (into entryPtr) corresponding to string. The
+ * index value is guaranteed to lie between 0 and the number of
+ * characters in the string, inclusive. If an error occurs then an error
+ * message is left in the interp's result.
+ *
+ * Side effects:
+ * None.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+static int
+GetEntryIndex(
+ Tcl_Interp *interp, /* For error messages. */
+ Entry *entryPtr, /* Entry for which the index is being
+ * specified. */
+ const char *string, /* Specifies character in entryPtr. */
+ int *indexPtr) /* Where to store converted character index */
+{
+ size_t length;
+
+ length = strlen(string);
+
+ switch (string[0]) {
+ case 'a':
+ if (strncmp(string, "anchor", length) != 0) {
+ goto badIndex;
+ }
+ *indexPtr = entryPtr->selectAnchor;
+ break;
+ case 'e':
+ if (strncmp(string, "end", length) != 0) {
+ goto badIndex;
+ }
+ *indexPtr = entryPtr->numChars;
+ break;
+ case 'i':
+ if (strncmp(string, "insert", length) != 0) {
+ goto badIndex;
+ }
+ *indexPtr = entryPtr->insertPos;
+ break;
+ case 's':
+ if (entryPtr->selectFirst < 0) {
+ Tcl_ResetResult(interp);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "selection isn't in widget %s",
+ Tk_PathName(entryPtr->tkwin)));
+ Tcl_SetErrorCode(interp, "TK",
+ (entryPtr->type == TK_ENTRY) ? "ENTRY" : "SPINBOX",
+ "NO_SELECTION", NULL);
+ return TCL_ERROR;
+ }
+ if (length < 5) {
+ goto badIndex;
+ }
+ if (strncmp(string, "sel.first", length) == 0) {
+ *indexPtr = entryPtr->selectFirst;
+ } else if (strncmp(string, "sel.last", length) == 0) {
+ *indexPtr = entryPtr->selectLast;
+ } else {
+ goto badIndex;
+ }
+ break;
+ case '@': {
+ int x, roundUp, maxWidth;
+
+ if (Tcl_GetInt(NULL, string + 1, &x) != TCL_OK) {
+ goto badIndex;
+ }
+ if (x < entryPtr->inset) {
+ x = entryPtr->inset;
+ }
+ roundUp = 0;
+ maxWidth = Tk_Width(entryPtr->tkwin) - entryPtr->inset
+ - entryPtr->xWidth - 1;
+ if (x > maxWidth) {
+ x = maxWidth;
+ roundUp = 1;
+ }
+ *indexPtr = Tk_PointToChar(entryPtr->textLayout,
+ x - entryPtr->layoutX, 0);
+
+ /*
+ * Special trick: if the x-position was off-screen to the right, round
+ * the index up to refer to the character just after the last visible
+ * one on the screen. This is needed to enable the last character to
+ * be selected, for example.
+ */
+
+ if (roundUp && (*indexPtr < entryPtr->numChars)) {
+ *indexPtr += 1;
+ }
+ break;
+ }
+ default:
+ if (Tcl_GetInt(NULL, string, indexPtr) != TCL_OK) {
+ goto badIndex;
+ }
+ if (*indexPtr < 0){
+ *indexPtr = 0;
+ } else if (*indexPtr > entryPtr->numChars) {
+ *indexPtr = entryPtr->numChars;
+ }
+ }
+ return TCL_OK;
+
+ badIndex:
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf("bad %s index \"%s\"",
+ (entryPtr->type == TK_ENTRY) ? "entry" : "spinbox", string));
+ Tcl_SetErrorCode(interp, "TK",
+ (entryPtr->type == TK_ENTRY) ? "ENTRY" : "SPINBOX",
+ "BAD_INDEX", NULL);
+ return TCL_ERROR;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * EntryScanTo --
+ *
+ * Given a y-coordinate (presumably of the curent mouse location) drag
+ * the view in the window to implement the scan operation.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The view in the window may change.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+EntryScanTo(
+ Entry *entryPtr, /* Information about widget. */
+ int x) /* X-coordinate to use for scan operation. */
+{
+ int newLeftIndex;
+
+ /*
+ * Compute new leftIndex for entry by amplifying the difference between
+ * the current position and the place where the scan started (the "mark"
+ * position). If we run off the left or right side of the entry, then
+ * reset the mark point so that the current position continues to
+ * correspond to the edge of the window. This means that the picture will
+ * start dragging as soon as the mouse reverses direction (without this
+ * reset, might have to slide mouse a long ways back before the picture
+ * starts moving again).
+ */
+
+ newLeftIndex = entryPtr->scanMarkIndex
+ - (10 * (x - entryPtr->scanMarkX)) / entryPtr->avgWidth;
+ if (newLeftIndex >= entryPtr->numChars) {
+ newLeftIndex = entryPtr->scanMarkIndex = entryPtr->numChars - 1;
+ entryPtr->scanMarkX = x;
+ }
+ if (newLeftIndex < 0) {
+ newLeftIndex = entryPtr->scanMarkIndex = 0;
+ entryPtr->scanMarkX = x;
+ }
+
+ if (newLeftIndex != entryPtr->leftIndex) {
+ entryPtr->leftIndex = newLeftIndex;
+ entryPtr->flags |= UPDATE_SCROLLBAR;
+ EntryComputeGeometry(entryPtr);
+ if (newLeftIndex != entryPtr->leftIndex) {
+ entryPtr->scanMarkIndex = entryPtr->leftIndex;
+ entryPtr->scanMarkX = x;
+ }
+ EventuallyRedraw(entryPtr);
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * EntrySelectTo --
+ *
+ * Modify the selection by moving its un-anchored end. This could make
+ * the selection either larger or smaller.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The selection changes.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+EntrySelectTo(
+ Entry *entryPtr, /* Information about widget. */
+ int index) /* Character index of element that is to
+ * become the "other" end of the selection. */
+{
+ int newFirst, newLast;
+
+ /*
+ * Grab the selection if we don't own it already.
+ */
+
+ if (!(entryPtr->flags & GOT_SELECTION) && (entryPtr->exportSelection)) {
+ Tk_OwnSelection(entryPtr->tkwin, XA_PRIMARY, EntryLostSelection,
+ entryPtr);
+ entryPtr->flags |= GOT_SELECTION;
+ }
+
+ /*
+ * Pick new starting and ending points for the selection.
+ */
+
+ if (entryPtr->selectAnchor > entryPtr->numChars) {
+ entryPtr->selectAnchor = entryPtr->numChars;
+ }
+ if (entryPtr->selectAnchor <= index) {
+ newFirst = entryPtr->selectAnchor;
+ newLast = index;
+ } else {
+ newFirst = index;
+ newLast = entryPtr->selectAnchor;
+ if (newLast < 0) {
+ newFirst = newLast = -1;
+ }
+ }
+ if ((entryPtr->selectFirst == newFirst)
+ && (entryPtr->selectLast == newLast)) {
+ return;
+ }
+ entryPtr->selectFirst = newFirst;
+ entryPtr->selectLast = newLast;
+ EventuallyRedraw(entryPtr);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * EntryFetchSelection --
+ *
+ * This function is called back by Tk when the selection is requested by
+ * someone. It returns part or all of the selection in a buffer provided
+ * by the caller.
+ *
+ * Results:
+ * The return value is the number of non-NULL bytes stored at buffer.
+ * Buffer is filled (or partially filled) with a NULL-terminated string
+ * containing part or all of the selection, as given by offset and
+ * maxBytes.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+EntryFetchSelection(
+ ClientData 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 NUL character. */
+{
+ Entry *entryPtr = clientData;
+ int byteCount;
+ const char *string;
+ const char *selStart, *selEnd;
+
+ if ((entryPtr->selectFirst < 0) || !(entryPtr->exportSelection)) {
+ return -1;
+ }
+ string = entryPtr->displayString;
+ selStart = Tcl_UtfAtIndex(string, entryPtr->selectFirst);
+ selEnd = Tcl_UtfAtIndex(selStart,
+ entryPtr->selectLast - entryPtr->selectFirst);
+ byteCount = selEnd - selStart - offset;
+ if (byteCount > maxBytes) {
+ byteCount = maxBytes;
+ }
+ if (byteCount <= 0) {
+ return 0;
+ }
+ memcpy(buffer, selStart + offset, (size_t) byteCount);
+ buffer[byteCount] = '\0';
+ return byteCount;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * EntryLostSelection --
+ *
+ * This function is called back by Tk when the selection is grabbed away
+ * from an entry widget.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The existing selection is unhighlighted, and the window is marked as
+ * not containing a selection.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+EntryLostSelection(
+ ClientData clientData) /* Information about entry widget. */
+{
+ Entry *entryPtr = clientData;
+
+ entryPtr->flags &= ~GOT_SELECTION;
+
+ /*
+ * On Windows and Mac systems, we want to remember the selection for the
+ * next time the focus enters the window. On Unix, we need to clear the
+ * selection since it is always visible.
+ * This is controlled by ::tk::AlwaysShowSelection.
+ */
+
+ if (TkpAlwaysShowSelection(entryPtr->tkwin)
+ && (entryPtr->selectFirst >= 0) && entryPtr->exportSelection) {
+ entryPtr->selectFirst = -1;
+ entryPtr->selectLast = -1;
+ EventuallyRedraw(entryPtr);
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * EventuallyRedraw --
+ *
+ * Ensure that an entry is eventually redrawn on the display.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Information gets redisplayed. Right now we don't do selective
+ * redisplays: the whole window will be redrawn. This doesn't seem to
+ * hurt performance noticeably, but if it does then this could be
+ * changed.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+EventuallyRedraw(
+ Entry *entryPtr) /* Information about widget. */
+{
+ if ((entryPtr->flags & ENTRY_DELETED) || !Tk_IsMapped(entryPtr->tkwin)) {
+ return;
+ }
+
+ /*
+ * Right now we don't do selective redisplays: the whole window will be
+ * redrawn. This doesn't seem to hurt performance noticeably, but if it
+ * does then this could be changed.
+ */
+
+ if (!(entryPtr->flags & REDRAW_PENDING)) {
+ entryPtr->flags |= REDRAW_PENDING;
+ Tcl_DoWhenIdle(DisplayEntry, entryPtr);
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * EntryVisibleRange --
+ *
+ * Return information about the range of the entry that is currently
+ * visible.
+ *
+ * Results:
+ * *firstPtr and *lastPtr are modified to hold fractions between 0 and 1
+ * identifying the range of characters visible in the entry.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+EntryVisibleRange(
+ Entry *entryPtr, /* Information about widget. */
+ double *firstPtr, /* Return position of first visible character
+ * in widget. */
+ double *lastPtr) /* Return position of char just after last
+ * visible one. */
+{
+ int charsInWindow;
+
+ if (entryPtr->numChars == 0) {
+ *firstPtr = 0.0;
+ *lastPtr = 1.0;
+ } else {
+ charsInWindow = Tk_PointToChar(entryPtr->textLayout,
+ Tk_Width(entryPtr->tkwin) - entryPtr->inset
+ - entryPtr->xWidth - entryPtr->layoutX - 1, 0);
+ if (charsInWindow < entryPtr->numChars) {
+ charsInWindow++;
+ }
+ charsInWindow -= entryPtr->leftIndex;
+ if (charsInWindow == 0) {
+ charsInWindow = 1;
+ }
+
+ *firstPtr = (double) entryPtr->leftIndex / entryPtr->numChars;
+ *lastPtr = (double) (entryPtr->leftIndex + charsInWindow)
+ / entryPtr->numChars;
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * EntryUpdateScrollbar --
+ *
+ * This function is invoked whenever information has changed in an entry
+ * in a way that would invalidate a scrollbar display. If there is an
+ * associated scrollbar, then this function updates it by invoking a Tcl
+ * command.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * A Tcl command is invoked, and an additional command may be
+ * invoked to process errors in the command.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+EntryUpdateScrollbar(
+ Entry *entryPtr) /* Information about widget. */
+{
+ char firstStr[TCL_DOUBLE_SPACE], lastStr[TCL_DOUBLE_SPACE];
+ int code;
+ double first, last;
+ Tcl_Interp *interp;
+ Tcl_DString buf;
+
+ if (entryPtr->scrollCmd == NULL) {
+ return;
+ }
+
+ interp = entryPtr->interp;
+ Tcl_Preserve(interp);
+ EntryVisibleRange(entryPtr, &first, &last);
+ Tcl_PrintDouble(NULL, first, firstStr);
+ Tcl_PrintDouble(NULL, last, lastStr);
+ Tcl_DStringInit(&buf);
+ Tcl_DStringAppend(&buf, entryPtr->scrollCmd, -1);
+ Tcl_DStringAppend(&buf, " ", -1);
+ Tcl_DStringAppend(&buf, firstStr, -1);
+ Tcl_DStringAppend(&buf, " ", -1);
+ Tcl_DStringAppend(&buf, lastStr, -1);
+ code = Tcl_EvalEx(interp, Tcl_DStringValue(&buf), -1, 0);
+ Tcl_DStringFree(&buf);
+ if (code != TCL_OK) {
+ Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf(
+ "\n (horizontal scrolling command executed by %s)",
+ Tk_PathName(entryPtr->tkwin)));
+ Tcl_BackgroundException(interp, code);
+ }
+ Tcl_ResetResult(interp);
+ Tcl_Release(interp);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * EntryBlinkProc --
+ *
+ * This function is called as a timer handler to blink the insertion
+ * cursor off and on.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The cursor gets turned on or off, redisplay gets invoked, and this
+ * function reschedules itself.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+EntryBlinkProc(
+ ClientData clientData) /* Pointer to record describing entry. */
+{
+ Entry *entryPtr = clientData;
+
+ if ((entryPtr->state == STATE_DISABLED) ||
+ (entryPtr->state == STATE_READONLY) ||
+ !(entryPtr->flags & GOT_FOCUS) || (entryPtr->insertOffTime == 0)) {
+ return;
+ }
+ if (entryPtr->flags & CURSOR_ON) {
+ entryPtr->flags &= ~CURSOR_ON;
+ entryPtr->insertBlinkHandler = Tcl_CreateTimerHandler(
+ entryPtr->insertOffTime, EntryBlinkProc, entryPtr);
+ } else {
+ entryPtr->flags |= CURSOR_ON;
+ entryPtr->insertBlinkHandler = Tcl_CreateTimerHandler(
+ entryPtr->insertOnTime, EntryBlinkProc, entryPtr);
+ }
+ EventuallyRedraw(entryPtr);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * EntryFocusProc --
+ *
+ * This function is called whenever the entry gets or loses the input
+ * focus. It's also called whenever the window is reconfigured while it
+ * has the focus.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The cursor gets turned on or off.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+EntryFocusProc(
+ Entry *entryPtr, /* Entry that got or lost focus. */
+ int gotFocus) /* 1 means window is getting focus, 0 means
+ * it's losing it. */
+{
+ Tcl_DeleteTimerHandler(entryPtr->insertBlinkHandler);
+ if (gotFocus) {
+ entryPtr->flags |= GOT_FOCUS | CURSOR_ON;
+ if (entryPtr->insertOffTime != 0) {
+ entryPtr->insertBlinkHandler = Tcl_CreateTimerHandler(
+ entryPtr->insertOnTime, EntryBlinkProc, entryPtr);
+ }
+ if (entryPtr->validate == VALIDATE_ALL ||
+ entryPtr->validate == VALIDATE_FOCUS ||
+ entryPtr->validate == VALIDATE_FOCUSIN) {
+ EntryValidateChange(entryPtr, NULL, entryPtr->string, -1,
+ VALIDATE_FOCUSIN);
+ }
+ } else {
+ entryPtr->flags &= ~(GOT_FOCUS | CURSOR_ON);
+ entryPtr->insertBlinkHandler = NULL;
+ if (entryPtr->validate == VALIDATE_ALL ||
+ entryPtr->validate == VALIDATE_FOCUS ||
+ entryPtr->validate == VALIDATE_FOCUSOUT) {
+ EntryValidateChange(entryPtr, NULL, entryPtr->string, -1,
+ VALIDATE_FOCUSOUT);
+ }
+ }
+ EventuallyRedraw(entryPtr);
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * EntryTextVarProc --
+ *
+ * This function is invoked when someone changes the variable whose
+ * contents are to be displayed in an entry.
+ *
+ * Results:
+ * NULL is always returned.
+ *
+ * Side effects:
+ * The text displayed in the entry will change to match the variable.
+ *
+ *--------------------------------------------------------------
+ */
+
+ /* ARGSUSED */
+static char *
+EntryTextVarProc(
+ ClientData clientData, /* Information about button. */
+ Tcl_Interp *interp, /* Interpreter containing variable. */
+ const char *name1, /* Not used. */
+ const char *name2, /* Not used. */
+ int flags) /* Information about what happened. */
+{
+ Entry *entryPtr = clientData;
+ const char *value;
+
+ if (entryPtr->flags & ENTRY_DELETED) {
+ /*
+ * Just abort early if we entered here while being deleted.
+ */
+ return NULL;
+ }
+
+ /*
+ * If the variable is unset, then immediately recreate it unless the whole
+ * interpreter is going away.
+ */
+
+ if (flags & TCL_TRACE_UNSETS) {
+ if ((flags & TCL_TRACE_DESTROYED) && !(flags & TCL_INTERP_DESTROYED)) {
+ Tcl_SetVar2(interp, entryPtr->textVarName, NULL,
+ entryPtr->string, TCL_GLOBAL_ONLY);
+ Tcl_TraceVar2(interp, entryPtr->textVarName, NULL,
+ TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS,
+ EntryTextVarProc, clientData);
+ entryPtr->flags |= ENTRY_VAR_TRACED;
+ }
+ return NULL;
+ }
+
+ /*
+ * Update the entry's text with the value of the variable, unless the
+ * entry already has that value (this happens when the variable changes
+ * value because we changed it because someone typed in the entry).
+ */
+
+ value = Tcl_GetVar2(interp, entryPtr->textVarName, NULL, TCL_GLOBAL_ONLY);
+ if (value == NULL) {
+ value = "";
+ }
+ EntrySetValue(entryPtr, value);
+ return NULL;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * EntryValidate --
+ *
+ * This function 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(
+ register Entry *entryPtr, /* Entry that needs validation. */
+ register char *cmd) /* Validation command (NULL-terminated
+ * string). */
+{
+ register Tcl_Interp *interp = entryPtr->interp;
+ int code, bool;
+
+ code = Tcl_EvalEx(interp, cmd, -1, TCL_EVAL_GLOBAL | TCL_EVAL_DIRECT);
+
+ /*
+ * We accept TCL_OK and TCL_RETURN as valid return codes from the command
+ * callback.
+ */
+
+ if (code != TCL_OK && code != TCL_RETURN) {
+ Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf(
+ "\n (in validation command executed by %s)",
+ Tk_PathName(entryPtr->tkwin)));
+ Tcl_BackgroundException(interp, code);
+ return TCL_ERROR;
+ }
+
+ /*
+ * The command callback should return an acceptable Tcl boolean.
+ */
+
+ if (Tcl_GetBooleanFromObj(interp, Tcl_GetObjResult(interp),
+ &bool) != TCL_OK) {
+ Tcl_AddErrorInfo(interp,
+ "\n (invalid boolean result from validation command)");
+ Tcl_BackgroundException(interp, TCL_ERROR);
+ Tcl_ResetResult(interp);
+ return TCL_ERROR;
+ }
+
+ Tcl_ResetResult(interp);
+ return (bool ? TCL_OK : TCL_BREAK);
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * EntryValidateChange --
+ *
+ * This function 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(
+ register Entry *entryPtr, /* Entry that needs validation. */
+ const char *change, /* Characters to be added/deleted
+ * (NUL-terminated string). */
+ const char *newValue, /* 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, newValue, index, type, &script);
+ Tcl_DStringAppend(&script, "", 1);
+
+ p = Tcl_DStringValue(&script);
+ code = EntryValidate(entryPtr, p);
+ Tcl_DStringFree(&script);
+
+ /*
+ * If e->validate has become VALIDATE_NONE during the validation, or we
+ * now have VALIDATE_VAR set (from EntrySetValue) and didn't before, it
+ * means that a loop condition almost occured. Do not allow this
+ * validation result to finish.
+ */
+
+ if (entryPtr->validate == VALIDATE_NONE
+ || (!varValidate && (entryPtr->flags & VALIDATE_VAR))) {
+ code = TCL_ERROR;
+ }
+
+ /*
+ * It's possible that the user deleted the entry during validation. In
+ * that case, abort future validation and return an error.
+ */
+
+ if (entryPtr->flags & ENTRY_DELETED) {
+ return TCL_ERROR;
+ }
+
+ /*
+ * If validate will return ERROR, then disallow further validations
+ * Otherwise, if it didn't accept the new string (returned TCL_BREAK) then
+ * eval the invalidCmd (if it's set)
+ */
+
+ if (code == TCL_ERROR) {
+ entryPtr->validate = VALIDATE_NONE;
+ } else if (code == TCL_BREAK) {
+ /*
+ * If we were doing forced validation (like via a variable trace) and
+ * the command returned 0, the we turn off validation because we
+ * assume that textvariables have precedence in managing the value.
+ * We also don't call the invcmd, as it may want to do entry
+ * manipulation which the setting of the var will later wipe anyway.
+ */
+
+ if (varValidate) {
+ entryPtr->validate = VALIDATE_NONE;
+ } else if (entryPtr->invalidCmd != NULL) {
+ int result;
+
+ Tcl_DStringInit(&script);
+ ExpandPercents(entryPtr, entryPtr->invalidCmd,
+ change, newValue, index, type, &script);
+ Tcl_DStringAppend(&script, "", 1);
+ p = Tcl_DStringValue(&script);
+ result = Tcl_EvalEx(entryPtr->interp, p, -1,
+ TCL_EVAL_GLOBAL | TCL_EVAL_DIRECT);
+ if (result != TCL_OK) {
+ Tcl_AddErrorInfo(entryPtr->interp,
+ "\n (in invalidcommand executed by entry)");
+ Tcl_BackgroundException(entryPtr->interp, result);
+ code = TCL_ERROR;
+ entryPtr->validate = VALIDATE_NONE;
+ }
+ Tcl_DStringFree(&script);
+
+ /*
+ * It's possible that the user deleted the entry during
+ * validation. In that case, abort future validation and return an
+ * error.
+ */
+
+ if (entryPtr->flags & ENTRY_DELETED) {
+ return TCL_ERROR;
+ }
+ }
+ }
+
+ entryPtr->flags &= ~VALIDATING;
+
+ return code;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * ExpandPercents --
+ *
+ * Given a command and an event, produce a new command by replacing %
+ * constructs in the original command with information from the X event.
+ *
+ * Results:
+ * The new expanded command is appended to the dynamic string given by
+ * dsPtr.
+ *
+ * Side effects:
+ * None.
+ *
+ *--------------------------------------------------------------
+ */
+
+static void
+ExpandPercents(
+ register Entry *entryPtr, /* Entry that needs validation. */
+ register const char *before,
+ /* Command containing percent expressions to
+ * be replaced. */
+ const char *change, /* Characters to added/deleted (NUL-terminated
+ * string). */
+ const char *newValue, /* Potential new value of entry string */
+ int index, /* index of insert/delete */
+ int type, /* INSERT or DELETE */
+ Tcl_DString *dsPtr) /* Dynamic string in which to append new
+ * command. */
+{
+ int spaceNeeded, cvtFlags; /* Used to substitute string as proper Tcl
+ * list element. */
+ int number, length;
+ register const char *string;
+ Tcl_UniChar ch;
+ char numStorage[2*TCL_INTEGER_SPACE];
+
+ while (1) {
+ if (*before == '\0') {
+ break;
+ }
+ /*
+ * Find everything up to the next % character and append it to the
+ * result string.
+ */
+
+ string = before;
+
+ /*
+ * No need to convert '%', as it is in ascii range.
+ */
+
+ string = Tcl_UtfFindFirst(before, '%');
+ if (string == NULL) {
+ Tcl_DStringAppend(dsPtr, before, -1);
+ break;
+ } else if (string != before) {
+ Tcl_DStringAppend(dsPtr, before, string-before);
+ before = string;
+ }
+
+ /*
+ * There's a percent sequence here. Process it.
+ */
+
+ before++; /* skip over % */
+ if (*before != '\0') {
+ before += Tcl_UtfToUniChar(before, &ch);
+ } else {
+ ch = '%';
+ }
+ if (type == VALIDATE_BUTTON) {
+ /*
+ * -command %-substitution
+ */
+
+ switch (ch) {
+ case 's': /* Current string value of spinbox */
+ string = entryPtr->string;
+ break;
+ case 'd': /* direction, up or down */
+ string = change;
+ break;
+ case 'W': /* widget name */
+ string = Tk_PathName(entryPtr->tkwin);
+ break;
+ default:
+ length = Tcl_UniCharToUtf(ch, numStorage);
+ numStorage[length] = '\0';
+ string = numStorage;
+ break;
+ }
+ } else {
+ /*
+ * -validatecommand / -invalidcommand %-substitution
+ */
+
+ switch (ch) {
+ case 'd': /* Type of call that caused validation */
+ switch (type) {
+ case VALIDATE_INSERT:
+ number = 1;
+ break;
+ case VALIDATE_DELETE:
+ number = 0;
+ break;
+ default:
+ number = -1;
+ break;
+ }
+ sprintf(numStorage, "%d", number);
+ string = numStorage;
+ break;
+ case 'i': /* index of insert/delete */
+ sprintf(numStorage, "%d", index);
+ string = numStorage;
+ break;
+ case 'P': /* 'Peeked' new value of the string */
+ string = newValue;
+ break;
+ case 's': /* Current string value of spinbox */
+ string = entryPtr->string;
+ break;
+ case 'S': /* string to be inserted/deleted, if any */
+ string = change;
+ break;
+ case 'v': /* type of validation currently set */
+ string = validateStrings[entryPtr->validate];
+ break;
+ case 'V': /* type of validation in effect */
+ switch (type) {
+ case VALIDATE_INSERT:
+ case VALIDATE_DELETE:
+ string = validateStrings[VALIDATE_KEY];
+ break;
+ case VALIDATE_FORCED:
+ string = "forced";
+ break;
+ default:
+ string = validateStrings[type];
+ break;
+ }
+ break;
+ case 'W': /* widget name */
+ string = Tk_PathName(entryPtr->tkwin);
+ break;
+ default:
+ length = Tcl_UniCharToUtf(ch, numStorage);
+ numStorage[length] = '\0';
+ string = numStorage;
+ break;
+ }
+ }
+
+ spaceNeeded = Tcl_ScanCountedElement(string, -1, &cvtFlags);
+ length = Tcl_DStringLength(dsPtr);
+ Tcl_DStringSetLength(dsPtr, length + spaceNeeded);
+ spaceNeeded = Tcl_ConvertCountedElement(string, -1,
+ Tcl_DStringValue(dsPtr) + length,
+ cvtFlags | TCL_DONT_USE_BRACES);
+ Tcl_DStringSetLength(dsPtr, length + spaceNeeded);
+ }
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * Tk_SpinboxObjCmd --
+ *
+ * This function is invoked to process the "spinbox" Tcl command. See the
+ * user documentation for details on what it does.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * See the user documentation.
+ *
+ *--------------------------------------------------------------
+ */
+
+int
+Tk_SpinboxObjCmd(
+ ClientData clientData, /* NULL. */
+ Tcl_Interp *interp, /* Current interpreter. */
+ int objc, /* Number of arguments. */
+ Tcl_Obj *const objv[]) /* Argument objects. */
+{
+ register Entry *entryPtr;
+ register Spinbox *sbPtr;
+ Tk_OptionTable optionTable;
+ Tk_Window tkwin;
+ char *tmp;
+
+ if (objc < 2) {
+ Tcl_WrongNumArgs(interp, 1, objv, "pathName ?-option value ...?");
+ return TCL_ERROR;
+ }
+
+ tkwin = Tk_CreateWindowFromPath(interp, Tk_MainWindow(interp),
+ Tcl_GetString(objv[1]), NULL);
+ if (tkwin == NULL) {
+ return TCL_ERROR;
+ }
+
+ /*
+ * Create the option table for this widget class. If it has already been
+ * created, Tk will return the cached value.
+ */
+
+ optionTable = Tk_CreateOptionTable(interp, sbOptSpec);
+
+ /*
+ * Initialize the fields of the structure that won't be initialized by
+ * ConfigureEntry, or that ConfigureEntry requires to be initialized
+ * already (e.g. resource pointers). Only the non-NULL/0 data must be
+ * initialized as memset covers the rest.
+ */
+
+ sbPtr = ckalloc(sizeof(Spinbox));
+ entryPtr = (Entry *) sbPtr;
+ memset(sbPtr, 0, sizeof(Spinbox));
+
+ entryPtr->tkwin = tkwin;
+ entryPtr->display = Tk_Display(tkwin);
+ entryPtr->interp = interp;
+ entryPtr->widgetCmd = Tcl_CreateObjCommand(interp,
+ Tk_PathName(entryPtr->tkwin), SpinboxWidgetObjCmd, sbPtr,
+ EntryCmdDeletedProc);
+ entryPtr->optionTable = optionTable;
+ entryPtr->type = TK_SPINBOX;
+ tmp = ckalloc(1);
+ tmp[0] = '\0';
+ entryPtr->string = tmp;
+ entryPtr->selectFirst = -1;
+ entryPtr->selectLast = -1;
+
+ entryPtr->cursor = None;
+ entryPtr->exportSelection = 1;
+ entryPtr->justify = TK_JUSTIFY_LEFT;
+ entryPtr->relief = TK_RELIEF_FLAT;
+ entryPtr->state = STATE_NORMAL;
+ entryPtr->displayString = entryPtr->string;
+ entryPtr->inset = XPAD;
+ entryPtr->textGC = None;
+ entryPtr->selTextGC = None;
+ entryPtr->highlightGC = None;
+ entryPtr->avgWidth = 1;
+ entryPtr->validate = VALIDATE_NONE;
+
+ sbPtr->selElement = SEL_NONE;
+ sbPtr->curElement = SEL_NONE;
+ sbPtr->bCursor = None;
+ sbPtr->repeatDelay = 400;
+ sbPtr->repeatInterval = 100;
+ sbPtr->fromValue = 0.0;
+ sbPtr->toValue = 100.0;
+ sbPtr->increment = 1.0;
+ sbPtr->formatBuf = ckalloc(TCL_DOUBLE_SPACE);
+ sbPtr->bdRelief = TK_RELIEF_FLAT;
+ sbPtr->buRelief = TK_RELIEF_FLAT;
+
+ /*
+ * Keep a hold of the associated tkwin until we destroy the spinbox,
+ * otherwise Tk might free it while we still need it.
+ */
+
+ Tcl_Preserve(entryPtr->tkwin);
+
+ Tk_SetClass(entryPtr->tkwin, "Spinbox");
+ Tk_SetClassProcs(entryPtr->tkwin, &entryClass, entryPtr);
+ Tk_CreateEventHandler(entryPtr->tkwin,
+ PointerMotionMask|ExposureMask|StructureNotifyMask|FocusChangeMask,
+ EntryEventProc, entryPtr);
+ Tk_CreateSelHandler(entryPtr->tkwin, XA_PRIMARY, XA_STRING,
+ EntryFetchSelection, entryPtr, XA_STRING);
+
+ if (Tk_InitOptions(interp, (char *) sbPtr, optionTable, tkwin)
+ != TCL_OK) {
+ Tk_DestroyWindow(entryPtr->tkwin);
+ return TCL_ERROR;
+ }
+ if (ConfigureEntry(interp, entryPtr, objc-2, objv+2) != TCL_OK) {
+ goto error;
+ }
+
+ Tcl_SetObjResult(interp, TkNewWindowObj(entryPtr->tkwin));
+ return TCL_OK;
+
+ error:
+ Tk_DestroyWindow(entryPtr->tkwin);
+ return TCL_ERROR;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * SpinboxWidgetObjCmd --
+ *
+ * This function is invoked to process the Tcl command that corresponds
+ * to a widget managed by this module. See the user documentation for
+ * details on what it does.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * See the user documentation.
+ *
+ *--------------------------------------------------------------
+ */
+
+static int
+SpinboxWidgetObjCmd(
+ ClientData clientData, /* Information about spinbox widget. */
+ Tcl_Interp *interp, /* Current interpreter. */
+ int objc, /* Number of arguments. */
+ Tcl_Obj *const objv[]) /* Argument objects. */
+{
+ Entry *entryPtr = clientData;
+ Spinbox *sbPtr = clientData;
+ int cmdIndex, selIndex, result;
+ Tcl_Obj *objPtr;
+
+ if (objc < 2) {
+ Tcl_WrongNumArgs(interp, 1, objv, "option ?arg ...?");
+ return TCL_ERROR;
+ }
+
+ /*
+ * Parse the widget command by looking up the second token in the list of
+ * valid command names.
+ */
+
+ result = Tcl_GetIndexFromObj(interp, objv[1], sbCmdNames,
+ "option", 0, &cmdIndex);
+ if (result != TCL_OK) {
+ return result;
+ }
+
+ Tcl_Preserve(entryPtr);
+ switch ((enum sbCmd) cmdIndex) {
+ case SB_CMD_BBOX: {
+ int index, x, y, width, height;
+ Tcl_Obj *bbox[4];
+
+ if (objc != 3) {
+ Tcl_WrongNumArgs(interp, 2, objv, "index");
+ goto error;
+ }
+ if (GetEntryIndex(interp, entryPtr, Tcl_GetString(objv[2]),
+ &index) != TCL_OK) {
+ goto error;
+ }
+ if ((index == entryPtr->numChars) && (index > 0)) {
+ index--;
+ }
+ Tk_CharBbox(entryPtr->textLayout, index, &x, &y, &width, &height);
+ bbox[0] = Tcl_NewIntObj(x + entryPtr->layoutX);
+ bbox[1] = Tcl_NewIntObj(y + entryPtr->layoutY);
+ bbox[2] = Tcl_NewIntObj(width);
+ bbox[3] = Tcl_NewIntObj(height);
+ Tcl_SetObjResult(interp, Tcl_NewListObj(4, bbox));
+ break;
+ }
+
+ case SB_CMD_CGET:
+ if (objc != 3) {
+ Tcl_WrongNumArgs(interp, 2, objv, "option");
+ goto error;
+ }
+
+ objPtr = Tk_GetOptionValue(interp, (char *) entryPtr,
+ entryPtr->optionTable, objv[2], entryPtr->tkwin);
+ if (objPtr == NULL) {
+ goto error;
+ }
+ Tcl_SetObjResult(interp, objPtr);
+ break;
+
+ case SB_CMD_CONFIGURE:
+ if (objc <= 3) {
+ objPtr = Tk_GetOptionInfo(interp, (char *) entryPtr,
+ entryPtr->optionTable, (objc == 3) ? objv[2] : NULL,
+ entryPtr->tkwin);
+ if (objPtr == NULL) {
+ goto error;
+ }
+ Tcl_SetObjResult(interp, objPtr);
+ } else {
+ result = ConfigureEntry(interp, entryPtr, objc-2, objv+2);
+ }
+ break;
+
+ case SB_CMD_DELETE: {
+ int first, last, code;
+
+ if ((objc < 3) || (objc > 4)) {
+ Tcl_WrongNumArgs(interp, 2, objv, "firstIndex ?lastIndex?");
+ goto error;
+ }
+ if (GetEntryIndex(interp, entryPtr, Tcl_GetString(objv[2]),
+ &first) != TCL_OK) {
+ goto error;
+ }
+ if (objc == 3) {
+ last = first + 1;
+ } else {
+ if (GetEntryIndex(interp, entryPtr, Tcl_GetString(objv[3]),
+ &last) != TCL_OK) {
+ goto error;
+ }
+ }
+ if ((last >= first) && (entryPtr->state == STATE_NORMAL)) {
+ code = DeleteChars(entryPtr, first, last - first);
+ if (code != TCL_OK) {
+ goto error;
+ }
+ }
+ break;
+ }
+
+ case SB_CMD_GET:
+ if (objc != 2) {
+ Tcl_WrongNumArgs(interp, 2, objv, NULL);
+ goto error;
+ }
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(entryPtr->string, -1));
+ break;
+
+ case SB_CMD_ICURSOR:
+ if (objc != 3) {
+ Tcl_WrongNumArgs(interp, 2, objv, "pos");
+ goto error;
+ }
+ if (GetEntryIndex(interp, entryPtr, Tcl_GetString(objv[2]),
+ &entryPtr->insertPos) != TCL_OK) {
+ goto error;
+ }
+ EventuallyRedraw(entryPtr);
+ break;
+
+ case SB_CMD_IDENTIFY: {
+ int x, y, elem;
+
+ if (objc != 4) {
+ Tcl_WrongNumArgs(interp, 2, objv, "x y");
+ goto error;
+ }
+ if ((Tcl_GetIntFromObj(interp, objv[2], &x) != TCL_OK) ||
+ (Tcl_GetIntFromObj(interp, objv[3], &y) != TCL_OK)) {
+ goto error;
+ }
+ elem = GetSpinboxElement(sbPtr, x, y);
+ if (elem != SEL_NONE) {
+ Tcl_SetObjResult(interp,
+ Tcl_NewStringObj(selElementNames[elem], -1));
+ }
+ break;
+ }
+
+ case SB_CMD_INDEX: {
+ int index;
+
+ if (objc != 3) {
+ Tcl_WrongNumArgs(interp, 2, objv, "string");
+ goto error;
+ }
+ if (GetEntryIndex(interp, entryPtr, Tcl_GetString(objv[2]),
+ &index) != TCL_OK) {
+ goto error;
+ }
+ Tcl_SetObjResult(interp, Tcl_NewIntObj(index));
+ break;
+ }
+
+ case SB_CMD_INSERT: {
+ int index, code;
+
+ if (objc != 4) {
+ Tcl_WrongNumArgs(interp, 2, objv, "index text");
+ goto error;
+ }
+ if (GetEntryIndex(interp, entryPtr, Tcl_GetString(objv[2]),
+ &index) != TCL_OK) {
+ goto error;
+ }
+ if (entryPtr->state == STATE_NORMAL) {
+ code = InsertChars(entryPtr, index, Tcl_GetString(objv[3]));
+ if (code != TCL_OK) {
+ goto error;
+ }
+ }
+ break;
+ }
+
+ case SB_CMD_INVOKE:
+ if (objc != 3) {
+ Tcl_WrongNumArgs(interp, 2, objv, "elemName");
+ goto error;
+ }
+ result = Tcl_GetIndexFromObj(interp, objv[2],
+ selElementNames, "element", 0, &cmdIndex);
+ if (result != TCL_OK) {
+ goto error;
+ }
+ if (entryPtr->state != STATE_DISABLED) {
+ if (SpinboxInvoke(interp, sbPtr, cmdIndex) != TCL_OK) {
+ goto error;
+ }
+ }
+ break;
+
+ case SB_CMD_SCAN: {
+ int x;
+ const char *minorCmd;
+
+ if (objc != 4) {
+ Tcl_WrongNumArgs(interp, 2, objv, "mark|dragto x");
+ goto error;
+ }
+ if (Tcl_GetIntFromObj(interp, objv[3], &x) != TCL_OK) {
+ goto error;
+ }
+
+ minorCmd = Tcl_GetString(objv[2]);
+ if (minorCmd[0] == 'm'
+ && (strncmp(minorCmd, "mark", strlen(minorCmd)) == 0)) {
+ entryPtr->scanMarkX = x;
+ entryPtr->scanMarkIndex = entryPtr->leftIndex;
+ } else if ((minorCmd[0] == 'd')
+ && (strncmp(minorCmd, "dragto", strlen(minorCmd)) == 0)) {
+ EntryScanTo(entryPtr, x);
+ } else {
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "bad scan option \"%s\": must be mark or dragto",
+ minorCmd));
+ Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "INDEX", "scan option",
+ minorCmd, NULL);
+ goto error;
+ }
+ break;
+ }
+
+ case SB_CMD_SELECTION: {
+ int index, index2;
+
+ if (objc < 3) {
+ Tcl_WrongNumArgs(interp, 2, objv, "option ?index?");
+ goto error;
+ }
+
+ /*
+ * Parse the selection sub-command, using the command table
+ * "sbSelCmdNames" defined above.
+ */
+
+ result = Tcl_GetIndexFromObj(interp, objv[2], sbSelCmdNames,
+ "selection option", 0, &selIndex);
+ if (result != TCL_OK) {
+ goto error;
+ }
+
+ /*
+ * Disabled entries don't allow the selection to be modified, but
+ * 'selection present' must return a boolean.
+ */
+
+ if ((entryPtr->state == STATE_DISABLED)
+ && (selIndex != SB_SEL_PRESENT)) {
+ goto done;
+ }
+
+ switch (selIndex) {
+ case SB_SEL_ADJUST:
+ if (objc != 4) {
+ Tcl_WrongNumArgs(interp, 3, objv, "index");
+ goto error;
+ }
+ if (GetEntryIndex(interp, entryPtr,
+ Tcl_GetString(objv[3]), &index) != TCL_OK) {
+ goto error;
+ }
+ if (entryPtr->selectFirst >= 0) {
+ int half1, half2;
+
+ half1 = (entryPtr->selectFirst + entryPtr->selectLast)/2;
+ half2 = (entryPtr->selectFirst + entryPtr->selectLast + 1)/2;
+ if (index < half1) {
+ entryPtr->selectAnchor = entryPtr->selectLast;
+ } else if (index > half2) {
+ entryPtr->selectAnchor = entryPtr->selectFirst;
+ } else {
+ /*
+ * We're at about the halfway point in the selection; just
+ * keep the existing anchor.
+ */
+ }
+ }
+ EntrySelectTo(entryPtr, index);
+ break;
+
+ case SB_SEL_CLEAR:
+ if (objc != 3) {
+ Tcl_WrongNumArgs(interp, 3, objv, NULL);
+ goto error;
+ }
+ if (entryPtr->selectFirst >= 0) {
+ entryPtr->selectFirst = -1;
+ entryPtr->selectLast = -1;
+ EventuallyRedraw(entryPtr);
+ }
+ goto done;
+
+ case SB_SEL_FROM:
+ if (objc != 4) {
+ Tcl_WrongNumArgs(interp, 3, objv, "index");
+ goto error;
+ }
+ if (GetEntryIndex(interp, entryPtr,
+ Tcl_GetString(objv[3]), &index) != TCL_OK) {
+ goto error;
+ }
+ entryPtr->selectAnchor = index;
+ break;
+
+ case SB_SEL_PRESENT:
+ if (objc != 3) {
+ Tcl_WrongNumArgs(interp, 3, objv, NULL);
+ goto error;
+ }
+ Tcl_SetObjResult(interp, Tcl_NewBooleanObj(
+ entryPtr->selectFirst >= 0));
+ goto done;
+
+ case SB_SEL_RANGE:
+ if (objc != 5) {
+ Tcl_WrongNumArgs(interp, 3, objv, "start end");
+ goto error;
+ }
+ if (GetEntryIndex(interp, entryPtr,
+ Tcl_GetString(objv[3]), &index) != TCL_OK) {
+ goto error;
+ }
+ if (GetEntryIndex(interp, entryPtr,
+ Tcl_GetString(objv[4]),& index2) != TCL_OK) {
+ goto error;
+ }
+ if (index >= index2) {
+ entryPtr->selectFirst = -1;
+ entryPtr->selectLast = -1;
+ } else {
+ entryPtr->selectFirst = index;
+ entryPtr->selectLast = index2;
+ }
+ if (!(entryPtr->flags & GOT_SELECTION)
+ && entryPtr->exportSelection) {
+ Tk_OwnSelection(entryPtr->tkwin, XA_PRIMARY,
+ EntryLostSelection, entryPtr);
+ entryPtr->flags |= GOT_SELECTION;
+ }
+ EventuallyRedraw(entryPtr);
+ break;
+
+ case SB_SEL_TO:
+ if (objc != 4) {
+ Tcl_WrongNumArgs(interp, 3, objv, "index");
+ goto error;
+ }
+ if (GetEntryIndex(interp, entryPtr,
+ Tcl_GetString(objv[3]), &index) != TCL_OK) {
+ goto error;
+ }
+ EntrySelectTo(entryPtr, index);
+ break;
+
+ case SB_SEL_ELEMENT:
+ if ((objc < 3) || (objc > 4)) {
+ Tcl_WrongNumArgs(interp, 3, objv, "?elemName?");
+ goto error;
+ }
+ if (objc == 3) {
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ selElementNames[sbPtr->selElement], -1));
+ } else {
+ int lastElement = sbPtr->selElement;
+
+ result = Tcl_GetIndexFromObj(interp, objv[3], selElementNames,
+ "selection element", 0, &(sbPtr->selElement));
+ if (result != TCL_OK) {
+ goto error;
+ }
+ if (lastElement != sbPtr->selElement) {
+ EventuallyRedraw(entryPtr);
+ }
+ }
+ break;
+ }
+ break;
+ }
+
+ case SB_CMD_SET: {
+ int code = TCL_OK;
+
+ if (objc > 3) {
+ Tcl_WrongNumArgs(interp, 2, objv, "?string?");
+ goto error;
+ }
+ if (objc == 3) {
+ code = EntryValueChanged(entryPtr, Tcl_GetString(objv[2]));
+ if (code != TCL_OK) {
+ goto error;
+ }
+ }
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(entryPtr->string, -1));
+ break;
+ }
+
+ case SB_CMD_VALIDATE: {
+ int code;
+
+ if (objc != 2) {
+ Tcl_WrongNumArgs(interp, 2, objv, NULL);
+ goto error;
+ }
+ selIndex = entryPtr->validate;
+ entryPtr->validate = VALIDATE_ALL;
+ code = EntryValidateChange(entryPtr, NULL, entryPtr->string,
+ -1, VALIDATE_FORCED);
+ if (entryPtr->validate != VALIDATE_NONE) {
+ entryPtr->validate = selIndex;
+ }
+
+ Tcl_SetObjResult(interp, Tcl_NewBooleanObj(code == TCL_OK));
+ break;
+ }
+
+ case SB_CMD_XVIEW: {
+ int index;
+
+ if (objc == 2) {
+ double first, last;
+ Tcl_Obj *span[2];
+
+ EntryVisibleRange(entryPtr, &first, &last);
+ span[0] = Tcl_NewDoubleObj(first);
+ span[1] = Tcl_NewDoubleObj(last);
+ Tcl_SetObjResult(interp, Tcl_NewListObj(2, span));
+ goto done;
+ } else if (objc == 3) {
+ if (GetEntryIndex(interp, entryPtr, Tcl_GetString(objv[2]),
+ &index) != TCL_OK) {
+ goto error;
+ }
+ } else {
+ double fraction;
+ int count;
+
+ index = entryPtr->leftIndex;
+ switch (Tk_GetScrollInfoObj(interp, objc, objv, &fraction,
+ &count)) {
+ case TK_SCROLL_ERROR:
+ goto error;
+ case TK_SCROLL_MOVETO:
+ index = (int) ((fraction * entryPtr->numChars) + 0.5);
+ break;
+ case TK_SCROLL_PAGES: {
+ int charsPerPage;
+
+ charsPerPage = ((Tk_Width(entryPtr->tkwin)
+ - 2 * entryPtr->inset - entryPtr->xWidth)
+ / entryPtr->avgWidth) - 2;
+ if (charsPerPage < 1) {
+ charsPerPage = 1;
+ }
+ index += count * charsPerPage;
+ break;
+ }
+ case TK_SCROLL_UNITS:
+ index += count;
+ break;
+ }
+ }
+ if (index >= entryPtr->numChars) {
+ index = entryPtr->numChars - 1;
+ }
+ if (index < 0) {
+ index = 0;
+ }
+ entryPtr->leftIndex = index;
+ entryPtr->flags |= UPDATE_SCROLLBAR;
+ EntryComputeGeometry(entryPtr);
+ EventuallyRedraw(entryPtr);
+ break;
+ }
+ }
+
+ done:
+ Tcl_Release(entryPtr);
+ return result;
+
+ error:
+ Tcl_Release(entryPtr);
+ return TCL_ERROR;
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * GetSpinboxElement --
+ *
+ * Return the element associated with an x,y coord.
+ *
+ * Results:
+ * Element type as enum selelement.
+ *
+ * Side effects:
+ * None.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+static int
+GetSpinboxElement(
+ Spinbox *sbPtr, /* Spinbox for which the index is being
+ * specified. */
+ int x, int y) /* Widget-relative coordinates. */
+{
+ Entry *entryPtr = (Entry *) sbPtr;
+
+ if ((x < 0) || (y < 0) || (y > Tk_Height(entryPtr->tkwin))
+ || (x > Tk_Width(entryPtr->tkwin))) {
+ return SEL_NONE;
+ }
+
+ if (x > (Tk_Width(entryPtr->tkwin) - entryPtr->inset - entryPtr->xWidth)) {
+ if (y > (Tk_Height(entryPtr->tkwin) / 2)) {
+ return SEL_BUTTONDOWN;
+ } else {
+ return SEL_BUTTONUP;
+ }
+ }
+ return SEL_ENTRY;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * SpinboxInvoke --
+ *
+ * This function is invoked when the invoke method for the widget is
+ * called.
+ *
+ * Results:
+ * TCL_OK.
+ *
+ * Side effects:
+ * A background error condition may arise when invoking the callback.
+ * The widget value may change.
+ *
+ *--------------------------------------------------------------
+ */
+
+static int
+SpinboxInvoke(
+ register Tcl_Interp *interp,/* Current interpreter. */
+ register Spinbox *sbPtr, /* Spinbox to invoke. */
+ int element) /* Element to invoke, either the "up" or
+ * "down" button. */
+{
+ Entry *entryPtr = (Entry *) sbPtr;
+ const char *type;
+ int code, up;
+ Tcl_DString script;
+
+ switch (element) {
+ case SEL_BUTTONUP:
+ type = "up";
+ up = 1;
+ break;
+ case SEL_BUTTONDOWN:
+ type = "down";
+ up = 0;
+ break;
+ default:
+ return TCL_OK;
+ }
+
+ code = TCL_OK;
+ if (fabs(sbPtr->increment) > MIN_DBL_VAL) {
+ if (sbPtr->listObj != NULL) {
+ Tcl_Obj *objPtr;
+
+ Tcl_ListObjIndex(interp, sbPtr->listObj, sbPtr->eIndex, &objPtr);
+ if (strcmp(Tcl_GetString(objPtr), entryPtr->string)) {
+ /*
+ * Somehow the string changed from what we expected, so let's
+ * do a search on the list to see if the current value is
+ * there. If not, move to the first element of the list.
+ */
+
+ int i, listc, elemLen, length = entryPtr->numChars;
+ const char *bytes;
+ Tcl_Obj **listv;
+
+ Tcl_ListObjGetElements(interp, sbPtr->listObj, &listc, &listv);
+ for (i = 0; i < listc; i++) {
+ bytes = Tcl_GetStringFromObj(listv[i], &elemLen);
+ if ((length == elemLen) &&
+ (memcmp(bytes, entryPtr->string,
+ (size_t) length) == 0)) {
+ sbPtr->eIndex = i;
+ break;
+ }
+ }
+ }
+ if (up) {
+ if (++sbPtr->eIndex >= sbPtr->nElements) {
+ if (sbPtr->wrap) {
+ sbPtr->eIndex = 0;
+ } else {
+ sbPtr->eIndex = sbPtr->nElements-1;
+ }
+ }
+ } else {
+ if (--sbPtr->eIndex < 0) {
+ if (sbPtr->wrap) {
+ sbPtr->eIndex = sbPtr->nElements-1;
+ } else {
+ sbPtr->eIndex = 0;
+ }
+ }
+ }
+ Tcl_ListObjIndex(interp, sbPtr->listObj, sbPtr->eIndex, &objPtr);
+ code = EntryValueChanged(entryPtr, Tcl_GetString(objPtr));
+ } else if (!DOUBLES_EQ(sbPtr->fromValue, sbPtr->toValue)) {
+ double dvalue;
+
+ if (sscanf(entryPtr->string, "%lf", &dvalue) <= 0) {
+ /*
+ * If the string doesn't scan as a double value, just
+ * use the -from value
+ */
+
+ dvalue = sbPtr->fromValue;
+ } else if (up) {
+ dvalue += sbPtr->increment;
+ if (dvalue > sbPtr->toValue) {
+ if (sbPtr->wrap) {
+ dvalue = sbPtr->fromValue;
+ } else {
+ dvalue = sbPtr->toValue;
+ }
+ } else if (dvalue < sbPtr->fromValue) {
+ /*
+ * It's possible that when pressing up, we are still less
+ * than the fromValue, because the user may have
+ * manipulated the value by hand.
+ */
+
+ dvalue = sbPtr->fromValue;
+ }
+ } else {
+ dvalue -= sbPtr->increment;
+ if (dvalue < sbPtr->fromValue) {
+ if (sbPtr->wrap) {
+ dvalue = sbPtr->toValue;
+ } else {
+ dvalue = sbPtr->fromValue;
+ }
+ } else if (dvalue > sbPtr->toValue) {
+ /*
+ * It's possible that when pressing down, we are still
+ * greater than the toValue, because the user may have
+ * manipulated the value by hand.
+ */
+
+ dvalue = sbPtr->toValue;
+ }
+ }
+ sprintf(sbPtr->formatBuf, sbPtr->valueFormat, dvalue);
+ code = EntryValueChanged(entryPtr, sbPtr->formatBuf);
+ }
+ }
+ if (code != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ if (sbPtr->command != NULL) {
+ Tcl_DStringInit(&script);
+ ExpandPercents(entryPtr, sbPtr->command, type, "", 0,
+ VALIDATE_BUTTON, &script);
+ Tcl_DStringAppend(&script, "", 1);
+
+ code = Tcl_EvalEx(interp, Tcl_DStringValue(&script), -1,
+ TCL_EVAL_GLOBAL | TCL_EVAL_DIRECT);
+ Tcl_DStringFree(&script);
+
+ if (code != TCL_OK) {
+ Tcl_AddErrorInfo(interp,
+ "\n (in command executed by spinbox)");
+ Tcl_BackgroundException(interp, code);
+
+ /*
+ * Yes, it's an error, but a bg one, so we return OK
+ */
+
+ return TCL_OK;
+ }
+
+ Tcl_ResetResult(interp);
+ }
+
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ComputeFormat --
+ *
+ * This function is invoked to recompute the "format" fields of a
+ * spinbox's widget record, which determines how the value of the dial is
+ * converted to a string.
+ *
+ * Results:
+ * Tcl result code.
+ *
+ * Side effects:
+ * The format fields of the spinbox are modified.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+ComputeFormat(
+ Spinbox *sbPtr) /* Information about dial widget. */
+{
+ double maxValue, x;
+ int mostSigDigit, numDigits, leastSigDigit, afterDecimal;
+ int eDigits, fDigits;
+
+ /*
+ * Compute the displacement from the decimal of the most significant digit
+ * required for any number in the dial's range.
+ */
+
+ if (sbPtr->reqFormat) {
+ sbPtr->valueFormat = sbPtr->reqFormat;
+ return TCL_OK;
+ }
+
+ maxValue = fabs(sbPtr->fromValue);
+ x = fabs(sbPtr->toValue);
+ if (x > maxValue) {
+ maxValue = x;
+ }
+ if (maxValue == 0) {
+ maxValue = 1;
+ }
+ mostSigDigit = (int) floor(log10(maxValue));
+
+ if (fabs(sbPtr->increment) > MIN_DBL_VAL) {
+ /*
+ * A increment was specified, so use it.
+ */
+
+ leastSigDigit = (int) floor(log10(sbPtr->increment));
+ } else {
+ leastSigDigit = 0;
+ }
+ numDigits = mostSigDigit - leastSigDigit + 1;
+ if (numDigits < 1) {
+ numDigits = 1;
+ }
+
+ /*
+ * Compute the number of characters required using "e" format and "f"
+ * format, and then choose whichever one takes fewer characters.
+ */
+
+ eDigits = numDigits + 4;
+ if (numDigits > 1) {
+ eDigits++; /* Decimal point. */
+ }
+ afterDecimal = numDigits - mostSigDigit - 1;
+ if (afterDecimal < 0) {
+ afterDecimal = 0;
+ }
+ fDigits = (mostSigDigit >= 0) ? mostSigDigit + afterDecimal : afterDecimal;
+ if (afterDecimal > 0) {
+ fDigits++; /* Decimal point. */
+ }
+ if (mostSigDigit < 0) {
+ fDigits++; /* Zero to left of decimal point. */
+ }
+ if (fDigits <= eDigits) {
+ sprintf(sbPtr->digitFormat, "%%.%df", afterDecimal);
+ } else {
+ sprintf(sbPtr->digitFormat, "%%.%de", numDigits-1);
+ }
+ sbPtr->valueFormat = sbPtr->digitFormat;
+ return TCL_OK;
+}
+
+/*
+ * Local Variables:
+ * mode: c
+ * c-basic-offset: 4
+ * fill-column: 78
+ * End:
+ */
diff --git a/tk8.6/generic/tkEntry.h b/tk8.6/generic/tkEntry.h
new file mode 100644
index 0000000..52535c8
--- /dev/null
+++ b/tk8.6/generic/tkEntry.h
@@ -0,0 +1,298 @@
+/*
+ * tkEntry.h --
+ *
+ * This module defined the structures for the Entry & SpinBox widgets.
+ *
+ * See the file "license.terms" for information on usage and redistribution of
+ * this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ * Copyright (c) 2002 Apple Inc.
+ */
+
+#ifndef _TKENTRY
+#define _TKENTRY
+
+#ifndef _TKINT
+#include "tkInt.h"
+#endif
+
+enum EntryType {
+ TK_ENTRY, TK_SPINBOX
+};
+
+/*
+ * A data structure of the following type is kept for each Entry widget
+ * managed by this file:
+ */
+
+typedef struct {
+ Tk_Window tkwin; /* Window that embodies the entry. NULL means
+ * that the window has been destroyed but the
+ * data structures haven't yet been cleaned
+ * up.*/
+ Display *display; /* Display containing widget. Used, among
+ * other things, so that resources can be
+ * freed even after tkwin has gone away. */
+ Tcl_Interp *interp; /* Interpreter associated with entry. */
+ Tcl_Command widgetCmd; /* Token for entry's widget command. */
+ Tk_OptionTable optionTable; /* Table that defines configuration options
+ * available for this widget. */
+ enum EntryType type; /* Specialized type of Entry widget */
+
+ /*
+ * Fields that are set by widget commands other than "configure".
+ */
+
+ const char *string; /* Pointer to storage for string;
+ * NULL-terminated; malloc-ed. */
+ int insertPos; /* Character index before which next typed
+ * character will be inserted. */
+
+ /*
+ * Information about what's selected, if any.
+ */
+
+ int selectFirst; /* Character index of first selected character
+ * (-1 means nothing selected. */
+ int selectLast; /* Character index just after last selected
+ * character (-1 means nothing selected. */
+ int selectAnchor; /* Fixed end of selection (i.e. "select to"
+ * operation will use this as one end of the
+ * selection). */
+
+ /*
+ * Information for scanning:
+ */
+
+ int scanMarkX; /* X-position at which scan started (e.g.
+ * button was pressed here). */
+ int scanMarkIndex; /* Character index of character that was at
+ * left of window when scan started. */
+
+ /*
+ * Configuration settings that are updated by Tk_ConfigureWidget.
+ */
+
+ Tk_3DBorder normalBorder; /* Used for drawing border around whole
+ * window, plus used for background. */
+ Tk_3DBorder disabledBorder; /* Used for drawing border around whole window
+ * in disabled state, plus used for
+ * background. */
+ Tk_3DBorder readonlyBorder; /* Used for drawing border around whole window
+ * in readonly state, plus used for
+ * background. */
+ int borderWidth; /* Width of 3-D border around window. */
+ Tk_Cursor cursor; /* Current cursor for window, or None. */
+ int exportSelection; /* Non-zero means tie internal entry selection
+ * to X selection. */
+ Tk_Font tkfont; /* Information about text font, or NULL. */
+ XColor *fgColorPtr; /* Text color in normal mode. */
+ XColor *dfgColorPtr; /* Text color in disabled mode. */
+ XColor *highlightBgColorPtr;/* Color for drawing traversal highlight area
+ * when highlight is off. */
+ XColor *highlightColorPtr; /* Color for drawing traversal highlight. */
+ int highlightWidth; /* Width in pixels of highlight to draw around
+ * widget when it has the focus. <= 0 means
+ * don't draw a highlight. */
+ Tk_3DBorder insertBorder; /* Used to draw vertical bar for insertion
+ * cursor. */
+ int insertBorderWidth; /* Width of 3-D border around insert cursor. */
+ int insertOffTime; /* Number of milliseconds cursor should spend
+ * in "off" state for each blink. */
+ int insertOnTime; /* Number of milliseconds cursor should spend
+ * in "on" state for each blink. */
+ int insertWidth; /* Total width of insert cursor. */
+ Tk_Justify justify; /* Justification to use for text within
+ * window. */
+ int relief; /* 3-D effect: TK_RELIEF_RAISED, etc. */
+ Tk_3DBorder selBorder; /* Border and background for selected
+ * characters. */
+ int selBorderWidth; /* Width of border around selection. */
+ XColor *selFgColorPtr; /* Foreground color for selected text. */
+ int state; /* Normal or disabled. Entry is read-only when
+ * disabled. */
+ char *textVarName; /* Name of variable (malloc'ed) or NULL. If
+ * non-NULL, entry's string tracks the
+ * contents of this variable and vice
+ * versa. */
+ char *takeFocus; /* Value of -takefocus option; not used in the
+ * C code, but used by keyboard traversal
+ * scripts. Malloc'ed, but may be NULL. */
+ int prefWidth; /* Desired width of window, measured in
+ * average characters. */
+ char *scrollCmd; /* Command prefix for communicating with
+ * scrollbar(s). Malloc'ed. NULL means no
+ * command to issue. */
+ char *showChar; /* Value of -show option. If non-NULL, first
+ * character is used for displaying all
+ * characters in entry. Malloc'ed. This is
+ * only used by the Entry widget. */
+
+ /*
+ * Fields whose values are derived from the current values of the
+ * configuration settings above.
+ */
+
+ const char *displayString; /* String to use when displaying. This may be
+ * a pointer to string, or a pointer to
+ * malloced memory with the same character
+ * length as string but whose characters are
+ * all equal to showChar. */
+ int numBytes; /* Length of string in bytes. */
+ int numChars; /* Length of string in characters. Both string
+ * and displayString have the same character
+ * length, but may have different byte lengths
+ * due to being made from different UTF-8
+ * characters. */
+ int numDisplayBytes; /* Length of displayString in bytes. */
+ int inset; /* Number of pixels on the left and right
+ * sides that are taken up by XPAD,
+ * borderWidth (if any), and highlightWidth
+ * (if any). */
+ Tk_TextLayout textLayout; /* Cached text layout information. */
+ int layoutX, layoutY; /* Origin for layout. */
+ int leftX; /* X position at which character at leftIndex
+ * is drawn (varies depending on justify). */
+ int leftIndex; /* Character index of left-most character
+ * visible in window. */
+ Tcl_TimerToken insertBlinkHandler;
+ /* Timer handler used to blink cursor on and
+ * off. */
+ GC textGC; /* For drawing normal text. */
+ GC selTextGC; /* For drawing selected text. */
+ GC highlightGC; /* For drawing traversal highlight. */
+ int avgWidth; /* Width of average character. */
+ int xWidth; /* Extra width to reserve for widget. Used by
+ * spinboxes for button space. */
+ int flags; /* Miscellaneous flags; see below for
+ * definitions. */
+
+ int validate; /* Non-zero means try to validate */
+ char *validateCmd; /* Command prefix to use when invoking
+ * validate command. NULL means don't invoke
+ * commands. Malloc'ed. */
+ char *invalidCmd; /* Command called when a validation returns 0
+ * (successfully fails), defaults to {}. */
+} Entry;
+
+/*
+ * A data structure of the following type is kept for each spinbox widget
+ * managed by this file:
+ */
+
+typedef struct {
+ Entry entry; /* A pointer to the generic entry structure.
+ * This must be the first element of the
+ * Spinbox. */
+
+ /*
+ * Spinbox specific configuration settings.
+ */
+
+ Tk_3DBorder activeBorder; /* Used for drawing border around active
+ * buttons. */
+ Tk_3DBorder buttonBorder; /* Used for drawing border around buttons. */
+ Tk_Cursor bCursor; /* cursor for buttons, or None. */
+ int bdRelief; /* 3-D effect: TK_RELIEF_RAISED, etc. */
+ int buRelief; /* 3-D effect: TK_RELIEF_RAISED, etc. */
+ char *command; /* Command to invoke for spin buttons. NULL
+ * means no command to issue. */
+
+ /*
+ * Spinbox specific fields for use with configuration settings above.
+ */
+
+ int wrap; /* whether to wrap around when spinning */
+
+ int selElement; /* currently selected control */
+ int curElement; /* currently mouseover control */
+
+ int repeatDelay; /* repeat delay */
+ int repeatInterval; /* repeat interval */
+
+ double fromValue; /* Value corresponding to left/top of dial */
+ double toValue; /* Value corresponding to right/bottom of
+ * dial */
+ double increment; /* If > 0, all values are rounded to an even
+ * multiple of this value. */
+ char *formatBuf; /* string into which to format value.
+ * Malloc'ed. */
+ char *reqFormat; /* Sprintf conversion specifier used for the
+ * value that the users requests. Malloc'ed */
+ char *valueFormat; /* Sprintf conversion specifier used for the
+ * value. */
+ char digitFormat[10]; /* Sprintf conversion specifier computed from
+ * digits and other information; used for the
+ * value. */
+
+ char *valueStr; /* Values List. Malloc'ed. */
+ Tcl_Obj *listObj; /* Pointer to the list object being used */
+ int eIndex; /* Holds the current index into elements */
+ int nElements; /* Holds the current count of elements */
+} Spinbox;
+
+/*
+ * Assigned bits of "flags" fields of Entry structures, and what those bits
+ * mean:
+ *
+ * REDRAW_PENDING: Non-zero means a DoWhenIdle handler has
+ * already been queued to redisplay the entry.
+ * BORDER_NEEDED: Non-zero means 3-D border must be redrawn
+ * around window during redisplay. Normally only
+ * text portion needs to be redrawn.
+ * CURSOR_ON: Non-zero means insert cursor is displayed at
+ * present. 0 means it isn't displayed.
+ * GOT_FOCUS: Non-zero means this window has the input
+ * focus.
+ * UPDATE_SCROLLBAR: Non-zero means scrollbar should be updated
+ * during next redisplay operation.
+ * GOT_SELECTION: Non-zero means we've claimed the selection.
+ * ENTRY_DELETED: This entry has been effectively destroyed.
+ * VALIDATING: Non-zero means we are in a validateCmd
+ * VALIDATE_VAR: Non-zero means we are attempting to validate
+ * the entry's textvariable with validateCmd
+ * VALIDATE_ABORT: Non-zero if validatecommand signals an abort
+ * for current procedure and make no changes
+ * ENTRY_VAR_TRACED: Non-zero if a var trace is set.
+ */
+
+#define REDRAW_PENDING 1
+#define BORDER_NEEDED 2
+#define CURSOR_ON 4
+#define GOT_FOCUS 8
+#define UPDATE_SCROLLBAR 0x10
+#define GOT_SELECTION 0x20
+#define ENTRY_DELETED 0x40
+#define VALIDATING 0x80
+#define VALIDATE_VAR 0x100
+#define VALIDATE_ABORT 0x200
+#define ENTRY_VAR_TRACED 0x400
+
+/*
+ * The following enum is used to define a type for the -state option of the
+ * Entry widget. These values are used as indices into the string table below.
+ */
+
+enum state {
+ STATE_DISABLED, STATE_NORMAL, STATE_READONLY
+};
+
+/*
+ * This is the element index corresponding to the strings in selElementNames.
+ * If you modify them, you must modify the numbers here.
+ */
+
+enum selelement {
+ SEL_NONE, SEL_BUTTONDOWN, SEL_BUTTONUP, SEL_NULL, SEL_ENTRY
+};
+
+/*
+ * Declaration of functions used in the implementation of the native side of
+ * the Entry widget.
+ */
+
+MODULE_SCOPE int TkpDrawEntryBorderAndFocus(Entry *entryPtr,
+ Drawable d, int isSpinbox);
+MODULE_SCOPE int TkpDrawSpinboxButtons(Spinbox *sbPtr, Drawable d);
+
+#endif /* _TKENTRY */
diff --git a/tk8.6/generic/tkError.c b/tk8.6/generic/tkError.c
new file mode 100644
index 0000000..fc223e6
--- /dev/null
+++ b/tk8.6/generic/tkError.c
@@ -0,0 +1,291 @@
+/*
+ * tkError.c --
+ *
+ * This file provides a high-performance mechanism for selectively
+ * dealing with errors that occur in talking to the X server. This is
+ * useful, for example, when communicating with a window that may not
+ * exist.
+ *
+ * Copyright (c) 1990-1994 The Regents of the University of California.
+ * Copyright (c) 1994-1995 Sun Microsystems, Inc.
+ *
+ * See the file "license.terms" for information on usage and redistribution of
+ * this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ */
+
+#include "tkInt.h"
+
+/*
+ * The default X error handler gets saved here, so that it can be invoked if
+ * an error occurs that we can't handle.
+ */
+
+typedef int (*TkXErrorHandler)(Display *display, XErrorEvent *eventPtr);
+static TkXErrorHandler defaultHandler = NULL;
+
+/*
+ * Forward references to procedures declared later in this file:
+ */
+
+static int ErrorProc(Display *display, XErrorEvent *errEventPtr);
+
+/*
+ *--------------------------------------------------------------
+ *
+ * Tk_CreateErrorHandler --
+ *
+ * Arrange for all a given procedure to be invoked whenever certain
+ * errors occur.
+ *
+ * Results:
+ * The return value is a token identifying the handler; it must be passed
+ * to Tk_DeleteErrorHandler to delete the handler.
+ *
+ * Side effects:
+ * If an X error occurs that matches the error, request, and minor
+ * arguments, then errorProc will be invoked. ErrorProc should have the
+ * following structure:
+ *
+ * int
+ * errorProc(caddr_t clientData, XErrorEvent *errorEventPtr) {
+ * }
+ *
+ * The clientData argument will be the same as the clientData argument to
+ * this procedure, and errorEvent will describe the error. If errorProc
+ * returns 0, it means that it completely "handled" the error: no further
+ * processing should be done. If errorProc returns 1, it means that it
+ * didn't know how to deal with the error, so we should look for other
+ * error handlers, or invoke the default error handler if no other
+ * handler returns zero. Handlers are invoked in order of age: youngest
+ * handler first.
+ *
+ * Note: errorProc will only be called for errors associated with X
+ * requests made AFTER this call, but BEFORE the handler is deleted by
+ * calling Tk_DeleteErrorHandler.
+ *
+ *--------------------------------------------------------------
+ */
+
+Tk_ErrorHandler
+Tk_CreateErrorHandler(
+ Display *display, /* Display for which to handle errors. */
+ int error, /* Consider only errors with this error_code
+ * (-1 means consider all errors). */
+ int request, /* Consider only errors with this major
+ * request code (-1 means consider all major
+ * codes). */
+ int minorCode, /* Consider only errors with this minor
+ * request code (-1 means consider all minor
+ * codes). */
+ Tk_ErrorProc *errorProc, /* Procedure to invoke when a matching error
+ * occurs. NULL means just ignore matching
+ * errors. */
+ ClientData clientData) /* Arbitrary value to pass to errorProc. */
+{
+ register TkErrorHandler *errorPtr;
+ register TkDisplay *dispPtr;
+
+ /*
+ * Find the display. If Tk doesn't know about this display then it's an
+ * error: panic.
+ */
+
+ dispPtr = TkGetDisplay(display);
+ if (dispPtr == NULL) {
+ Tcl_Panic("Unknown display passed to Tk_CreateErrorHandler");
+ }
+
+ /*
+ * Make sure that X calls us whenever errors occur.
+ */
+
+ if (defaultHandler == NULL) {
+ defaultHandler = XSetErrorHandler(ErrorProc);
+ }
+
+ /*
+ * Create the handler record.
+ */
+
+ errorPtr = ckalloc(sizeof(TkErrorHandler));
+ errorPtr->dispPtr = dispPtr;
+ errorPtr->firstRequest = NextRequest(display);
+ errorPtr->lastRequest = (unsigned) -1;
+ errorPtr->error = error;
+ errorPtr->request = request;
+ errorPtr->minorCode = minorCode;
+ errorPtr->errorProc = errorProc;
+ errorPtr->clientData = clientData;
+ errorPtr->nextPtr = dispPtr->errorPtr;
+ dispPtr->errorPtr = errorPtr;
+
+ return (Tk_ErrorHandler) errorPtr;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * Tk_DeleteErrorHandler --
+ *
+ * Do not use an error handler anymore.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The handler denoted by the "handler" argument will not be invoked for
+ * any X errors associated with requests made after this call. However,
+ * if errors arrive later for requests made BEFORE this call, then the
+ * handler will still be invoked. Call XSync if you want to be sure that
+ * all outstanding errors have been received and processed.
+ *
+ *--------------------------------------------------------------
+ */
+
+void
+Tk_DeleteErrorHandler(
+ Tk_ErrorHandler handler) /* Token for handler to delete; was previous
+ * return value from Tk_CreateErrorHandler. */
+{
+ register TkErrorHandler *errorPtr = (TkErrorHandler *) handler;
+ register TkDisplay *dispPtr = errorPtr->dispPtr;
+
+ errorPtr->lastRequest = NextRequest(dispPtr->display) - 1;
+
+ /*
+ * Every once-in-a-while, cleanup handlers that are no longer active. We
+ * probably won't be able to free the handler that was just deleted (need
+ * to wait for any outstanding requests to be processed by server), but
+ * there may be previously-deleted handlers that are now ready for garbage
+ * collection. To reduce the cost of the cleanup, let a few dead handlers
+ * pile up, then clean them all at once. This adds a bit of overhead to
+ * errors that might occur while the dead handlers are hanging around, but
+ * reduces the overhead of scanning the list to clean up (particularly if
+ * there are many handlers that stay around forever).
+ */
+
+ dispPtr->deleteCount += 1;
+ if (dispPtr->deleteCount >= 10) {
+ register TkErrorHandler *prevPtr;
+ TkErrorHandler *nextPtr;
+ int lastSerial;
+
+ dispPtr->deleteCount = 0;
+ lastSerial = LastKnownRequestProcessed(dispPtr->display);
+ errorPtr = dispPtr->errorPtr;
+ for (prevPtr = NULL; errorPtr != NULL; errorPtr = nextPtr) {
+ nextPtr = errorPtr->nextPtr;
+ if ((errorPtr->lastRequest != (unsigned long) -1)
+ && (errorPtr->lastRequest <= (unsigned long) lastSerial)) {
+ if (prevPtr == NULL) {
+ dispPtr->errorPtr = nextPtr;
+ } else {
+ prevPtr->nextPtr = nextPtr;
+ }
+ ckfree(errorPtr);
+ continue;
+ }
+ prevPtr = errorPtr;
+ }
+ }
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * ErrorProc --
+ *
+ * This procedure is invoked by the X system when error events arrive.
+ *
+ * Results:
+ * If it returns, the return value is zero. However, it is possible that
+ * one of the error handlers may just exit.
+ *
+ * Side effects:
+ * This procedure does two things. First, it uses the serial # in the
+ * error event to eliminate handlers whose expiration serials are now in
+ * the past. Second, it invokes any handlers that want to deal with the
+ * error.
+ *
+ *--------------------------------------------------------------
+ */
+
+static int
+ErrorProc(
+ Display *display, /* Display for which error occurred. */
+ register XErrorEvent *errEventPtr)
+ /* Information about error. */
+{
+ register TkDisplay *dispPtr;
+ register TkErrorHandler *errorPtr;
+
+ /*
+ * See if we know anything about the display. If not, then invoke the
+ * default error handler.
+ */
+
+ dispPtr = TkGetDisplay(display);
+ if (dispPtr == NULL) {
+ goto couldntHandle;
+ }
+
+ /*
+ * Otherwise invoke any relevant handlers for the error, in order.
+ */
+
+ for (errorPtr = dispPtr->errorPtr; errorPtr != NULL;
+ errorPtr = errorPtr->nextPtr) {
+ if ((errorPtr->firstRequest > errEventPtr->serial)
+ || ((errorPtr->error != -1)
+ && (errorPtr->error != errEventPtr->error_code))
+ || ((errorPtr->request != -1)
+ && (errorPtr->request != errEventPtr->request_code))
+ || ((errorPtr->minorCode != -1)
+ && (errorPtr->minorCode != errEventPtr->minor_code))
+ || ((errorPtr->lastRequest != (unsigned long) -1)
+ && (errorPtr->lastRequest < errEventPtr->serial))) {
+ continue;
+ }
+ if (errorPtr->errorProc == NULL ||
+ errorPtr->errorProc(errorPtr->clientData, errEventPtr) == 0) {
+ return 0;
+ }
+ }
+
+ /*
+ * See if the error is a BadWindow error. If so, and it refers to a window
+ * that still exists in our window table, then ignore the error. Errors
+ * like this can occur if a window owned by us is deleted by someone
+ * externally, like a window manager. We'll ignore the errors at least
+ * long enough to clean up internally and remove the entry from the window
+ * table.
+ *
+ * NOTE: For embedding, we must also check whether the window was recently
+ * deleted. If so, it may be that Tk generated operations on windows that
+ * were deleted by the container. Now we are getting the errors
+ * (BadWindow) after Tk already deleted the window itself.
+ */
+
+ if (errEventPtr->error_code == BadWindow) {
+ Window w = (Window) errEventPtr->resourceid;
+
+ if (Tk_IdToWindow(display, w) != NULL) {
+ return 0;
+ }
+ }
+
+ /*
+ * We couldn't handle the error. Use the default handler.
+ */
+
+ couldntHandle:
+ return defaultHandler(display, errEventPtr);
+}
+
+/*
+ * Local Variables:
+ * mode: c
+ * c-basic-offset: 4
+ * fill-column: 78
+ * End:
+ */
diff --git a/tk8.6/generic/tkEvent.c b/tk8.6/generic/tkEvent.c
new file mode 100644
index 0000000..95aeda1
--- /dev/null
+++ b/tk8.6/generic/tkEvent.c
@@ -0,0 +1,2147 @@
+/*
+ * tkEvent.c --
+ *
+ * This file provides basic low-level facilities for managing X events in
+ * Tk.
+ *
+ * Copyright (c) 1990-1994 The Regents of the University of California.
+ * Copyright (c) 1994-1995 Sun Microsystems, Inc.
+ * Copyright (c) 1998-2000 Ajuba Solutions.
+ * Copyright (c) 2004 George Peter Staplin
+ *
+ * See the file "license.terms" for information on usage and redistribution of
+ * this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ */
+
+#include "tkInt.h"
+
+/*
+ * There's a potential problem if a handler is deleted while it's current
+ * (i.e. its function is executing), since Tk_HandleEvent will need to read
+ * the handler's "nextPtr" field when the function returns. To handle this
+ * problem, structures of the type below indicate the next handler to be
+ * processed for any (recursively nested) dispatches in progress. The
+ * nextHandler fields get updated if the handlers pointed to are deleted.
+ * Tk_HandleEvent also needs to know if the entire window gets deleted; the
+ * winPtr field is set to zero if that particular window gets deleted.
+ */
+
+typedef struct InProgress {
+ XEvent *eventPtr; /* Event currently being handled. */
+ TkWindow *winPtr; /* Window for event. Gets set to None if
+ * window is deleted while event is being
+ * handled. */
+ TkEventHandler *nextHandler;/* Next handler in search. */
+ struct InProgress *nextPtr; /* Next higher nested search. */
+} InProgress;
+
+/*
+ * For each call to Tk_CreateGenericHandler or Tk_CreateClientMessageHandler,
+ * an instance of the following structure will be created. All of the active
+ * handlers are linked into a list.
+ */
+
+typedef struct GenericHandler {
+ Tk_GenericProc *proc; /* Function to dispatch on all X events. */
+ ClientData clientData; /* Client data to pass to function. */
+ int deleteFlag; /* Flag to set when this handler is
+ * deleted. */
+ struct GenericHandler *nextPtr;
+ /* Next handler in list of all generic
+ * handlers, or NULL for end of list. */
+} GenericHandler;
+
+/*
+ * There's a potential problem if Tk_HandleEvent is entered recursively. A
+ * handler cannot be deleted physically until we have returned from calling
+ * it. Otherwise, we're looking at unallocated memory in advancing to its
+ * `next' entry. We deal with the problem by using the `delete flag' and
+ * deleting handlers only when it's known that there's no handler active.
+ */
+
+/*
+ * The following structure is used for queueing X-style events on the Tcl
+ * event queue.
+ */
+
+typedef struct TkWindowEvent {
+ Tcl_Event header; /* Standard information for all events. */
+ XEvent event; /* The X event. */
+} TkWindowEvent;
+
+/*
+ * Array of event masks corresponding to each X event:
+ */
+
+static const unsigned long realEventMasks[MappingNotify+1] = {
+ 0,
+ 0,
+ KeyPressMask, /* KeyPress */
+ KeyReleaseMask, /* KeyRelease */
+ ButtonPressMask, /* ButtonPress */
+ ButtonReleaseMask, /* ButtonRelease */
+ PointerMotionMask|PointerMotionHintMask|ButtonMotionMask
+ |Button1MotionMask|Button2MotionMask|Button3MotionMask
+ |Button4MotionMask|Button5MotionMask,
+ /* MotionNotify */
+ EnterWindowMask, /* EnterNotify */
+ LeaveWindowMask, /* LeaveNotify */
+ FocusChangeMask, /* FocusIn */
+ FocusChangeMask, /* FocusOut */
+ KeymapStateMask, /* KeymapNotify */
+ ExposureMask, /* Expose */
+ ExposureMask, /* GraphicsExpose */
+ ExposureMask, /* NoExpose */
+ VisibilityChangeMask, /* VisibilityNotify */
+ SubstructureNotifyMask, /* CreateNotify */
+ StructureNotifyMask, /* DestroyNotify */
+ StructureNotifyMask, /* UnmapNotify */
+ StructureNotifyMask, /* MapNotify */
+ SubstructureRedirectMask, /* MapRequest */
+ StructureNotifyMask, /* ReparentNotify */
+ StructureNotifyMask, /* ConfigureNotify */
+ SubstructureRedirectMask, /* ConfigureRequest */
+ StructureNotifyMask, /* GravityNotify */
+ ResizeRedirectMask, /* ResizeRequest */
+ StructureNotifyMask, /* CirculateNotify */
+ SubstructureRedirectMask, /* CirculateRequest */
+ PropertyChangeMask, /* PropertyNotify */
+ 0, /* SelectionClear */
+ 0, /* SelectionRequest */
+ 0, /* SelectionNotify */
+ ColormapChangeMask, /* ColormapNotify */
+ 0, /* ClientMessage */
+ 0 /* Mapping Notify */
+};
+
+static const unsigned long virtualEventMasks[TK_LASTEVENT-VirtualEvent] = {
+ VirtualEventMask, /* VirtualEvents */
+ ActivateMask, /* ActivateNotify */
+ ActivateMask, /* DeactivateNotify */
+ MouseWheelMask /* MouseWheelEvent */
+};
+
+/*
+ * For each exit handler created with a call to TkCreateExitHandler or
+ * TkCreateThreadExitHandler there is a structure of the following type:
+ */
+
+typedef struct ExitHandler {
+ Tcl_ExitProc *proc; /* Function to call when process exits. */
+ ClientData clientData; /* One word of information to pass to proc. */
+ struct ExitHandler *nextPtr;/* Next in list of all exit handlers for this
+ * application, or NULL for end of list. */
+} ExitHandler;
+
+/*
+ * The structure below is used to store Data for the Event module that must be
+ * kept thread-local. The "dataKey" is used to fetch the thread-specific
+ * storage for the current thread.
+ */
+
+typedef struct ThreadSpecificData {
+ int handlersActive; /* The following variable has a non-zero value
+ * when a handler is active. */
+ InProgress *pendingPtr; /* Topmost search in progress, or NULL if
+ * none. */
+
+ /*
+ * List of generic handler records.
+ */
+
+ GenericHandler *genericList;/* First handler in the list, or NULL. */
+ GenericHandler *lastGenericPtr;
+ /* Last handler in list. */
+
+ /*
+ * List of client message handler records.
+ */
+
+ GenericHandler *cmList; /* First handler in the list, or NULL. */
+ GenericHandler *lastCmPtr; /* Last handler in list. */
+
+ /*
+ * If someone has called Tk_RestrictEvents, the information below keeps
+ * track of it.
+ */
+
+ Tk_RestrictProc *restrictProc;
+ /* Function to call. NULL means no
+ * restrictProc is currently in effect. */
+ ClientData restrictArg; /* Argument to pass to restrictProc. */
+ ExitHandler *firstExitPtr; /* First in list of all exit handlers for this
+ * thread. */
+ int inExit; /* True when this thread is exiting. This is
+ * used as a hack to decide to close the
+ * standard channels. */
+} ThreadSpecificData;
+static Tcl_ThreadDataKey dataKey;
+
+/*
+ * There are both per-process and per-thread exit handlers. The first list is
+ * controlled by a mutex. The other is in thread local storage.
+ */
+
+static ExitHandler *firstExitPtr = NULL;
+ /* First in list of all exit handlers for
+ * application. */
+TCL_DECLARE_MUTEX(exitMutex)
+
+/*
+ * Prototypes for functions that are only referenced locally within this file.
+ */
+
+static void CleanUpTkEvent(XEvent *eventPtr);
+static void DelayedMotionProc(ClientData clientData);
+static int GetButtonMask(unsigned int Button);
+static unsigned long GetEventMaskFromXEvent(XEvent *eventPtr);
+static TkWindow * GetTkWindowFromXEvent(XEvent *eventPtr);
+static void InvokeClientMessageHandlers(ThreadSpecificData *tsdPtr,
+ Tk_Window tkwin, XEvent *eventPtr);
+static int InvokeFocusHandlers(TkWindow **winPtrPtr,
+ unsigned long mask, XEvent *eventPtr);
+static int InvokeGenericHandlers(ThreadSpecificData *tsdPtr,
+ XEvent *eventPtr);
+static int InvokeMouseHandlers(TkWindow *winPtr,
+ unsigned long mask, XEvent *eventPtr);
+static Window ParentXId(Display *display, Window w);
+static int RefreshKeyboardMappingIfNeeded(XEvent *eventPtr);
+static int TkXErrorHandler(ClientData clientData,
+ XErrorEvent *errEventPtr);
+static void UpdateButtonEventState(XEvent *eventPtr);
+static int WindowEventProc(Tcl_Event *evPtr, int flags);
+#ifdef TK_USE_INPUT_METHODS
+static void CreateXIC(TkWindow *winPtr);
+#endif /* TK_USE_INPUT_METHODS */
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * InvokeFocusHandlers --
+ *
+ * Call focus-related code to look at FocusIn, FocusOut, Enter, and Leave
+ * events; depending on its return value, ignore the event.
+ *
+ * Results:
+ * 0 further processing can be done on the event.
+ * 1 we are done with the event passed.
+ *
+ * Side effects:
+ * The *winPtrPtr in the caller may be changed to the TkWindow for the
+ * window with focus.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+InvokeFocusHandlers(
+ TkWindow **winPtrPtr,
+ unsigned long mask,
+ XEvent *eventPtr)
+{
+ if ((mask & (FocusChangeMask|EnterWindowMask|LeaveWindowMask))
+ && (TkFocusFilterEvent(*winPtrPtr, eventPtr) == 0)) {
+ return 1;
+ }
+
+ /*
+ * Only key-related events are directed according to the focus.
+ */
+
+ if (mask & (KeyPressMask|KeyReleaseMask)) {
+ (*winPtrPtr)->dispPtr->lastEventTime = eventPtr->xkey.time;
+ *winPtrPtr = TkFocusKeyEvent(*winPtrPtr, eventPtr);
+ if (*winPtrPtr == NULL) {
+ return 1;
+ }
+ }
+
+ return 0;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * InvokeMouseHandlers --
+ *
+ * Call a grab-related function to do special processing on pointer
+ * events.
+ *
+ * Results:
+ * 0 further processing can be done on the event.
+ * 1 we are done with the event passed.
+ *
+ * Side effects:
+ * New events may be queued from TkPointerEvent and grabs may be added
+ * and/or removed. The eventPtr may be changed by TkPointerEvent in some
+ * cases.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+InvokeMouseHandlers(
+ TkWindow *winPtr,
+ unsigned long mask,
+ XEvent *eventPtr)
+{
+ if (mask & (ButtonPressMask|ButtonReleaseMask|PointerMotionMask
+ |EnterWindowMask|LeaveWindowMask)) {
+
+ if (mask & (ButtonPressMask|ButtonReleaseMask)) {
+ winPtr->dispPtr->lastEventTime = eventPtr->xbutton.time;
+ } else if (mask & PointerMotionMask) {
+ winPtr->dispPtr->lastEventTime = eventPtr->xmotion.time;
+ } else {
+ winPtr->dispPtr->lastEventTime = eventPtr->xcrossing.time;
+ }
+
+ if (TkPointerEvent(eventPtr, winPtr) == 0) {
+ /*
+ * The event should be ignored to make grab work correctly (as the
+ * comment for TkPointerEvent states).
+ */
+
+ return 1;
+ }
+ }
+
+ return 0;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * CreateXIC --
+ *
+ * Create the X input context for our winPtr.
+ * XIM is only ever enabled on Unix.
+ *
+ *----------------------------------------------------------------------
+ */
+
+#ifdef TK_USE_INPUT_METHODS
+static void
+CreateXIC(
+ TkWindow *winPtr)
+{
+ TkDisplay *dispPtr = winPtr->dispPtr;
+ long im_event_mask = 0L;
+ const char *preedit_attname = NULL;
+ XVaNestedList preedit_attlist = NULL;
+
+ if (dispPtr->inputStyle & XIMPreeditPosition) {
+ XPoint spot = {0, 0};
+
+ preedit_attname = XNPreeditAttributes;
+ preedit_attlist = XVaCreateNestedList(0,
+ XNSpotLocation, &spot,
+ XNFontSet, dispPtr->inputXfs,
+ NULL);
+ }
+
+ winPtr->inputContext = XCreateIC(dispPtr->inputMethod,
+ XNInputStyle, dispPtr->inputStyle,
+ XNClientWindow, winPtr->window,
+ XNFocusWindow, winPtr->window,
+ preedit_attname, preedit_attlist,
+ NULL);
+
+ if (preedit_attlist) {
+ XFree(preedit_attlist);
+ }
+
+
+ if (winPtr->inputContext == NULL) {
+ /* XCreateIC failed. */
+ return;
+ }
+
+ /*
+ * Adjust the window's event mask if the IM requires it.
+ */
+ XGetICValues(winPtr->inputContext, XNFilterEvents, &im_event_mask, NULL);
+ if ((winPtr->atts.event_mask & im_event_mask) != im_event_mask) {
+ winPtr->atts.event_mask |= im_event_mask;
+ XSelectInput(winPtr->display, winPtr->window, winPtr->atts.event_mask);
+ }
+}
+#endif
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * GetTkWindowFromXEvent --
+ *
+ * Attempt to find which TkWindow is associated with an event. If it
+ * fails we attempt to get the TkWindow from the parent for a property
+ * notification.
+ *
+ * Results:
+ * The TkWindow associated with the event or NULL.
+ *
+ * Side effects:
+ * TkSelPropProc may influence selection on windows not known to Tk.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static TkWindow *
+GetTkWindowFromXEvent(
+ XEvent *eventPtr)
+{
+ TkWindow *winPtr;
+ Window parentXId, handlerWindow = eventPtr->xany.window;
+
+ if ((eventPtr->xany.type == StructureNotifyMask)
+ && (eventPtr->xmap.event != eventPtr->xmap.window)) {
+ handlerWindow = eventPtr->xmap.event;
+ }
+
+ winPtr = (TkWindow *) Tk_IdToWindow(eventPtr->xany.display, handlerWindow);
+
+ if (winPtr == NULL) {
+ /*
+ * There isn't a TkWindow structure for this window. However, if the
+ * event is a PropertyNotify event then call the selection manager (it
+ * deals beneath-the-table with certain properties). Also, if the
+ * window's parent is a Tk window that has the TK_PROP_PROPCHANGE flag
+ * set, then we must propagate the PropertyNotify event up to the
+ * parent.
+ */
+
+ if (eventPtr->type != PropertyNotify) {
+ return NULL;
+ }
+ TkSelPropProc(eventPtr);
+ parentXId = ParentXId(eventPtr->xany.display, handlerWindow);
+ if (parentXId == None) {
+ return NULL;
+ }
+ winPtr = (TkWindow *) Tk_IdToWindow(eventPtr->xany.display, parentXId);
+ if (winPtr == NULL) {
+ return NULL;
+ }
+ if (!(winPtr->flags & TK_PROP_PROPCHANGE)) {
+ return NULL;
+ }
+ }
+ return winPtr;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * GetEventMaskFromXEvent --
+ *
+ * The event type is looked up in our eventMasks tables, and may be
+ * changed to a different mask depending on the state of the event and
+ * window members.
+ *
+ * Results:
+ * The mask for the event.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static unsigned long
+GetEventMaskFromXEvent(
+ XEvent *eventPtr)
+{
+ unsigned long mask;
+
+ /*
+ * Get the event mask from the correct table. Note that there are two
+ * tables here because that means we no longer need this code to rely on
+ * the exact value of VirtualEvent, which has caused us problems in the
+ * past when X11 changed the value of LASTEvent. [Bug ???]
+ */
+
+ if (eventPtr->xany.type <= MappingNotify) {
+ mask = realEventMasks[eventPtr->xany.type];
+ } else if (eventPtr->xany.type >= VirtualEvent
+ && eventPtr->xany.type<TK_LASTEVENT) {
+ mask = virtualEventMasks[eventPtr->xany.type - VirtualEvent];
+ } else {
+ mask = 0;
+ }
+
+ /*
+ * Events selected by StructureNotify require special handling. They look
+ * the same as those selected by SubstructureNotify. The only difference
+ * is whether the "event" and "window" fields are the same. Compare the
+ * two fields and convert StructureNotify to SubstructureNotify if
+ * necessary.
+ */
+
+ if (mask == StructureNotifyMask) {
+ if (eventPtr->xmap.event != eventPtr->xmap.window) {
+ mask = SubstructureNotifyMask;
+ }
+ }
+ return mask;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * RefreshKeyboardMappingIfNeeded --
+ *
+ * If the event is a MappingNotify event, find its display and refresh
+ * the keyboard mapping information for the display.
+ *
+ * Results:
+ * 0 if the event was not a MappingNotify event
+ * 1 if the event was a MappingNotify event
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+RefreshKeyboardMappingIfNeeded(
+ XEvent *eventPtr)
+{
+ TkDisplay *dispPtr;
+
+ if (eventPtr->type == MappingNotify) {
+ dispPtr = TkGetDisplay(eventPtr->xmapping.display);
+ if (dispPtr != NULL) {
+ XRefreshKeyboardMapping(&eventPtr->xmapping);
+ dispPtr->bindInfoStale = 1;
+ }
+ return 1;
+ }
+ return 0;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * GetButtonMask --
+ *
+ * Return the proper Button${n}Mask for the button.
+ *
+ * Results:
+ * A button mask.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+GetButtonMask(
+ unsigned int button)
+{
+ switch (button) {
+ case 1:
+ return Button1Mask;
+ case 2:
+ return Button2Mask;
+ case 3:
+ return Button3Mask;
+ case 4:
+ return Button4Mask;
+ case 5:
+ return Button5Mask;
+ }
+ return 0;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * UpdateButtonEventState --
+ *
+ * Update the button event state in our TkDisplay using the XEvent
+ * passed. We also may modify the the XEvent passed to fit some aspects
+ * of our TkDisplay.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The TkDisplay's private button state may be modified. The eventPtr's
+ * state may be updated to reflect masks stored in our TkDisplay that the
+ * event doesn't contain. The eventPtr may also be modified to not
+ * contain a button state for the window in which it was not pressed in.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+UpdateButtonEventState(
+ XEvent *eventPtr)
+{
+ TkDisplay *dispPtr;
+ int allButtonsMask = Button1Mask | Button2Mask | Button3Mask
+ | Button4Mask | Button5Mask;
+
+ switch (eventPtr->type) {
+ case ButtonPress:
+ dispPtr = TkGetDisplay(eventPtr->xbutton.display);
+ dispPtr->mouseButtonWindow = eventPtr->xbutton.window;
+ eventPtr->xbutton.state |= dispPtr->mouseButtonState;
+
+ dispPtr->mouseButtonState |= GetButtonMask(eventPtr->xbutton.button);
+ break;
+
+ case ButtonRelease:
+ dispPtr = TkGetDisplay(eventPtr->xbutton.display);
+ dispPtr->mouseButtonWindow = None;
+ dispPtr->mouseButtonState &= ~GetButtonMask(eventPtr->xbutton.button);
+ eventPtr->xbutton.state |= dispPtr->mouseButtonState;
+ break;
+
+ case MotionNotify:
+ dispPtr = TkGetDisplay(eventPtr->xmotion.display);
+ if (dispPtr->mouseButtonState & allButtonsMask) {
+ if (eventPtr->xbutton.window != dispPtr->mouseButtonWindow) {
+ /*
+ * This motion event should not be interpreted as a button
+ * press + motion event since this is not the same window the
+ * button was pressed down in.
+ */
+
+ dispPtr->mouseButtonState &= ~allButtonsMask;
+ dispPtr->mouseButtonWindow = None;
+ } else {
+ eventPtr->xmotion.state |= dispPtr->mouseButtonState;
+ }
+ }
+ break;
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * InvokeClientMessageHandlers --
+ *
+ * Iterate the list of handlers and invoke the function pointer for each.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Handlers may be deleted and events may be sent to handlers.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+InvokeClientMessageHandlers(
+ ThreadSpecificData *tsdPtr,
+ Tk_Window tkwin,
+ XEvent *eventPtr)
+{
+ GenericHandler *prevPtr, *tmpPtr, *curPtr = tsdPtr->cmList;
+
+ for (prevPtr = NULL; curPtr != NULL; ) {
+ if (curPtr->deleteFlag) {
+ if (!tsdPtr->handlersActive) {
+ /*
+ * This handler needs to be deleted and there are no calls
+ * pending through any handlers, so now is a safe time to
+ * delete it.
+ */
+
+ tmpPtr = curPtr->nextPtr;
+ if (prevPtr == NULL) {
+ tsdPtr->cmList = tmpPtr;
+ } else {
+ prevPtr->nextPtr = tmpPtr;
+ }
+ if (tmpPtr == NULL) {
+ tsdPtr->lastCmPtr = prevPtr;
+ }
+ ckfree(curPtr);
+ curPtr = tmpPtr;
+ continue;
+ }
+ } else {
+ int done;
+
+ tsdPtr->handlersActive++;
+ done = (*(Tk_ClientMessageProc *)curPtr->proc)(tkwin, eventPtr);
+ tsdPtr->handlersActive--;
+ if (done) {
+ break;
+ }
+ }
+ prevPtr = curPtr;
+ curPtr = curPtr->nextPtr;
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * InvokeGenericHandlers --
+ *
+ * Iterate the list of handlers and invoke the function pointer for each.
+ * If the handler invoked returns a non-zero value then we are done.
+ *
+ * Results:
+ * 0 when the event wasn't handled by a handler. Non-zero when it was
+ * processed and handled by a handler.
+ *
+ * Side effects:
+ * Handlers may be deleted and events may be sent to handlers.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+InvokeGenericHandlers(
+ ThreadSpecificData *tsdPtr,
+ XEvent *eventPtr)
+{
+ GenericHandler *prevPtr, *tmpPtr, *curPtr = tsdPtr->genericList;
+
+ for (prevPtr = NULL; curPtr != NULL; ) {
+ if (curPtr->deleteFlag) {
+ if (!tsdPtr->handlersActive) {
+ /*
+ * This handler needs to be deleted and there are no calls
+ * pending through the handler, so now is a safe time to
+ * delete it.
+ */
+
+ tmpPtr = curPtr->nextPtr;
+ if (prevPtr == NULL) {
+ tsdPtr->genericList = tmpPtr;
+ } else {
+ prevPtr->nextPtr = tmpPtr;
+ }
+ if (tmpPtr == NULL) {
+ tsdPtr->lastGenericPtr = prevPtr;
+ }
+ ckfree(curPtr);
+ curPtr = tmpPtr;
+ continue;
+ }
+ } else {
+ int done;
+
+ tsdPtr->handlersActive++;
+ done = curPtr->proc(curPtr->clientData, eventPtr);
+ tsdPtr->handlersActive--;
+ if (done) {
+ return done;
+ }
+ }
+ prevPtr = curPtr;
+ curPtr = curPtr->nextPtr;
+ }
+ return 0;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_CreateEventHandler --
+ *
+ * Arrange for a given function to be invoked whenever events from a
+ * given class occur in a given window.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * From now on, whenever an event of the type given by mask occurs for
+ * token and is processed by Tk_HandleEvent, proc will be called. See the
+ * manual entry for details of the calling sequence and return value for
+ * proc.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tk_CreateEventHandler(
+ Tk_Window token, /* Token for window in which to create
+ * handler. */
+ unsigned long mask, /* Events for which proc should be called. */
+ Tk_EventProc *proc, /* Function to call for each selected event */
+ ClientData clientData) /* Arbitrary data to pass to proc. */
+{
+ register TkEventHandler *handlerPtr;
+ register TkWindow *winPtr = (TkWindow *) token;
+
+ /*
+ * Skim through the list of existing handlers to (a) compute the overall
+ * event mask for the window (so we can pass this new value to the X
+ * system) and (b) see if there's already a handler declared with the same
+ * callback and clientData (if so, just change the mask). If no existing
+ * handler matches, then create a new handler.
+ */
+
+ if (winPtr->handlerList == NULL) {
+ /*
+ * No event handlers defined at all, so must create.
+ */
+
+ handlerPtr = ckalloc(sizeof(TkEventHandler));
+ winPtr->handlerList = handlerPtr;
+ } else {
+ int found = 0;
+
+ for (handlerPtr = winPtr->handlerList; ;
+ handlerPtr = handlerPtr->nextPtr) {
+ if ((handlerPtr->proc == proc)
+ && (handlerPtr->clientData == clientData)) {
+ handlerPtr->mask = mask;
+ found = 1;
+ }
+ if (handlerPtr->nextPtr == NULL) {
+ break;
+ }
+ }
+
+ /*
+ * If we found anything, we're done because we do not need to use
+ * XSelectInput; Tk always selects on all events anyway in order to
+ * support binding on classes, 'all' and other bind-tags.
+ */
+
+ if (found) {
+ return;
+ }
+
+ /*
+ * No event handler matched, so create a new one.
+ */
+
+ handlerPtr->nextPtr = ckalloc(sizeof(TkEventHandler));
+ handlerPtr = handlerPtr->nextPtr;
+ }
+
+ /*
+ * Initialize the new event handler.
+ */
+
+ handlerPtr->mask = mask;
+ handlerPtr->proc = proc;
+ handlerPtr->clientData = clientData;
+ handlerPtr->nextPtr = NULL;
+
+ /*
+ * No need to call XSelectInput: Tk always selects on all events for all
+ * windows (needed to support bindings on classes and "all").
+ */
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_DeleteEventHandler --
+ *
+ * Delete a previously-created handler.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * If there existed a handler as described by the parameters, the handler
+ * is deleted so that proc will not be invoked again.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tk_DeleteEventHandler(
+ Tk_Window token, /* Same as corresponding arguments passed */
+ unsigned long mask, /* previously to Tk_CreateEventHandler. */
+ Tk_EventProc *proc,
+ ClientData clientData)
+{
+ register TkEventHandler *handlerPtr;
+ register InProgress *ipPtr;
+ TkEventHandler *prevPtr;
+ register TkWindow *winPtr = (TkWindow *) token;
+ ThreadSpecificData *tsdPtr =
+ Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
+
+ /*
+ * Find the event handler to be deleted, or return immediately if it
+ * doesn't exist.
+ */
+
+ for (handlerPtr = winPtr->handlerList, prevPtr = NULL; ;
+ prevPtr = handlerPtr, handlerPtr = handlerPtr->nextPtr) {
+ if (handlerPtr == NULL) {
+ return;
+ }
+ if ((handlerPtr->mask == mask) && (handlerPtr->proc == proc)
+ && (handlerPtr->clientData == clientData)) {
+ break;
+ }
+ }
+
+ /*
+ * If Tk_HandleEvent is about to process this handler, tell it to process
+ * the next one instead.
+ */
+
+ for (ipPtr = tsdPtr->pendingPtr; ipPtr != NULL; ipPtr = ipPtr->nextPtr) {
+ if (ipPtr->nextHandler == handlerPtr) {
+ ipPtr->nextHandler = handlerPtr->nextPtr;
+ }
+ }
+
+ /*
+ * Free resources associated with the handler.
+ */
+
+ if (prevPtr == NULL) {
+ winPtr->handlerList = handlerPtr->nextPtr;
+ } else {
+ prevPtr->nextPtr = handlerPtr->nextPtr;
+ }
+ ckfree(handlerPtr);
+
+ /*
+ * No need to call XSelectInput: Tk always selects on all events for all
+ * windows (needed to support bindings on classes and "all").
+ */
+}
+
+/*----------------------------------------------------------------------
+ *
+ * Tk_CreateGenericHandler --
+ *
+ * Register a function to be called on each X event, regardless of
+ * display or window. Generic handlers are useful for capturing events
+ * that aren't associated with windows, or events for windows not managed
+ * by Tk.
+ *
+ * Results:
+ * None.
+ *
+ * Side Effects:
+ * From now on, whenever an X event is given to Tk_HandleEvent, invoke
+ * proc, giving it clientData and the event as arguments.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tk_CreateGenericHandler(
+ Tk_GenericProc *proc, /* Function to call on every event. */
+ ClientData clientData) /* One-word value to pass to proc. */
+{
+ GenericHandler *handlerPtr;
+ ThreadSpecificData *tsdPtr =
+ Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
+
+ handlerPtr = ckalloc(sizeof(GenericHandler));
+
+ handlerPtr->proc = proc;
+ handlerPtr->clientData = clientData;
+ handlerPtr->deleteFlag = 0;
+ handlerPtr->nextPtr = NULL;
+ if (tsdPtr->genericList == NULL) {
+ tsdPtr->genericList = handlerPtr;
+ } else {
+ tsdPtr->lastGenericPtr->nextPtr = handlerPtr;
+ }
+ tsdPtr->lastGenericPtr = handlerPtr;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_DeleteGenericHandler --
+ *
+ * Delete a previously-created generic handler.
+ *
+ * Results:
+ * None.
+ *
+ * Side Effects:
+ * If there existed a handler as described by the parameters, that
+ * handler is logically deleted so that proc will not be invoked again.
+ * The physical deletion happens in the event loop in Tk_HandleEvent.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tk_DeleteGenericHandler(
+ Tk_GenericProc *proc,
+ ClientData clientData)
+{
+ GenericHandler * handler;
+ ThreadSpecificData *tsdPtr =
+ Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
+
+ for (handler=tsdPtr->genericList ; handler ; handler=handler->nextPtr) {
+ if ((handler->proc == proc) && (handler->clientData == clientData)) {
+ handler->deleteFlag = 1;
+ }
+ }
+}
+
+/*----------------------------------------------------------------------
+ *
+ * Tk_CreateClientMessageHandler --
+ *
+ * Register a function to be called on each ClientMessage event.
+ * ClientMessage handlers are useful for Drag&Drop extensions.
+ *
+ * Results:
+ * None.
+ *
+ * Side Effects:
+ * From now on, whenever a ClientMessage event is received that isn't a
+ * WM_PROTOCOL event or SelectionEvent, invoke proc, giving it tkwin and
+ * the event as arguments.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tk_CreateClientMessageHandler(
+ Tk_ClientMessageProc *proc) /* Function to call on event. */
+{
+ GenericHandler *handlerPtr;
+ ThreadSpecificData *tsdPtr =
+ Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
+
+ /*
+ * We use a GenericHandler struct, because it's basically the same, except
+ * with an extra clientData field we'll never use.
+ */
+
+ handlerPtr = ckalloc(sizeof(GenericHandler));
+
+ handlerPtr->proc = (Tk_GenericProc *) proc;
+ handlerPtr->clientData = NULL; /* never used */
+ handlerPtr->deleteFlag = 0;
+ handlerPtr->nextPtr = NULL;
+ if (tsdPtr->cmList == NULL) {
+ tsdPtr->cmList = handlerPtr;
+ } else {
+ tsdPtr->lastCmPtr->nextPtr = handlerPtr;
+ }
+ tsdPtr->lastCmPtr = handlerPtr;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_DeleteClientMessageHandler --
+ *
+ * Delete a previously-created ClientMessage handler.
+ *
+ * Results:
+ * None.
+ *
+ * Side Effects:
+ * If there existed a handler as described by the parameters, that
+ * handler is logically deleted so that proc will not be invoked again.
+ * The physical deletion happens in the event loop in
+ * TkClientMessageEventProc.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tk_DeleteClientMessageHandler(
+ Tk_ClientMessageProc *proc)
+{
+ GenericHandler * handler;
+ ThreadSpecificData *tsdPtr =
+ Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
+
+ for (handler=tsdPtr->cmList ; handler!=NULL ; handler=handler->nextPtr) {
+ if (handler->proc == (Tk_GenericProc *) proc) {
+ handler->deleteFlag = 1;
+ }
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkEventInit --
+ *
+ * This functions initializes all the event module structures used by the
+ * current thread. It must be called before any other function in this
+ * file is called.
+ *
+ * Results:
+ * None.
+ *
+ * Side Effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TkEventInit(void)
+{
+ ThreadSpecificData *tsdPtr =
+ Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
+
+ tsdPtr->handlersActive = 0;
+ tsdPtr->pendingPtr = NULL;
+ tsdPtr->genericList = NULL;
+ tsdPtr->lastGenericPtr = NULL;
+ tsdPtr->cmList = NULL;
+ tsdPtr->lastCmPtr = NULL;
+ tsdPtr->restrictProc = NULL;
+ tsdPtr->restrictArg = NULL;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkXErrorHandler --
+ *
+ * TkXErrorHandler is an error handler, to be installed via
+ * Tk_CreateErrorHandler, that will set a flag if an X error occurred.
+ *
+ * Results:
+ * Always returns 0, indicating that the X error was handled.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+TkXErrorHandler(
+ ClientData clientData, /* Pointer to flag we set. */
+ XErrorEvent *errEventPtr) /* X error info. */
+{
+ int *error = clientData;
+
+ *error = 1;
+ return 0;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ParentXId --
+ *
+ * Returns the parent of the given window, or "None" if the window
+ * doesn't exist.
+ *
+ * Results:
+ * Returns an X window ID.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static Window
+ParentXId(
+ Display *display,
+ Window w)
+{
+ Tk_ErrorHandler handler;
+ int gotXError;
+ Status status;
+ Window parent;
+ Window root;
+ Window *childList;
+ unsigned int nChildren;
+
+ /*
+ * Handle errors ourselves.
+ */
+
+ gotXError = 0;
+ handler = Tk_CreateErrorHandler(display, -1, -1, -1,
+ TkXErrorHandler, &gotXError);
+
+ /*
+ * Get the parent window.
+ */
+
+ status = XQueryTree(display, w, &root, &parent, &childList, &nChildren);
+
+ /*
+ * Do some cleanup; gotta return "None" if we got an error.
+ */
+
+ Tk_DeleteErrorHandler(handler);
+ XSync(display, False);
+ if (status != 0 && childList != NULL) {
+ XFree(childList);
+ }
+ if (status == 0) {
+ parent = None;
+ }
+
+ return parent;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_HandleEvent --
+ *
+ * Given an event, invoke all the handlers that have been registered for
+ * the event.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Depends on the handlers.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tk_HandleEvent(
+ XEvent *eventPtr) /* Event to dispatch. */
+{
+ register TkEventHandler *handlerPtr;
+ TkWindow *winPtr;
+ unsigned long mask;
+ InProgress ip;
+ Tcl_Interp *interp = NULL;
+ ThreadSpecificData *tsdPtr =
+ Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
+
+ UpdateButtonEventState(eventPtr);
+
+ /*
+ * If the generic handler processed this event we are done and can return.
+ */
+
+ if (InvokeGenericHandlers(tsdPtr, eventPtr)) {
+ goto releaseEventResources;
+ }
+
+ if (RefreshKeyboardMappingIfNeeded(eventPtr)) {
+ /*
+ * We are done with a MappingNotify event.
+ */
+
+ goto releaseEventResources;
+ }
+
+ mask = GetEventMaskFromXEvent(eventPtr);
+ winPtr = GetTkWindowFromXEvent(eventPtr);
+
+ if (winPtr == NULL) {
+ goto releaseEventResources;
+ }
+
+ /*
+ * Once a window has started getting deleted, don't process any more
+ * events for it except for the DestroyNotify event. This check is needed
+ * because a DestroyNotify handler could re-invoke the event loop, causing
+ * other pending events to be handled for the window (the window doesn't
+ * get totally expunged from our tables until after the DestroyNotify
+ * event has been completely handled).
+ */
+
+ if ((winPtr->flags & TK_ALREADY_DEAD)
+ && (eventPtr->type != DestroyNotify)) {
+ goto releaseEventResources;
+ }
+
+ if (winPtr->mainPtr != NULL) {
+ int result;
+
+ interp = winPtr->mainPtr->interp;
+
+ /*
+ * Protect interpreter for this window from possible deletion while we
+ * are dealing with the event for this window. Thus, widget writers do
+ * not have to worry about protecting the interpreter in their own
+ * code.
+ */
+
+ Tcl_Preserve(interp);
+
+ result = ((InvokeFocusHandlers(&winPtr, mask, eventPtr))
+ || (InvokeMouseHandlers(winPtr, mask, eventPtr)));
+
+ if (result) {
+ goto releaseInterpreter;
+ }
+ }
+
+ /*
+ * Create the input context for the window if it hasn't already been done
+ * (XFilterEvent needs this context). When the event is a FocusIn event,
+ * set the input context focus to the receiving window. This code is only
+ * ever active for X11.
+ */
+
+#ifdef TK_USE_INPUT_METHODS
+ if ((winPtr->dispPtr->flags & TK_DISPLAY_USE_IM)) {
+ if (!(winPtr->flags & (TK_CHECKED_IC|TK_ALREADY_DEAD))) {
+ winPtr->flags |= TK_CHECKED_IC;
+ if (winPtr->dispPtr->inputMethod != NULL) {
+ CreateXIC(winPtr);
+ }
+ }
+ if (eventPtr->type == FocusIn && winPtr->inputContext != NULL) {
+ XSetICFocus(winPtr->inputContext);
+ }
+ }
+#endif /*TK_USE_INPUT_METHODS*/
+
+ /*
+ * For events where it hasn't already been done, update the current time
+ * in the display.
+ */
+
+ if (eventPtr->type == PropertyNotify) {
+ winPtr->dispPtr->lastEventTime = eventPtr->xproperty.time;
+ }
+
+ /*
+ * There's a potential interaction here with Tk_DeleteEventHandler. Read
+ * the documentation for pendingPtr.
+ */
+
+ ip.eventPtr = eventPtr;
+ ip.winPtr = winPtr;
+ ip.nextHandler = NULL;
+ ip.nextPtr = tsdPtr->pendingPtr;
+ tsdPtr->pendingPtr = &ip;
+ if (mask == 0) {
+ if ((eventPtr->type == SelectionClear)
+ || (eventPtr->type == SelectionRequest)
+ || (eventPtr->type == SelectionNotify)) {
+ TkSelEventProc((Tk_Window) winPtr, eventPtr);
+ } else if (eventPtr->type == ClientMessage) {
+ if (eventPtr->xclient.message_type ==
+ Tk_InternAtom((Tk_Window) winPtr, "WM_PROTOCOLS")) {
+ TkWmProtocolEventProc(winPtr, eventPtr);
+ } else {
+ InvokeClientMessageHandlers(tsdPtr, (Tk_Window) winPtr,
+ eventPtr);
+ }
+ }
+ } else {
+ for (handlerPtr = winPtr->handlerList; handlerPtr != NULL; ) {
+ if (handlerPtr->mask & mask) {
+ ip.nextHandler = handlerPtr->nextPtr;
+ handlerPtr->proc(handlerPtr->clientData, eventPtr);
+ handlerPtr = ip.nextHandler;
+ } else {
+ handlerPtr = handlerPtr->nextPtr;
+ }
+ }
+
+ /*
+ * Pass the event to the "bind" command mechanism. But, don't do this
+ * for SubstructureNotify events. The "bind" command doesn't support
+ * them anyway, and it's easier to filter out these events here than
+ * in the lower-level functions.
+ */
+
+ /*
+ * ...well, except when we use the tkwm patches, in which case we DO
+ * handle CreateNotify events, so we gotta pass 'em through.
+ */
+
+ if ((ip.winPtr != None)
+ && ((mask != SubstructureNotifyMask)
+ || (eventPtr->type == CreateNotify))) {
+ TkBindEventProc(winPtr, eventPtr);
+ }
+ }
+ tsdPtr->pendingPtr = ip.nextPtr;
+
+ /*
+ * Release the interpreter for this window so that it can be potentially
+ * deleted if requested.
+ */
+
+ releaseInterpreter:
+ if (interp != NULL) {
+ Tcl_Release(interp);
+ }
+
+ /*
+ * Release the user_data from the event (if it is a virtual event and the
+ * field was non-NULL in the first place.) Note that this is done using a
+ * Tcl_Obj interface, and we set the field back to NULL afterwards out of
+ * paranoia. Also clean up any cached %A substitutions from key events.
+ */
+
+ releaseEventResources:
+ CleanUpTkEvent(eventPtr);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkEventDeadWindow --
+ *
+ * This function is invoked when it is determined that a window is dead.
+ * It cleans up event-related information about the window.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Various things get cleaned up and recycled.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TkEventDeadWindow(
+ TkWindow *winPtr) /* Information about the window that is being
+ * deleted. */
+{
+ register TkEventHandler *handlerPtr;
+ register InProgress *ipPtr;
+ ThreadSpecificData *tsdPtr =
+ Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
+
+ /*
+ * While deleting all the handlers, be careful to check for Tk_HandleEvent
+ * being about to process one of the deleted handlers. If it is, tell it
+ * to quit (all of the handlers are being deleted).
+ */
+
+ while (winPtr->handlerList != NULL) {
+ handlerPtr = winPtr->handlerList;
+ winPtr->handlerList = handlerPtr->nextPtr;
+ for (ipPtr = tsdPtr->pendingPtr; ipPtr != NULL;
+ ipPtr = ipPtr->nextPtr) {
+ if (ipPtr->nextHandler == handlerPtr) {
+ ipPtr->nextHandler = NULL;
+ }
+ if (ipPtr->winPtr == winPtr) {
+ ipPtr->winPtr = None;
+ }
+ }
+ ckfree(handlerPtr);
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkCurrentTime --
+ *
+ * Try to deduce the current time. "Current time" means the time of the
+ * event that led to the current code being executed, which means the
+ * time in the most recently-nested invocation of Tk_HandleEvent.
+ *
+ * Results:
+ * The return value is the time from the current event, or CurrentTime if
+ * there is no current event or if the current event contains no time.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+Time
+TkCurrentTime(
+ TkDisplay *dispPtr) /* Display for which the time is desired. */
+{
+ register XEvent *eventPtr;
+ ThreadSpecificData *tsdPtr =
+ Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
+
+ if (tsdPtr->pendingPtr == NULL) {
+ return dispPtr->lastEventTime;
+ }
+ eventPtr = tsdPtr->pendingPtr->eventPtr;
+ switch (eventPtr->type) {
+ case ButtonPress:
+ case ButtonRelease:
+ return eventPtr->xbutton.time;
+ case KeyPress:
+ case KeyRelease:
+ return eventPtr->xkey.time;
+ case MotionNotify:
+ return eventPtr->xmotion.time;
+ case EnterNotify:
+ case LeaveNotify:
+ return eventPtr->xcrossing.time;
+ case PropertyNotify:
+ return eventPtr->xproperty.time;
+ }
+ return dispPtr->lastEventTime;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_RestrictEvents --
+ *
+ * This function is used to globally restrict the set of events that will
+ * be dispatched. The restriction is done by filtering all incoming X
+ * events through a function that determines whether they are to be
+ * processed immediately, deferred, or discarded.
+ *
+ * Results:
+ * The return value is the previous restriction function in effect, if
+ * there was one, or NULL if there wasn't.
+ *
+ * Side effects:
+ * From now on, proc will be called to determine whether to process,
+ * defer or discard each incoming X event.
+ *
+ *----------------------------------------------------------------------
+ */
+
+Tk_RestrictProc *
+Tk_RestrictEvents(
+ Tk_RestrictProc *proc, /* Function to call for each incoming event */
+ ClientData arg, /* Arbitrary argument to pass to proc. */
+ ClientData *prevArgPtr) /* Place to store information about previous
+ * argument. */
+{
+ Tk_RestrictProc *prev;
+ ThreadSpecificData *tsdPtr =
+ Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
+
+ prev = tsdPtr->restrictProc;
+ *prevArgPtr = tsdPtr->restrictArg;
+ tsdPtr->restrictProc = proc;
+ tsdPtr->restrictArg = arg;
+ return prev;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_CollapseMotionEvents --
+ *
+ * This function controls whether we collapse motion events in a
+ * particular display or not.
+ *
+ * Results:
+ * The return value is the previous collapse value in effect.
+ *
+ * Side effects:
+ * Filtering of motion events may be changed after calling this.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tk_CollapseMotionEvents(
+ Display *display, /* Display handling these events. */
+ int collapse) /* Boolean value that specifies whether motion
+ * events should be collapsed. */
+{
+ TkDisplay *dispPtr = (TkDisplay *) display;
+ int prev = (dispPtr->flags & TK_DISPLAY_COLLAPSE_MOTION_EVENTS);
+
+ if (collapse) {
+ dispPtr->flags |= TK_DISPLAY_COLLAPSE_MOTION_EVENTS;
+ } else {
+ dispPtr->flags &= ~TK_DISPLAY_COLLAPSE_MOTION_EVENTS;
+ }
+ return prev;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_QueueWindowEvent --
+ *
+ * Given an X-style window event, this function adds it to the Tcl event
+ * queue at the given position. This function also performs mouse motion
+ * event collapsing if possible.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Adds stuff to the event queue, which will eventually be processed.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tk_QueueWindowEvent(
+ XEvent *eventPtr, /* Event to add to queue. This function copies
+ * it before adding it to the queue. */
+ Tcl_QueuePosition position) /* Where to put it on the queue:
+ * TCL_QUEUE_TAIL, TCL_QUEUE_HEAD, or
+ * TCL_QUEUE_MARK. */
+{
+ TkWindowEvent *wevPtr;
+ TkDisplay *dispPtr;
+
+ /*
+ * Find our display structure for the event's display.
+ */
+
+ for (dispPtr = TkGetDisplayList(); ; dispPtr = dispPtr->nextPtr) {
+ if (dispPtr == NULL) {
+ return;
+ }
+ if (dispPtr->display == eventPtr->xany.display) {
+ break;
+ }
+ }
+
+ /*
+ * Don't filter motion events if the user defaulting to true (1), which
+ * could be set to false (0) when the user wishes to receive all the
+ * motion data)
+ */
+
+ if (!(dispPtr->flags & TK_DISPLAY_COLLAPSE_MOTION_EVENTS)) {
+ wevPtr = ckalloc(sizeof(TkWindowEvent));
+ wevPtr->header.proc = WindowEventProc;
+ wevPtr->event = *eventPtr;
+ Tcl_QueueEvent(&wevPtr->header, position);
+ return;
+ }
+
+ if ((dispPtr->delayedMotionPtr != NULL) && (position == TCL_QUEUE_TAIL)) {
+ if ((eventPtr->type == MotionNotify) && (eventPtr->xmotion.window
+ == dispPtr->delayedMotionPtr->event.xmotion.window)) {
+ /*
+ * The new event is a motion event in the same window as the saved
+ * motion event. Just replace the saved event with the new one.
+ */
+
+ dispPtr->delayedMotionPtr->event = *eventPtr;
+ return;
+ } else if ((eventPtr->type != GraphicsExpose)
+ && (eventPtr->type != NoExpose)
+ && (eventPtr->type != Expose)) {
+ /*
+ * The new event may conflict with the saved motion event. Queue
+ * the saved motion event now so that it will be processed before
+ * the new event.
+ */
+
+ Tcl_QueueEvent(&dispPtr->delayedMotionPtr->header, position);
+ dispPtr->delayedMotionPtr = NULL;
+ Tcl_CancelIdleCall(DelayedMotionProc, dispPtr);
+ }
+ }
+
+ wevPtr = ckalloc(sizeof(TkWindowEvent));
+ wevPtr->header.proc = WindowEventProc;
+ wevPtr->event = *eventPtr;
+ if ((eventPtr->type == MotionNotify) && (position == TCL_QUEUE_TAIL)) {
+ /*
+ * The new event is a motion event so don't queue it immediately; save
+ * it around in case another motion event arrives that it can be
+ * collapsed with.
+ */
+
+ if (dispPtr->delayedMotionPtr != NULL) {
+ Tcl_Panic("Tk_QueueWindowEvent found unexpected delayed motion event");
+ }
+ dispPtr->delayedMotionPtr = wevPtr;
+ Tcl_DoWhenIdle(DelayedMotionProc, dispPtr);
+ } else {
+ Tcl_QueueEvent(&wevPtr->header, position);
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkQueueEventForAllChildren --
+ *
+ * Given an XEvent, recursively queue the event for this window and all
+ * non-toplevel children of the given window.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Events queued.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TkQueueEventForAllChildren(
+ TkWindow *winPtr, /* Window to which event is sent. */
+ XEvent *eventPtr) /* The event to be sent. */
+{
+ TkWindow *childPtr;
+
+ if (!Tk_IsMapped(winPtr)) {
+ return;
+ }
+
+ eventPtr->xany.window = winPtr->window;
+ Tk_QueueWindowEvent(eventPtr, TCL_QUEUE_TAIL);
+
+ childPtr = winPtr->childList;
+ while (childPtr != NULL) {
+ if (!Tk_TopWinHierarchy(childPtr)) {
+ TkQueueEventForAllChildren(childPtr, eventPtr);
+ }
+ childPtr = childPtr->nextPtr;
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * WindowEventProc --
+ *
+ * This function is called by Tcl_DoOneEvent when a window event reaches
+ * the front of the event queue. This function is responsible for
+ * actually handling the event.
+ *
+ * Results:
+ * Returns 1 if the event was handled, meaning it should be removed from
+ * the queue. Returns 0 if the event was not handled, meaning it should
+ * stay on the queue. The event isn't handled if the TCL_WINDOW_EVENTS
+ * bit isn't set in flags, if a restrict proc prevents the event from
+ * being handled.
+ *
+ * Side effects:
+ * Whatever the event handlers for the event do.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+WindowEventProc(
+ Tcl_Event *evPtr, /* Event to service. */
+ int flags) /* Flags that indicate what events to handle,
+ * such as TCL_WINDOW_EVENTS. */
+{
+ TkWindowEvent *wevPtr = (TkWindowEvent *) evPtr;
+ Tk_RestrictAction result;
+ ThreadSpecificData *tsdPtr =
+ Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
+
+ if (!(flags & TCL_WINDOW_EVENTS)) {
+ return 0;
+ }
+ if (tsdPtr->restrictProc != NULL) {
+ result = tsdPtr->restrictProc(tsdPtr->restrictArg, &wevPtr->event);
+ if (result != TK_PROCESS_EVENT) {
+ if (result == TK_DEFER_EVENT) {
+ return 0;
+ } else {
+ /*
+ * TK_DELETE_EVENT: return and say we processed the event,
+ * even though we didn't do anything at all.
+ */
+
+ CleanUpTkEvent(&wevPtr->event);
+ return 1;
+ }
+ }
+ }
+ Tk_HandleEvent(&wevPtr->event);
+ CleanUpTkEvent(&wevPtr->event);
+ return 1;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * CleanUpTkEvent --
+ *
+ * This function is called to remove and deallocate any information in
+ * the event which is not directly in the event structure itself. It may
+ * be called multiple times per event, so it takes care to set the
+ * cleared pointer fields to NULL afterwards.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Makes the event no longer have any external resources.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+CleanUpTkEvent(
+ XEvent *eventPtr)
+{
+ switch (eventPtr->type) {
+ case KeyPress:
+ case KeyRelease: {
+ TkKeyEvent *kePtr = (TkKeyEvent *) eventPtr;
+
+ if (kePtr->charValuePtr != NULL) {
+ ckfree(kePtr->charValuePtr);
+ kePtr->charValuePtr = NULL;
+ kePtr->charValueLen = 0;
+ }
+ break;
+ }
+
+ case VirtualEvent: {
+ XVirtualEvent *vePtr = (XVirtualEvent *) eventPtr;
+
+ if (vePtr->user_data != NULL) {
+ Tcl_DecrRefCount(vePtr->user_data);
+ vePtr->user_data = NULL;
+ }
+ break;
+ }
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * DelayedMotionProc --
+ *
+ * This function is invoked as an idle handler when a mouse motion event
+ * has been delayed. It queues the delayed event so that it will finally
+ * be serviced.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The delayed mouse motion event gets added to the Tcl event queue for
+ * servicing.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+DelayedMotionProc(
+ ClientData clientData) /* Pointer to display containing a delayed
+ * motion event to be serviced. */
+{
+ TkDisplay *dispPtr = clientData;
+
+ if (dispPtr->delayedMotionPtr == NULL) {
+ Tcl_Panic("DelayedMotionProc found no delayed mouse motion event");
+ }
+ Tcl_QueueEvent(&dispPtr->delayedMotionPtr->header, TCL_QUEUE_TAIL);
+ dispPtr->delayedMotionPtr = NULL;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkCreateExitHandler --
+ *
+ * Same as Tcl_CreateExitHandler, but private to Tk.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects.
+ * Sets a handler with Tcl_CreateExitHandler if this is the first call.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TkCreateExitHandler(
+ Tcl_ExitProc *proc, /* Function to invoke. */
+ ClientData clientData) /* Arbitrary value to pass to proc. */
+{
+ ExitHandler *exitPtr;
+
+ exitPtr = ckalloc(sizeof(ExitHandler));
+ exitPtr->proc = proc;
+ exitPtr->clientData = clientData;
+ Tcl_MutexLock(&exitMutex);
+
+ /*
+ * The call to TclInExit() is disabled here. That's a private Tcl routine,
+ * and calling it is causing some trouble with portability of building Tk.
+ * We should avoid private Tcl routines generally.
+ *
+ * In this case, the TclInExit() call is being used only to prevent a
+ * Tcl_CreateExitHandler() call when Tcl finalization is in progress.
+ * That's a situation that shouldn't happen anyway. Recent changes within
+ * Tcl_Finalize now cause a Tcl_Panic() to happen if exit handlers get
+ * added after exit handling is complete. By disabling the guard here,
+ * that panic will serve to help us find the buggy conditions and correct
+ * them.
+ *
+ * We can restore this guard if we find we must (hopefully getting public
+ * access to TclInExit() if we discover extensions really do need this),
+ * but during alpha development, this is a good time to dig in and find
+ * the root causes of finalization bugs.
+ */
+
+ if (firstExitPtr == NULL/* && !TclInExit()*/) {
+ Tcl_CreateExitHandler(TkFinalize, NULL);
+ }
+ exitPtr->nextPtr = firstExitPtr;
+ firstExitPtr = exitPtr;
+ Tcl_MutexUnlock(&exitMutex);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkDeleteExitHandler --
+ *
+ * Same as Tcl_DeleteExitHandler, but private to Tk.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects.
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TkDeleteExitHandler(
+ Tcl_ExitProc *proc, /* Function that was previously registered. */
+ ClientData clientData) /* Arbitrary value to pass to proc. */
+{
+ ExitHandler *exitPtr, *prevPtr;
+
+ Tcl_MutexLock(&exitMutex);
+ for (prevPtr = NULL, exitPtr = firstExitPtr; exitPtr != NULL;
+ prevPtr = exitPtr, exitPtr = exitPtr->nextPtr) {
+ if ((exitPtr->proc == proc)
+ && (exitPtr->clientData == clientData)) {
+ if (prevPtr == NULL) {
+ firstExitPtr = exitPtr->nextPtr;
+ } else {
+ prevPtr->nextPtr = exitPtr->nextPtr;
+ }
+ ckfree(exitPtr);
+ break;
+ }
+ }
+ Tcl_MutexUnlock(&exitMutex);
+ return;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkCreateThreadExitHandler --
+ *
+ * Same as Tcl_CreateThreadExitHandler, but private to Tk.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Proc will be invoked with clientData as argument when the application
+ * exits.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TkCreateThreadExitHandler(
+ Tcl_ExitProc *proc, /* Function to invoke. */
+ ClientData clientData) /* Arbitrary value to pass to proc. */
+{
+ ExitHandler *exitPtr;
+ ThreadSpecificData *tsdPtr =
+ Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
+
+ exitPtr = ckalloc(sizeof(ExitHandler));
+ exitPtr->proc = proc;
+ exitPtr->clientData = clientData;
+
+ /*
+ * See comments in TkCreateExitHandler().
+ */
+
+ if (tsdPtr->firstExitPtr == NULL/* && !TclInExit()*/) {
+ Tcl_CreateThreadExitHandler(TkFinalizeThread, NULL);
+ }
+ exitPtr->nextPtr = tsdPtr->firstExitPtr;
+ tsdPtr->firstExitPtr = exitPtr;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkDeleteThreadExitHandler --
+ *
+ * Same as Tcl_DeleteThreadExitHandler, but private to Tk.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * If there is an exit handler corresponding to proc and clientData then
+ * it is cancelled; if no such handler exists then nothing happens.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TkDeleteThreadExitHandler(
+ Tcl_ExitProc *proc, /* Function that was previously registered. */
+ ClientData clientData) /* Arbitrary value to pass to proc. */
+{
+ ExitHandler *exitPtr, *prevPtr;
+ ThreadSpecificData *tsdPtr =
+ Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
+
+ for (prevPtr = NULL, exitPtr = tsdPtr->firstExitPtr; exitPtr != NULL;
+ prevPtr = exitPtr, exitPtr = exitPtr->nextPtr) {
+ if ((exitPtr->proc == proc)
+ && (exitPtr->clientData == clientData)) {
+ if (prevPtr == NULL) {
+ tsdPtr->firstExitPtr = exitPtr->nextPtr;
+ } else {
+ prevPtr->nextPtr = exitPtr->nextPtr;
+ }
+ ckfree(exitPtr);
+ return;
+ }
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkFinalize --
+ *
+ * Runs our private exit handlers and removes itself from Tcl. This is
+ * benificial should we want to protect from dangling pointers should the
+ * Tk shared library be unloaded prior to Tcl which can happen on windows
+ * should the process be forcefully exiting from an exception handler.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects.
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TkFinalize(
+ ClientData clientData) /* Arbitrary value to pass to proc. */
+{
+ ExitHandler *exitPtr;
+
+#if defined(_WIN32) && !defined(STATIC_BUILD)
+ if (!tclStubsPtr) {
+ return;
+ }
+#endif
+
+ Tcl_DeleteExitHandler(TkFinalize, NULL);
+
+ Tcl_MutexLock(&exitMutex);
+ for (exitPtr = firstExitPtr; exitPtr != NULL; exitPtr = firstExitPtr) {
+ /*
+ * Be careful to remove the handler from the list before invoking its
+ * callback. This protects us against double-freeing if the callback
+ * should call TkDeleteExitHandler on itself.
+ */
+
+ firstExitPtr = exitPtr->nextPtr;
+ Tcl_MutexUnlock(&exitMutex);
+ exitPtr->proc(exitPtr->clientData);
+ ckfree(exitPtr);
+ Tcl_MutexLock(&exitMutex);
+ }
+ firstExitPtr = NULL;
+ Tcl_MutexUnlock(&exitMutex);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkFinalizeThread --
+ *
+ * Runs our private thread exit handlers and removes itself from Tcl.
+ * This is beneficial should we want to protect from dangling pointers
+ * should the Tk shared library be unloaded prior to Tcl which can happen
+ * on Windows should the process be forcefully exiting from an exception
+ * handler.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects.
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TkFinalizeThread(
+ ClientData clientData) /* Arbitrary value to pass to proc. */
+{
+ ExitHandler *exitPtr;
+ ThreadSpecificData *tsdPtr =
+ Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
+
+ Tcl_DeleteThreadExitHandler(TkFinalizeThread, NULL);
+
+ if (tsdPtr != NULL) {
+ tsdPtr->inExit = 1;
+
+ for (exitPtr = tsdPtr->firstExitPtr; exitPtr != NULL;
+ exitPtr = tsdPtr->firstExitPtr) {
+ /*
+ * Be careful to remove the handler from the list before invoking
+ * its callback. This protects us against double-freeing if the
+ * callback should call TkDeleteThreadExitHandler on itself.
+ */
+
+ tsdPtr->firstExitPtr = exitPtr->nextPtr;
+ exitPtr->proc(exitPtr->clientData);
+ ckfree(exitPtr);
+ }
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_MainLoop --
+ *
+ * Call Tcl_DoOneEvent over and over again in an infinite loop as long as
+ * there exist any main windows.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Arbitrary; depends on handlers for events.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tk_MainLoop(void)
+{
+ while (Tk_GetNumMainWindows() > 0) {
+ Tcl_DoOneEvent(0);
+ }
+}
+
+/*
+ * Local Variables:
+ * mode: c
+ * c-basic-offset: 4
+ * fill-column: 78
+ * End:
+ */
diff --git a/tk8.6/generic/tkFileFilter.c b/tk8.6/generic/tkFileFilter.c
new file mode 100644
index 0000000..8588d70
--- /dev/null
+++ b/tk8.6/generic/tkFileFilter.c
@@ -0,0 +1,473 @@
+/*
+ * tkFileFilter.c --
+ *
+ * Process the -filetypes option for the file dialogs on Windows and the
+ * Mac.
+ *
+ * Copyright (c) 1996 Sun Microsystems, Inc.
+ *
+ * See the file "license.terms" for information on usage and redistribution of
+ * this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ */
+
+#include "tkInt.h"
+#include "tkFileFilter.h"
+
+static int AddClause(Tcl_Interp *interp, FileFilter *filterPtr,
+ Tcl_Obj *patternsObj, Tcl_Obj *ostypesObj,
+ int isWindows);
+static FileFilter * GetFilter(FileFilterList *flistPtr, const char *name);
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkInitFileFilters --
+ *
+ * Initializes a FileFilterList data structure. A FileFilterList must be
+ * initialized EXACTLY ONCE before any calls to TkGetFileFilters() is
+ * made. The usual flow of control is:
+ * TkInitFileFilters(&flist);
+ * TkGetFileFilters(&flist, ...);
+ * TkGetFileFilters(&flist, ...);
+ * ...
+ * TkFreeFileFilters(&flist);
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The fields in flistPtr are initialized.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TkInitFileFilters(
+ FileFilterList *flistPtr) /* The structure to be initialized. */
+{
+ flistPtr->filters = NULL;
+ flistPtr->filtersTail = NULL;
+ flistPtr->numFilters = 0;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkGetFileFilters --
+ *
+ * This function is called by the Mac and Windows implementation of
+ * tk_getOpenFile and tk_getSaveFile to translate the string value of the
+ * -filetypes option into an easy-to-parse C structure (flistPtr). The
+ * caller of this function will then use flistPtr to perform filetype
+ * matching in a platform specific way.
+ *
+ * flistPtr must be initialized (See comments in TkInitFileFilters).
+ *
+ * Results:
+ * A standard TCL return value.
+ *
+ * Side effects:
+ * The fields in flistPtr are changed according to 'types'.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TkGetFileFilters(
+ Tcl_Interp *interp, /* Interpreter to use for error reporting. */
+ FileFilterList *flistPtr, /* Stores the list of file filters. */
+ Tcl_Obj *types, /* Value of the -filetypes option. */
+ int isWindows) /* True if we are running on Windows. */
+{
+ int listObjc;
+ Tcl_Obj ** listObjv = NULL;
+ int i;
+
+ if (types == NULL) {
+ return TCL_OK;
+ }
+
+ if (Tcl_ListObjGetElements(interp, types, &listObjc,
+ &listObjv) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (listObjc == 0) {
+ return TCL_OK;
+ }
+
+ /*
+ * Free the filter information that have been allocated the previous time;
+ * the -filefilters option may have been used more than once in the
+ * command line.
+ */
+
+ TkFreeFileFilters(flistPtr);
+
+ for (i = 0; i<listObjc; i++) {
+ /*
+ * Each file type should have two or three elements: the first one is
+ * the name of the type and the second is the filter of the type. The
+ * third is the Mac OSType ID, but we don't care about them here.
+ */
+
+ int count;
+ FileFilter *filterPtr;
+ Tcl_Obj **typeInfo;
+
+ if (Tcl_ListObjGetElements(interp, listObjv[i], &count,
+ &typeInfo) != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ if (count != 2 && count != 3) {
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "bad file type \"%s\", should be "
+ "\"typeName {extension ?extensions ...?} "
+ "?{macType ?macTypes ...?}?\"",
+ Tcl_GetString(listObjv[i])));
+ Tcl_SetErrorCode(interp, "TK", "VALUE", "FILE_TYPE", NULL);
+ return TCL_ERROR;
+ }
+
+ filterPtr = GetFilter(flistPtr, Tcl_GetString(typeInfo[0]));
+
+ if (AddClause(interp, filterPtr, typeInfo[1],
+ (count==2 ? NULL : typeInfo[2]), isWindows) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ }
+
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkFreeFileFilters --
+ *
+ * Frees the malloc'ed file filter information.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The fields allocated by TkGetFileFilters() are freed.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TkFreeFileFilters(
+ FileFilterList *flistPtr) /* List of file filters to free */
+{
+ FileFilter *filterPtr;
+ FileFilterClause *clausePtr;
+ GlobPattern *globPtr;
+ MacFileType *mfPtr;
+ register void *toFree; /* A pointer that we are about to free. */
+
+ for (filterPtr = flistPtr->filters; filterPtr != NULL; ) {
+ for (clausePtr = filterPtr->clauses; clausePtr != NULL; ) {
+ /*
+ * Squelch each of the glob patterns.
+ */
+
+ for (globPtr = clausePtr->patterns; globPtr != NULL; ) {
+ ckfree(globPtr->pattern);
+ toFree = globPtr;
+ globPtr = globPtr->next;
+ ckfree(toFree);
+ }
+
+ /*
+ * Squelch each of the Mac file type codes.
+ */
+
+ for (mfPtr = clausePtr->macTypes; mfPtr != NULL; ) {
+ toFree = mfPtr;
+ mfPtr = mfPtr->next;
+ ckfree(toFree);
+ }
+ toFree = clausePtr;
+ clausePtr = clausePtr->next;
+ ckfree(toFree);
+ }
+
+ /*
+ * Squelch the name of the filter and the overall structure.
+ */
+
+ ckfree(filterPtr->name);
+ toFree = filterPtr;
+ filterPtr = filterPtr->next;
+ ckfree(toFree);
+ }
+ flistPtr->filters = NULL;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * AddClause --
+ *
+ * Add one FileFilterClause to filterPtr.
+ *
+ * Results:
+ * A standard TCL result.
+ *
+ * Side effects:
+ * The list of filter clauses are updated in filterPtr.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+AddClause(
+ Tcl_Interp *interp, /* Interpreter to use for error reporting. */
+ FileFilter *filterPtr, /* Stores the new filter clause */
+ Tcl_Obj *patternsObj, /* A Tcl list of glob patterns. */
+ Tcl_Obj *ostypesObj, /* A Tcl list of Mac OSType strings. */
+ int isWindows) /* True if we are running on Windows; False if
+ * we are running on the Mac; Glob patterns
+ * need to be processed differently on these
+ * two platforms */
+{
+ Tcl_Obj **globList = NULL, **ostypeList = NULL;
+ int globCount, ostypeCount, i, code = TCL_OK;
+ FileFilterClause *clausePtr;
+ Tcl_Encoding macRoman = NULL;
+
+ if (Tcl_ListObjGetElements(interp, patternsObj,
+ &globCount, &globList) != TCL_OK) {
+ code = TCL_ERROR;
+ goto done;
+ }
+ if (ostypesObj != NULL) {
+ if (Tcl_ListObjGetElements(interp, ostypesObj,
+ &ostypeCount, &ostypeList) != TCL_OK) {
+ code = TCL_ERROR;
+ goto done;
+ }
+
+ /*
+ * We probably need this encoding now...
+ */
+
+ macRoman = Tcl_GetEncoding(NULL, "macRoman");
+
+ /*
+ * Might be cleaner to use 'Tcl_GetOSTypeFromObj' but that is actually
+ * static to the MacOS X/Darwin version of Tcl, and would therefore
+ * require further code refactoring.
+ */
+
+ for (i=0; i<ostypeCount; i++) {
+ int len;
+ const char *strType = Tcl_GetStringFromObj(ostypeList[i], &len);
+
+ /*
+ * If len is < 4, it is definitely an error. If equal or longer,
+ * we need to use the macRoman encoding to determine the correct
+ * length (assuming there may be non-ascii characters, e.g.,
+ * embedded nulls or accented characters in the string, the
+ * macRoman length will be different).
+ *
+ * If we couldn't load the encoding, then we can't actually check
+ * the correct length. But here we assume we're probably operating
+ * on unix/windows with a minimal set of encodings and so don't
+ * care about MacOS types. So we won't signal an error.
+ */
+
+ if (len >= 4 && macRoman != NULL) {
+ Tcl_DString osTypeDS;
+
+ /*
+ * Convert utf to macRoman, since MacOS types are defined to
+ * be 4 macRoman characters long
+ */
+
+ Tcl_UtfToExternalDString(macRoman, strType, len, &osTypeDS);
+ len = Tcl_DStringLength(&osTypeDS);
+ Tcl_DStringFree(&osTypeDS);
+ }
+ if (len != 4) {
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "bad Macintosh file type \"%s\"",
+ Tcl_GetString(ostypeList[i])));
+ Tcl_SetErrorCode(interp, "TK", "VALUE", "MAC_TYPE", NULL);
+ code = TCL_ERROR;
+ goto done;
+ }
+ }
+ }
+
+ /*
+ * Add the clause into the list of clauses
+ */
+
+ clausePtr = ckalloc(sizeof(FileFilterClause));
+ clausePtr->patterns = NULL;
+ clausePtr->patternsTail = NULL;
+ clausePtr->macTypes = NULL;
+ clausePtr->macTypesTail = NULL;
+
+ if (filterPtr->clauses == NULL) {
+ filterPtr->clauses = filterPtr->clausesTail = clausePtr;
+ } else {
+ filterPtr->clausesTail->next = clausePtr;
+ filterPtr->clausesTail = clausePtr;
+ }
+ clausePtr->next = NULL;
+
+ if (globCount > 0 && globList != NULL) {
+ for (i=0; i<globCount; i++) {
+ GlobPattern *globPtr = ckalloc(sizeof(GlobPattern));
+ int len;
+ const char *str = Tcl_GetStringFromObj(globList[i], &len);
+
+ len = (len + 1) * sizeof(char);
+ if (str[0] && str[0] != '*') {
+ /*
+ * Prepend a "*" to patterns that do not have a leading "*"
+ */
+
+ globPtr->pattern = ckalloc(len + 1);
+ globPtr->pattern[0] = '*';
+ strcpy(globPtr->pattern+1, str);
+ } else if (isWindows) {
+ if (strcmp(str, "*") == 0) {
+ globPtr->pattern = ckalloc(4);
+ strcpy(globPtr->pattern, "*.*");
+ } else if (strcmp(str, "") == 0) {
+ /*
+ * An empty string means "match all files with no
+ * extensions"
+ * TODO: "*." actually matches with all files on Win95
+ */
+
+ globPtr->pattern = ckalloc(3);
+ strcpy(globPtr->pattern, "*.");
+ } else {
+ globPtr->pattern = ckalloc(len);
+ strcpy(globPtr->pattern, str);
+ }
+ } else {
+ globPtr->pattern = ckalloc(len);
+ strcpy(globPtr->pattern, str);
+ }
+
+ /*
+ * Add the glob pattern into the list of patterns.
+ */
+
+ if (clausePtr->patterns == NULL) {
+ clausePtr->patterns = clausePtr->patternsTail = globPtr;
+ } else {
+ clausePtr->patternsTail->next = globPtr;
+ clausePtr->patternsTail = globPtr;
+ }
+ globPtr->next = NULL;
+ }
+ }
+ if (ostypeList != NULL && ostypeCount > 0) {
+ if (macRoman == NULL) {
+ macRoman = Tcl_GetEncoding(NULL, "macRoman");
+ }
+ for (i=0; i<ostypeCount; i++) {
+ Tcl_DString osTypeDS;
+ int len;
+ MacFileType *mfPtr = ckalloc(sizeof(MacFileType));
+ const char *strType = Tcl_GetStringFromObj(ostypeList[i], &len);
+ char *string;
+
+ /*
+ * Convert utf to macRoman, since MacOS types are defined to be 4
+ * macRoman characters long
+ */
+
+ Tcl_UtfToExternalDString(macRoman, strType, len, &osTypeDS);
+ string = Tcl_DStringValue(&osTypeDS);
+ mfPtr->type = (OSType) string[0] << 24 | (OSType) string[1] << 16 |
+ (OSType) string[2] << 8 | (OSType) string[3];
+ Tcl_DStringFree(&osTypeDS);
+
+ /*
+ * Add the Mac type pattern into the list of Mac types
+ */
+
+ if (clausePtr->macTypes == NULL) {
+ clausePtr->macTypes = clausePtr->macTypesTail = mfPtr;
+ } else {
+ clausePtr->macTypesTail->next = mfPtr;
+ clausePtr->macTypesTail = mfPtr;
+ }
+ mfPtr->next = NULL;
+ }
+ }
+
+ done:
+ if (macRoman != NULL) {
+ Tcl_FreeEncoding(macRoman);
+ }
+ return code;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * GetFilter --
+ *
+ * Add one FileFilter to flistPtr.
+ *
+ * Results:
+ * A standard TCL result.
+ *
+ * Side effects:
+ * The list of filters are updated in flistPtr.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static FileFilter *
+GetFilter(
+ FileFilterList *flistPtr, /* The FileFilterList that contains the newly
+ * created filter */
+ const char *name) /* Name of the filter. It is usually displayed
+ * in the "File Types" listbox in the file
+ * dialogs. */
+{
+ FileFilter *filterPtr = flistPtr->filters;
+ size_t len;
+
+ for (; filterPtr; filterPtr=filterPtr->next) {
+ if (strcmp(filterPtr->name, name) == 0) {
+ return filterPtr;
+ }
+ }
+
+ filterPtr = ckalloc(sizeof(FileFilter));
+ filterPtr->clauses = NULL;
+ filterPtr->clausesTail = NULL;
+ len = strlen(name) + 1;
+ filterPtr->name = ckalloc(len);
+ memcpy(filterPtr->name, name, len);
+
+ if (flistPtr->filters == NULL) {
+ flistPtr->filters = flistPtr->filtersTail = filterPtr;
+ } else {
+ flistPtr->filtersTail->next = filterPtr;
+ flistPtr->filtersTail = filterPtr;
+ }
+ filterPtr->next = NULL;
+
+ ++flistPtr->numFilters;
+ return filterPtr;
+}
+
+/*
+ * Local Variables:
+ * mode: c
+ * c-basic-offset: 4
+ * fill-column: 78
+ * End:
+ */
diff --git a/tk8.6/generic/tkFileFilter.h b/tk8.6/generic/tkFileFilter.h
new file mode 100644
index 0000000..131e423
--- /dev/null
+++ b/tk8.6/generic/tkFileFilter.h
@@ -0,0 +1,78 @@
+/*
+ * tkFileFilter.h --
+ *
+ * Declarations for the file filter processing routines needed by the
+ * file selection dialogs.
+ *
+ * Copyright (c) 1996 Sun Microsystems, Inc.
+ *
+ * See the file "license.terms" for information on usage and redistribution of
+ * this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ */
+
+#ifndef _TK_FILE_FILTER
+#define _TK_FILE_FILTER
+
+#define OSType long
+
+typedef struct GlobPattern {
+ struct GlobPattern *next; /* Chains to the next glob pattern in a glob
+ * pattern list */
+ char *pattern; /* String value of the pattern, such as
+ * "*.txt" or "*.*" */
+} GlobPattern;
+
+typedef struct MacFileType {
+ struct MacFileType *next; /* Chains to the next mac file type in a mac
+ * file type list */
+ OSType type; /* Mac file type, such as 'TEXT' or 'GIFF' */
+} MacFileType;
+
+typedef struct FileFilterClause {
+ struct FileFilterClause *next;
+ /* Chains to the next clause in a clause
+ * list */
+ GlobPattern *patterns; /* Head of glob pattern type list */
+ GlobPattern *patternsTail; /* Tail of glob pattern type list */
+ MacFileType *macTypes; /* Head of mac file type list */
+ MacFileType *macTypesTail; /* Tail of mac file type list */
+} FileFilterClause;
+
+typedef struct FileFilter {
+ struct FileFilter *next; /* Chains to the next filter in a filter
+ * list */
+ char *name; /* Name of the file filter, such as "Text
+ * Documents" */
+ FileFilterClause *clauses; /* Head of the clauses list */
+ FileFilterClause *clausesTail;
+ /* Tail of the clauses list */
+} FileFilter;
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * FileFilterList --
+ *
+ * The routine TkGetFileFilters() translates the string value of the
+ * -filefilters option into a FileFilterList structure, which consists of
+ * a list of file filters.
+ *
+ * Each file filter consists of one or more clauses. Each clause has one
+ * or more glob patterns and/or one or more Mac file types
+ *
+ *----------------------------------------------------------------------
+ */
+
+typedef struct FileFilterList {
+ FileFilter *filters; /* Head of the filter list */
+ FileFilter *filtersTail; /* Tail of the filter list */
+ int numFilters; /* number of filters in the list */
+} FileFilterList;
+
+MODULE_SCOPE void TkFreeFileFilters(FileFilterList *flistPtr);
+MODULE_SCOPE void TkInitFileFilters(FileFilterList *flistPtr);
+MODULE_SCOPE int TkGetFileFilters(Tcl_Interp *interp,
+ FileFilterList *flistPtr, Tcl_Obj *valuePtr,
+ int isWindows);
+
+#endif /* _TK_FILE_FILTER */
diff --git a/tk8.6/generic/tkFocus.c b/tk8.6/generic/tkFocus.c
new file mode 100644
index 0000000..60f631d
--- /dev/null
+++ b/tk8.6/generic/tkFocus.c
@@ -0,0 +1,1201 @@
+/*
+ * tkFocus.c --
+ *
+ * This file contains functions that manage the input focus for Tk.
+ *
+ * Copyright (c) 1990-1994 The Regents of the University of California.
+ * Copyright (c) 1994-1997 Sun Microsystems, Inc.
+ *
+ * See the file "license.terms" for information on usage and redistribution of
+ * this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ */
+
+#include "tkInt.h"
+
+/*
+ * For each top-level window that has ever received the focus, there is a
+ * record of the following type:
+ */
+
+typedef struct TkToplevelFocusInfo {
+ TkWindow *topLevelPtr; /* Information about top-level window. */
+ TkWindow *focusWinPtr; /* The next time the focus comes to this
+ * top-level, it will be given to this
+ * window. */
+ struct TkToplevelFocusInfo *nextPtr;
+ /* Next in list of all toplevel focus records
+ * for a given application. */
+} ToplevelFocusInfo;
+
+/*
+ * One of the following structures exists for each display used by each
+ * application. These are linked together from the TkMainInfo structure.
+ * These structures are needed because it isn't sufficient to store a single
+ * piece of focus information in each display or in each application: we need
+ * the cross-product. There needs to be separate information for each display,
+ * because it's possible to have multiple focus windows active simultaneously
+ * on different displays. There also needs to be separate information for each
+ * application, because of embedding: if an embedded application has the
+ * focus, its container application also has the focus. Thus we keep a list of
+ * structures for each application: the same display can appear in structures
+ * for several applications at once.
+ */
+
+typedef struct TkDisplayFocusInfo {
+ TkDisplay *dispPtr; /* Display that this information pertains
+ * to. */
+ struct TkWindow *focusWinPtr;
+ /* Window that currently has the focus for
+ * this application on this display, or NULL
+ * if none. */
+ struct TkWindow *focusOnMapPtr;
+ /* This points to a toplevel window that is
+ * supposed to receive the X input focus as
+ * soon as it is mapped (needed to handle the
+ * fact that X won't allow the focus on an
+ * unmapped window). NULL means no delayed
+ * focus op in progress for this display. */
+ int forceFocus; /* Associated with focusOnMapPtr: non-zero
+ * means claim the focus even if some other
+ * application currently has it. */
+ unsigned long focusSerial; /* Serial number of last request this
+ * application made to change the focus on
+ * this display. Used to identify stale focus
+ * notifications coming from the X server. */
+ struct TkDisplayFocusInfo *nextPtr;
+ /* Next in list of all display focus records
+ * for a given application. */
+} DisplayFocusInfo;
+
+/*
+ * Debugging support...
+ */
+
+#define DEBUG(dispPtr, arguments) \
+ if ((dispPtr)->focusDebug) { \
+ printf arguments; \
+ }
+
+/*
+ * Forward declarations for functions defined in this file:
+ */
+
+static DisplayFocusInfo*FindDisplayFocusInfo(TkMainInfo *mainPtr,
+ TkDisplay *dispPtr);
+static void FocusMapProc(ClientData clientData, XEvent *eventPtr);
+static void GenerateFocusEvents(TkWindow *sourcePtr,
+ TkWindow *destPtr);
+
+/*
+ *--------------------------------------------------------------
+ *
+ * Tk_FocusObjCmd --
+ *
+ * This function is invoked to process the "focus" Tcl command. See the
+ * user documentation for details on what it does.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * See the user documentation.
+ *
+ *--------------------------------------------------------------
+ */
+
+int
+Tk_FocusObjCmd(
+ ClientData clientData, /* Main window associated with interpreter. */
+ Tcl_Interp *interp, /* Current interpreter. */
+ int objc, /* Number of arguments. */
+ Tcl_Obj *const objv[]) /* Argument objects. */
+{
+ static const char *const focusOptions[] = {
+ "-displayof", "-force", "-lastfor", NULL
+ };
+ Tk_Window tkwin = clientData;
+ TkWindow *winPtr = clientData;
+ TkWindow *newPtr, *topLevelPtr;
+ ToplevelFocusInfo *tlFocusPtr;
+ const char *windowName;
+ int index;
+
+ /*
+ * If invoked with no arguments, just return the current focus window.
+ */
+
+ if (objc == 1) {
+ Tk_Window focusWin = (Tk_Window) TkGetFocusWin(winPtr);
+
+ if (focusWin != NULL) {
+ Tcl_SetObjResult(interp, TkNewWindowObj(focusWin));
+ }
+ return TCL_OK;
+ }
+
+ /*
+ * If invoked with a single argument beginning with "." then focus on that
+ * window.
+ */
+
+ if (objc == 2) {
+ windowName = Tcl_GetString(objv[1]);
+
+ /*
+ * The empty string case exists for backwards compatibility.
+ */
+
+ if (windowName[0] == '\0') {
+ return TCL_OK;
+ }
+ if (windowName[0] == '.') {
+ newPtr = (TkWindow *) Tk_NameToWindow(interp, windowName, tkwin);
+ if (newPtr == NULL) {
+ return TCL_ERROR;
+ }
+ TkSetFocusWin(newPtr, 0);
+ return TCL_OK;
+ }
+ }
+
+ /*
+ * We have a subcommand to parse and act upon.
+ */
+
+ if (Tcl_GetIndexFromObjStruct(interp, objv[1], focusOptions,
+ sizeof(char *), "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_GetString(objv[2]);
+ newPtr = (TkWindow *) Tk_NameToWindow(interp, windowName, tkwin);
+ if (newPtr == NULL) {
+ return TCL_ERROR;
+ }
+ newPtr = TkGetFocusWin(newPtr);
+ if (newPtr != NULL) {
+ Tcl_SetObjResult(interp, TkNewWindowObj((Tk_Window) newPtr));
+ }
+ break;
+ case 1: /* -force */
+ windowName = Tcl_GetString(objv[2]);
+
+ /*
+ * The empty string case exists for backwards compatibility.
+ */
+
+ if (windowName[0] == '\0') {
+ return TCL_OK;
+ }
+ newPtr = (TkWindow *) Tk_NameToWindow(interp, windowName, tkwin);
+ if (newPtr == NULL) {
+ return TCL_ERROR;
+ }
+ TkSetFocusWin(newPtr, 1);
+ break;
+ case 2: /* -lastfor */
+ windowName = Tcl_GetString(objv[2]);
+ newPtr = (TkWindow *) Tk_NameToWindow(interp, windowName, tkwin);
+ if (newPtr == NULL) {
+ return TCL_ERROR;
+ }
+ for (topLevelPtr = newPtr; topLevelPtr != NULL;
+ topLevelPtr = topLevelPtr->parentPtr) {
+ if (!(topLevelPtr->flags & TK_TOP_HIERARCHY)) {
+ continue;
+ }
+ for (tlFocusPtr = newPtr->mainPtr->tlFocusPtr; tlFocusPtr != NULL;
+ tlFocusPtr = tlFocusPtr->nextPtr) {
+ if (tlFocusPtr->topLevelPtr == topLevelPtr) {
+ Tcl_SetObjResult(interp, TkNewWindowObj((Tk_Window)
+ tlFocusPtr->focusWinPtr));
+ return TCL_OK;
+ }
+ }
+ Tcl_SetObjResult(interp, TkNewWindowObj((Tk_Window) topLevelPtr));
+ return TCL_OK;
+ }
+ break;
+ default:
+ Tcl_Panic("bad const entries to focusOptions in focus command");
+ }
+ return TCL_OK;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * TkFocusFilterEvent --
+ *
+ * This function is invoked by Tk_HandleEvent when it encounters a
+ * FocusIn, FocusOut, Enter, or Leave event.
+ *
+ * Results:
+ * A return value of 1 means that Tk_HandleEvent should process the event
+ * normally (i.e. event handlers should be invoked). A return value of 0
+ * means that this event should be ignored.
+ *
+ * Side effects:
+ * Additional events may be generated, and the focus may switch.
+ *
+ *--------------------------------------------------------------
+ */
+
+int
+TkFocusFilterEvent(
+ TkWindow *winPtr, /* Window that focus event is directed to. */
+ XEvent *eventPtr) /* FocusIn, FocusOut, Enter, or Leave
+ * event. */
+{
+ /*
+ * Design notes: the window manager and X server work together to transfer
+ * the focus among top-level windows. This function takes care of
+ * transferring the focus from a top-level or wrapper window to the actual
+ * window within that top-level that has the focus. We do this by
+ * synthesizing X events to move the focus around. None of the FocusIn and
+ * FocusOut events generated by X are ever used outside of this function;
+ * only the synthesized events get through to the rest of the application.
+ * At one point (e.g. Tk4.0b1) Tk used to call X to move the focus from a
+ * top-level to one of its descendants, then just pass through the events
+ * generated by X. This approach didn't work very well, for a variety of
+ * reasons. For example, if X generates the events they go at the back of
+ * the event queue, which could cause problems if other things have
+ * already happened, such as moving the focus to yet another window.
+ */
+
+ ToplevelFocusInfo *tlFocusPtr;
+ DisplayFocusInfo *displayFocusPtr;
+ TkDisplay *dispPtr = winPtr->dispPtr;
+ TkWindow *newFocusPtr;
+ int retValue, delta;
+
+ /*
+ * If this was a generated event, just turn off the generated flag and
+ * pass the event through to Tk bindings.
+ */
+
+ if (eventPtr->xfocus.send_event == GENERATED_FOCUS_EVENT_MAGIC) {
+ eventPtr->xfocus.send_event = 0;
+ return 1;
+ }
+
+ /*
+ * Check for special events generated by embedded applications to request
+ * the input focus. If this is one of those events, make the change in
+ * focus and return without any additional processing of the event (note:
+ * the "detail" field of the event indicates whether to claim the focus
+ * even if we don't already have it).
+ */
+
+ if ((eventPtr->xfocus.mode == EMBEDDED_APP_WANTS_FOCUS)
+ && (eventPtr->type == FocusIn)) {
+ TkSetFocusWin(winPtr, eventPtr->xfocus.detail);
+ return 0;
+ }
+
+ /*
+ * This was not a generated event. We'll return 1 (so that the event will
+ * be processed) if it's an Enter or Leave event, and 0 (so that the event
+ * won't be processed) if it's a FocusIn or FocusOut event.
+ */
+
+ retValue = 0;
+ displayFocusPtr = FindDisplayFocusInfo(winPtr->mainPtr, winPtr->dispPtr);
+ if (eventPtr->type == FocusIn) {
+ /*
+ * Skip FocusIn events that cause confusion
+ * NotifyVirtual and NotifyNonlinearVirtual - Virtual events occur on
+ * windows in between the origin and destination of the focus
+ * change. For FocusIn we may see this when focus goes into an
+ * embedded child. We don't care about this, although we may end
+ * up getting a NotifyPointer later.
+ * NotifyInferior - focus is coming to us from an embedded child. When
+ * focus is on an embeded focus, we still think we have the
+ * focus, too, so this message doesn't change our state.
+ * NotifyPointerRoot - should never happen because this is sent to the
+ * root window.
+ *
+ * Interesting FocusIn events are
+ * NotifyAncestor - focus is coming from our parent, probably the root.
+ * NotifyNonlinear - focus is coming from a different branch, probably
+ * another toplevel.
+ * NotifyPointer - implicit focus because of the mouse position. This
+ * is only interesting on toplevels, when it means that the focus
+ * has been set to the root window but the mouse is over this
+ * toplevel. We take the focus implicitly (probably no window
+ * manager)
+ */
+
+ if ((eventPtr->xfocus.detail == NotifyVirtual)
+ || (eventPtr->xfocus.detail == NotifyNonlinearVirtual)
+ || (eventPtr->xfocus.detail == NotifyPointerRoot)
+ || (eventPtr->xfocus.detail == NotifyInferior)) {
+ return retValue;
+ }
+ } else if (eventPtr->type == FocusOut) {
+ /*
+ * Skip FocusOut events that cause confusion.
+ * NotifyPointer - the pointer is in us or a child, and we are losing
+ * focus because of an XSetInputFocus. Other focus events will
+ * set our state properly.
+ * NotifyPointerRoot - should never happen because this is sent to the
+ * root window.
+ * NotifyInferior - focus leaving us for an embedded child. We retain
+ * a notion of focus when an embedded child has focus.
+ *
+ * Interesting events are:
+ * NotifyAncestor - focus is going to root.
+ * NotifyNonlinear - focus is going to another branch, probably
+ * another toplevel.
+ * NotifyVirtual, NotifyNonlinearVirtual - focus is passing through,
+ * and we need to make sure we track this.
+ */
+
+ if ((eventPtr->xfocus.detail == NotifyPointer)
+ || (eventPtr->xfocus.detail == NotifyPointerRoot)
+ || (eventPtr->xfocus.detail == NotifyInferior)) {
+ return retValue;
+ }
+ } else {
+ retValue = 1;
+ if (eventPtr->xcrossing.detail == NotifyInferior) {
+ return retValue;
+ }
+ }
+
+ /*
+ * If winPtr isn't a top-level window than just ignore the event.
+ */
+
+ winPtr = TkWmFocusToplevel(winPtr);
+ if (winPtr == NULL) {
+ return retValue;
+ }
+
+ /*
+ * If there is a grab in effect and this window is outside the grabbed
+ * tree, then ignore the event.
+ */
+
+ if (TkGrabState(winPtr) == TK_GRAB_EXCLUDED) {
+ return retValue;
+ }
+
+ /*
+ * It is possible that there were outstanding FocusIn and FocusOut events
+ * on their way to us at the time the focus was changed internally with
+ * the "focus" command. If so, these events could potentially cause us to
+ * lose the focus (switch it to the window of the last FocusIn event) even
+ * though the focus change occurred after those events. The following code
+ * detects this and ignores the stale events.
+ *
+ * Note: the focusSerial is only generated by TkpChangeFocus, whereas in
+ * Tk 4.2 there was always a nop marker generated.
+ */
+
+ delta = eventPtr->xfocus.serial - displayFocusPtr->focusSerial;
+ if (delta < 0) {
+ return retValue;
+ }
+
+ /*
+ * Find the ToplevelFocusInfo structure for the window, and make a new one
+ * if there isn't one already.
+ */
+
+ for (tlFocusPtr = winPtr->mainPtr->tlFocusPtr; tlFocusPtr != NULL;
+ tlFocusPtr = tlFocusPtr->nextPtr) {
+ if (tlFocusPtr->topLevelPtr == winPtr) {
+ break;
+ }
+ }
+ if (tlFocusPtr == NULL) {
+ tlFocusPtr = ckalloc(sizeof(ToplevelFocusInfo));
+ tlFocusPtr->topLevelPtr = tlFocusPtr->focusWinPtr = winPtr;
+ tlFocusPtr->nextPtr = winPtr->mainPtr->tlFocusPtr;
+ winPtr->mainPtr->tlFocusPtr = tlFocusPtr;
+ }
+ newFocusPtr = tlFocusPtr->focusWinPtr;
+
+ /*
+ * Ignore event if newFocus window is already dead!
+ */
+
+ if (newFocusPtr->flags & TK_ALREADY_DEAD) {
+ return retValue;
+ }
+
+ if (eventPtr->type == FocusIn) {
+ GenerateFocusEvents(displayFocusPtr->focusWinPtr, newFocusPtr);
+ displayFocusPtr->focusWinPtr = newFocusPtr;
+ dispPtr->focusPtr = newFocusPtr;
+
+ /*
+ * NotifyPointer gets set when the focus has been set to the root
+ * window but we have the pointer. We'll treat this like an implicit
+ * focus in event so that upon Leave events we release focus.
+ */
+
+ if (!(winPtr->flags & TK_EMBEDDED)) {
+ if (eventPtr->xfocus.detail == NotifyPointer) {
+ dispPtr->implicitWinPtr = winPtr;
+ } else {
+ dispPtr->implicitWinPtr = NULL;
+ }
+ }
+ } else if (eventPtr->type == FocusOut) {
+ GenerateFocusEvents(displayFocusPtr->focusWinPtr, NULL);
+
+ /*
+ * Reset dispPtr->focusPtr, but only if it currently is the same as
+ * this application's focusWinPtr: this check is needed to handle
+ * embedded applications in the same process.
+ */
+
+ if (dispPtr->focusPtr == displayFocusPtr->focusWinPtr) {
+ dispPtr->focusPtr = NULL;
+ }
+ displayFocusPtr->focusWinPtr = NULL;
+ } else if (eventPtr->type == EnterNotify) {
+ /*
+ * If there is no window manager, or if the window manager isn't
+ * moving the focus around (e.g. the disgusting "NoTitleFocus" option
+ * has been selected in twm), then we won't get FocusIn or FocusOut
+ * events. Instead, the "focus" field will be set in an Enter event to
+ * indicate that we've already got the focus when the mouse enters the
+ * window (even though we didn't get a FocusIn event). Watch for this
+ * and grab the focus when it happens. Note: if this is an embedded
+ * application then don't accept the focus implicitly like this; the
+ * container application will give us the focus explicitly if it wants
+ * us to have it.
+ */
+
+ if (eventPtr->xcrossing.focus &&
+ (displayFocusPtr->focusWinPtr == NULL)
+ && !(winPtr->flags & TK_EMBEDDED)) {
+ DEBUG(dispPtr,
+ ("Focussed implicitly on %s\n", newFocusPtr->pathName));
+
+ GenerateFocusEvents(displayFocusPtr->focusWinPtr, newFocusPtr);
+ displayFocusPtr->focusWinPtr = newFocusPtr;
+ dispPtr->implicitWinPtr = winPtr;
+ dispPtr->focusPtr = newFocusPtr;
+ }
+ } else if (eventPtr->type == LeaveNotify) {
+ /*
+ * If the pointer just left a window for which we automatically
+ * claimed the focus on enter, move the focus back to the root window,
+ * where it was before we claimed it above. Note:
+ * dispPtr->implicitWinPtr may not be the same as
+ * displayFocusPtr->focusWinPtr (e.g. because the "focus" command was
+ * used to redirect the focus after it arrived at
+ * dispPtr->implicitWinPtr)!! In addition, we generate events because
+ * the window manager won't give us a FocusOut event when we focus on
+ * the root.
+ */
+
+ if ((dispPtr->implicitWinPtr != NULL)
+ && !(winPtr->flags & TK_EMBEDDED)) {
+ DEBUG(dispPtr, ("Defocussed implicit Async\n"));
+ GenerateFocusEvents(displayFocusPtr->focusWinPtr, NULL);
+ XSetInputFocus(dispPtr->display, PointerRoot, RevertToPointerRoot,
+ CurrentTime);
+ displayFocusPtr->focusWinPtr = NULL;
+ dispPtr->implicitWinPtr = NULL;
+ }
+ }
+ return retValue;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkSetFocusWin --
+ *
+ * This function is invoked to change the focus window for a given
+ * display in a given application.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Event handlers may be invoked to process the change of
+ * focus.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TkSetFocusWin(
+ TkWindow *winPtr, /* Window that is to be the new focus for its
+ * display and application. */
+ int force) /* If non-zero, set the X focus to this window
+ * even if the application doesn't currently
+ * have the X focus. */
+{
+ ToplevelFocusInfo *tlFocusPtr;
+ DisplayFocusInfo *displayFocusPtr;
+ TkWindow *topLevelPtr;
+ int allMapped, serial;
+
+ /*
+ * Don't set focus if window is already dead. [Bug 3574708]
+ */
+
+ if (winPtr->flags & TK_ALREADY_DEAD) {
+ return;
+ }
+
+ displayFocusPtr = FindDisplayFocusInfo(winPtr->mainPtr, winPtr->dispPtr);
+
+ /*
+ * If force is set, we should make sure we grab the focus regardless of
+ * the current focus window since under Windows, we may need to take
+ * control away from another application.
+ */
+
+ if (winPtr == displayFocusPtr->focusWinPtr && !force) {
+ return;
+ }
+
+ /*
+ * Find the top-level window for winPtr, then find (or create) a record
+ * for the top-level. Also see whether winPtr and all its ancestors are
+ * mapped.
+ */
+
+ allMapped = 1;
+ for (topLevelPtr = winPtr; ; topLevelPtr = topLevelPtr->parentPtr) {
+ if (topLevelPtr == NULL) {
+ /*
+ * The window is being deleted. No point in worrying about giving
+ * it the focus.
+ */
+
+ return;
+ }
+ if (!(topLevelPtr->flags & TK_MAPPED)) {
+ allMapped = 0;
+ }
+ if (topLevelPtr->flags & TK_TOP_HIERARCHY) {
+ break;
+ }
+ }
+
+ /*
+ * If the new focus window isn't mapped, then we can't focus on it (X will
+ * generate an error, for example). Instead, create an event handler that
+ * will set the focus to this window once it gets mapped. At the same
+ * time, delete any old handler that might be around; it's no longer
+ * relevant.
+ */
+
+ if (displayFocusPtr->focusOnMapPtr != NULL) {
+ Tk_DeleteEventHandler((Tk_Window) displayFocusPtr->focusOnMapPtr,
+ StructureNotifyMask, FocusMapProc,
+ displayFocusPtr->focusOnMapPtr);
+ displayFocusPtr->focusOnMapPtr = NULL;
+ }
+ if (!allMapped) {
+ Tk_CreateEventHandler((Tk_Window) winPtr, VisibilityChangeMask,
+ FocusMapProc, winPtr);
+ displayFocusPtr->focusOnMapPtr = winPtr;
+ displayFocusPtr->forceFocus = force;
+ return;
+ }
+
+ for (tlFocusPtr = winPtr->mainPtr->tlFocusPtr; tlFocusPtr != NULL;
+ tlFocusPtr = tlFocusPtr->nextPtr) {
+ if (tlFocusPtr->topLevelPtr == topLevelPtr) {
+ break;
+ }
+ }
+ if (tlFocusPtr == NULL) {
+ tlFocusPtr = ckalloc(sizeof(ToplevelFocusInfo));
+ tlFocusPtr->topLevelPtr = topLevelPtr;
+ tlFocusPtr->nextPtr = winPtr->mainPtr->tlFocusPtr;
+ winPtr->mainPtr->tlFocusPtr = tlFocusPtr;
+ }
+ tlFocusPtr->focusWinPtr = winPtr;
+
+ /*
+ * Reset the window system's focus window and generate focus events, with
+ * two special cases:
+ *
+ * 1. If the application is embedded and doesn't currently have the focus,
+ * don't set the focus directly. Instead, see if the embedding code can
+ * claim the focus from the enclosing container.
+ * 2. Otherwise, if the application doesn't currently have the focus,
+ * don't change the window system's focus unless it was already in this
+ * application or "force" was specified.
+ */
+
+ if ((topLevelPtr->flags & TK_EMBEDDED)
+ && (displayFocusPtr->focusWinPtr == NULL)) {
+ TkpClaimFocus(topLevelPtr, force);
+ } else if ((displayFocusPtr->focusWinPtr != NULL) || force) {
+ /*
+ * Generate events to shift focus between Tk windows. We do this
+ * regardless of what TkpChangeFocus does with the real X focus so
+ * that Tk widgets track focus commands when there is no window
+ * manager. GenerateFocusEvents will set up a serial number marker so
+ * we discard focus events that are triggered by the ChangeFocus.
+ */
+
+ serial = TkpChangeFocus(TkpGetWrapperWindow(topLevelPtr), force);
+ if (serial != 0) {
+ displayFocusPtr->focusSerial = serial;
+ }
+ GenerateFocusEvents(displayFocusPtr->focusWinPtr, winPtr);
+ displayFocusPtr->focusWinPtr = winPtr;
+ winPtr->dispPtr->focusPtr = winPtr;
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkGetFocusWin --
+ *
+ * Given a window, this function returns the current focus window for its
+ * application and display.
+ *
+ * Results:
+ * The return value is a pointer to the window that currently has the
+ * input focus for the specified application and display, or NULL if
+ * none.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+TkWindow *
+TkGetFocusWin(
+ TkWindow *winPtr) /* Window that selects an application and a
+ * display. */
+{
+ DisplayFocusInfo *displayFocusPtr;
+
+ if (winPtr == NULL) {
+ return NULL;
+ }
+
+ displayFocusPtr = FindDisplayFocusInfo(winPtr->mainPtr, winPtr->dispPtr);
+ return displayFocusPtr->focusWinPtr;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkFocusKeyEvent --
+ *
+ * Given a window and a key press or release event that arrived for the
+ * window, use information about the keyboard focus to compute which
+ * window should really get the event. In addition, update the event to
+ * refer to its new window.
+ *
+ * Results:
+ * The return value is a pointer to the window that has the input focus
+ * in winPtr's application, or NULL if winPtr's application doesn't have
+ * the input focus. If a non-NULL value is returned, eventPtr will be
+ * updated to refer properly to the focus window.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+TkWindow *
+TkFocusKeyEvent(
+ TkWindow *winPtr, /* Window that selects an application and a
+ * display. */
+ XEvent *eventPtr) /* X event to redirect (should be KeyPress or
+ * KeyRelease). */
+{
+ DisplayFocusInfo *displayFocusPtr;
+ TkWindow *focusWinPtr;
+ int focusX, focusY;
+
+ displayFocusPtr = FindDisplayFocusInfo(winPtr->mainPtr, winPtr->dispPtr);
+ focusWinPtr = displayFocusPtr->focusWinPtr;
+
+ /*
+ * The code below is a debugging aid to make sure that dispPtr->focusPtr
+ * is kept properly in sync with the "truth", which is the value in
+ * displayFocusPtr->focusWinPtr.
+ */
+
+#ifdef TCL_MEM_DEBUG
+ if (focusWinPtr != winPtr->dispPtr->focusPtr) {
+ printf("TkFocusKeyEvent found dispPtr->focusPtr out of sync:\n");
+ printf("expected %s, got %s\n",
+ (focusWinPtr != NULL) ? focusWinPtr->pathName : "??",
+ (winPtr->dispPtr->focusPtr != NULL) ?
+ winPtr->dispPtr->focusPtr->pathName : "??");
+ }
+#endif
+
+ if ((focusWinPtr != NULL) && (focusWinPtr->mainPtr == winPtr->mainPtr)) {
+ /*
+ * Map the x and y coordinates to make sense in the context of the
+ * focus window, if possible (make both -1 if the map-from and map-to
+ * windows don't share the same screen).
+ */
+
+ if ((focusWinPtr->display != winPtr->display)
+ || (focusWinPtr->screenNum != winPtr->screenNum)) {
+ eventPtr->xkey.x = -1;
+ eventPtr->xkey.y = -1;
+ } else {
+ Tk_GetRootCoords((Tk_Window) focusWinPtr, &focusX, &focusY);
+ eventPtr->xkey.x = eventPtr->xkey.x_root - focusX;
+ eventPtr->xkey.y = eventPtr->xkey.y_root - focusY;
+ }
+ eventPtr->xkey.window = focusWinPtr->window;
+ return focusWinPtr;
+ }
+
+ /*
+ * The event doesn't belong to us. Perhaps, due to embedding, it really
+ * belongs to someone else. Give the embedding code a chance to redirect
+ * the event.
+ */
+
+ TkpRedirectKeyEvent(winPtr, eventPtr);
+ return NULL;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkFocusDeadWindow --
+ *
+ * This function is invoked when it is determined that a window is dead.
+ * It cleans up focus-related information about the window.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Various things get cleaned up and recycled.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TkFocusDeadWindow(
+ register TkWindow *winPtr) /* Information about the window that is being
+ * deleted. */
+{
+ ToplevelFocusInfo *tlFocusPtr, *prevPtr;
+ DisplayFocusInfo *displayFocusPtr;
+ TkDisplay *dispPtr = winPtr->dispPtr;
+
+ /*
+ * Certain special windows like those used for send and clipboard have no
+ * mainPtr.
+ */
+
+ if (winPtr->mainPtr == NULL) {
+ return;
+ }
+
+ /*
+ * Search for focus records that refer to this window either as the
+ * top-level window or the current focus window.
+ */
+
+ displayFocusPtr = FindDisplayFocusInfo(winPtr->mainPtr, winPtr->dispPtr);
+ for (prevPtr = NULL, tlFocusPtr = winPtr->mainPtr->tlFocusPtr;
+ tlFocusPtr != NULL;
+ prevPtr = tlFocusPtr, tlFocusPtr = tlFocusPtr->nextPtr) {
+ if (winPtr == tlFocusPtr->topLevelPtr) {
+ /*
+ * The top-level window is the one being deleted: free the focus
+ * record and release the focus back to PointerRoot if we acquired
+ * it implicitly.
+ */
+
+ if (dispPtr->implicitWinPtr == winPtr) {
+ DEBUG(dispPtr, ("releasing focus to root after %s died\n",
+ tlFocusPtr->topLevelPtr->pathName));
+ dispPtr->implicitWinPtr = NULL;
+ displayFocusPtr->focusWinPtr = NULL;
+ dispPtr->focusPtr = NULL;
+ }
+ if (displayFocusPtr->focusWinPtr == tlFocusPtr->focusWinPtr) {
+ displayFocusPtr->focusWinPtr = NULL;
+ dispPtr->focusPtr = NULL;
+ }
+ if (prevPtr == NULL) {
+ winPtr->mainPtr->tlFocusPtr = tlFocusPtr->nextPtr;
+ } else {
+ prevPtr->nextPtr = tlFocusPtr->nextPtr;
+ }
+ ckfree(tlFocusPtr);
+ break;
+ } else if (winPtr == tlFocusPtr->focusWinPtr) {
+ /*
+ * The deleted window had the focus for its top-level: move the
+ * focus to the top-level itself.
+ */
+
+ tlFocusPtr->focusWinPtr = tlFocusPtr->topLevelPtr;
+ if ((displayFocusPtr->focusWinPtr == winPtr)
+ && !(tlFocusPtr->topLevelPtr->flags & TK_ALREADY_DEAD)) {
+ DEBUG(dispPtr, ("forwarding focus to %s after %s died\n",
+ tlFocusPtr->topLevelPtr->pathName, winPtr->pathName));
+ GenerateFocusEvents(displayFocusPtr->focusWinPtr,
+ tlFocusPtr->topLevelPtr);
+ displayFocusPtr->focusWinPtr = tlFocusPtr->topLevelPtr;
+ dispPtr->focusPtr = tlFocusPtr->topLevelPtr;
+ }
+ break;
+ }
+ }
+
+ /*
+ * Occasionally, things can become unsynchronized. Move them back into
+ * synch now. [Bug 2496114]
+ */
+
+ if (displayFocusPtr->focusWinPtr == winPtr) {
+ DEBUG(dispPtr, ("focus cleared after %s died\n", winPtr->pathName));
+ displayFocusPtr->focusWinPtr = NULL;
+ }
+
+ if (displayFocusPtr->focusOnMapPtr == winPtr) {
+ displayFocusPtr->focusOnMapPtr = NULL;
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * GenerateFocusEvents --
+ *
+ * This function is called to create FocusIn and FocusOut events to move
+ * the input focus from one window to another.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * FocusIn and FocusOut events are generated.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+GenerateFocusEvents(
+ TkWindow *sourcePtr, /* Window that used to have the focus (may be
+ * NULL). */
+ TkWindow *destPtr) /* New window to have the focus (may be
+ * NULL). */
+{
+ XEvent event;
+ TkWindow *winPtr;
+
+ winPtr = sourcePtr;
+ if (winPtr == NULL) {
+ winPtr = destPtr;
+ if (winPtr == NULL) {
+ return;
+ }
+ }
+
+ event.xfocus.serial = LastKnownRequestProcessed(winPtr->display);
+ event.xfocus.send_event = GENERATED_FOCUS_EVENT_MAGIC;
+ event.xfocus.display = winPtr->display;
+ event.xfocus.mode = NotifyNormal;
+ TkInOutEvents(&event, sourcePtr, destPtr, FocusOut, FocusIn,
+ TCL_QUEUE_MARK);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * FocusMapProc --
+ *
+ * This function is called as an event handler for VisibilityNotify
+ * events, if a window receives the focus at a time when its toplevel
+ * isn't mapped. The function is needed because X won't allow the focus
+ * to be set to an unmapped window; we detect when the toplevel is mapped
+ * and set the focus to it then.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * If this is a map event, the focus gets set to the toplevel given by
+ * clientData.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+FocusMapProc(
+ ClientData clientData, /* Toplevel window. */
+ XEvent *eventPtr) /* Information about event. */
+{
+ TkWindow *winPtr = clientData;
+ DisplayFocusInfo *displayFocusPtr;
+
+ if (eventPtr->type == VisibilityNotify) {
+ displayFocusPtr = FindDisplayFocusInfo(winPtr->mainPtr,
+ winPtr->dispPtr);
+ DEBUG(winPtr->dispPtr, ("auto-focussing on %s, force %d\n",
+ winPtr->pathName, displayFocusPtr->forceFocus));
+ Tk_DeleteEventHandler((Tk_Window) winPtr, VisibilityChangeMask,
+ FocusMapProc, clientData);
+ displayFocusPtr->focusOnMapPtr = NULL;
+ TkSetFocusWin(winPtr, displayFocusPtr->forceFocus);
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * FindDisplayFocusInfo --
+ *
+ * Given an application and a display, this function locate the focus
+ * record for that combination. If no such record exists, it creates a
+ * new record and initializes it.
+ *
+ * Results:
+ * The return value is a pointer to the record.
+ *
+ * Side effects:
+ * A new record will be allocated if there wasn't one already.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static DisplayFocusInfo *
+FindDisplayFocusInfo(
+ TkMainInfo *mainPtr, /* Record that identifies a particular
+ * application. */
+ TkDisplay *dispPtr) /* Display whose focus information is
+ * needed. */
+{
+ DisplayFocusInfo *displayFocusPtr;
+
+ for (displayFocusPtr = mainPtr->displayFocusPtr;
+ displayFocusPtr != NULL;
+ displayFocusPtr = displayFocusPtr->nextPtr) {
+ if (displayFocusPtr->dispPtr == dispPtr) {
+ return displayFocusPtr;
+ }
+ }
+
+ /*
+ * The record doesn't exist yet. Make a new one.
+ */
+
+ displayFocusPtr = ckalloc(sizeof(DisplayFocusInfo));
+ displayFocusPtr->dispPtr = dispPtr;
+ displayFocusPtr->focusWinPtr = NULL;
+ displayFocusPtr->focusOnMapPtr = NULL;
+ displayFocusPtr->forceFocus = 0;
+ displayFocusPtr->focusSerial = 0;
+ displayFocusPtr->nextPtr = mainPtr->displayFocusPtr;
+ mainPtr->displayFocusPtr = displayFocusPtr;
+ return displayFocusPtr;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkFocusFree --
+ *
+ * Free resources associated with maintaining the focus.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * This mainPtr should no long access focus information.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TkFocusFree(
+ TkMainInfo *mainPtr) /* Record that identifies a particular
+ * application. */
+{
+ while (mainPtr->displayFocusPtr != NULL) {
+ DisplayFocusInfo *displayFocusPtr = mainPtr->displayFocusPtr;
+
+ mainPtr->displayFocusPtr = mainPtr->displayFocusPtr->nextPtr;
+ ckfree(displayFocusPtr);
+ }
+ while (mainPtr->tlFocusPtr != NULL) {
+ ToplevelFocusInfo *tlFocusPtr = mainPtr->tlFocusPtr;
+
+ mainPtr->tlFocusPtr = mainPtr->tlFocusPtr->nextPtr;
+ ckfree(tlFocusPtr);
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkFocusSplit --
+ *
+ * Adjust focus window for a newly managed toplevel, thus splitting the
+ * toplevel into two toplevels.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * A new record is allocated for the new toplevel window.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TkFocusSplit(
+ TkWindow *winPtr) /* Window is the new toplevel. Any focus point
+ * at or below window must be moved to this
+ * new toplevel. */
+{
+ ToplevelFocusInfo *tlFocusPtr;
+ TkWindow *topLevelPtr, *subWinPtr;
+
+ FindDisplayFocusInfo(winPtr->mainPtr, winPtr->dispPtr);
+
+ /*
+ * Find the top-level window for winPtr, then find (or create) a record
+ * for the top-level. Also see whether winPtr and all its ancestors are
+ * mapped.
+ */
+
+ for (topLevelPtr = winPtr; ; topLevelPtr = topLevelPtr->parentPtr) {
+ if (topLevelPtr == NULL) {
+ /*
+ * The window is being deleted. No point in worrying about giving
+ * it the focus.
+ */
+
+ return;
+ }
+ if (topLevelPtr->flags & TK_TOP_HIERARCHY) {
+ break;
+ }
+ }
+
+ /*
+ * Search all focus records to find child windows of winPtr.
+ */
+
+ for (tlFocusPtr = winPtr->mainPtr->tlFocusPtr; tlFocusPtr != NULL;
+ tlFocusPtr = tlFocusPtr->nextPtr) {
+ if (tlFocusPtr->topLevelPtr == topLevelPtr) {
+ break;
+ }
+ }
+
+ if (tlFocusPtr == NULL) {
+ /*
+ * No focus record for this toplevel, nothing to do.
+ */
+
+ return;
+ }
+
+ /*
+ * See if current focusWin is child of the new toplevel.
+ */
+
+ for (subWinPtr = tlFocusPtr->focusWinPtr;
+ subWinPtr && subWinPtr != winPtr && subWinPtr != topLevelPtr;
+ subWinPtr = subWinPtr->parentPtr) {
+ /* EMPTY */
+ }
+
+ if (subWinPtr == winPtr) {
+ /*
+ * Move focus to new toplevel.
+ */
+
+ ToplevelFocusInfo *newTlFocusPtr = ckalloc(sizeof(ToplevelFocusInfo));
+
+ newTlFocusPtr->topLevelPtr = winPtr;
+ newTlFocusPtr->focusWinPtr = tlFocusPtr->focusWinPtr;
+ newTlFocusPtr->nextPtr = winPtr->mainPtr->tlFocusPtr;
+ winPtr->mainPtr->tlFocusPtr = newTlFocusPtr;
+
+ /*
+ * Move old toplevel's focus to the toplevel itself.
+ */
+
+ tlFocusPtr->focusWinPtr = topLevelPtr;
+ }
+
+ /*
+ * If it's not, then let focus progress naturally.
+ */
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkFocusJoin --
+ *
+ * Remove the focus record for this window that is nolonger managed
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * A tlFocusPtr record is removed
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TkFocusJoin(
+ TkWindow *winPtr) /* Window is no longer a toplevel. */
+{
+ ToplevelFocusInfo *tlFocusPtr, *tmpPtr;
+
+ /*
+ * Remove old toplevel record
+ */
+
+ if (winPtr && winPtr->mainPtr && winPtr->mainPtr->tlFocusPtr
+ && winPtr->mainPtr->tlFocusPtr->topLevelPtr == winPtr) {
+ tmpPtr = winPtr->mainPtr->tlFocusPtr;
+ winPtr->mainPtr->tlFocusPtr = tmpPtr->nextPtr;
+ ckfree(tmpPtr);
+ } else if (winPtr && winPtr->mainPtr) {
+ for (tlFocusPtr = winPtr->mainPtr->tlFocusPtr; tlFocusPtr != NULL;
+ tlFocusPtr = tlFocusPtr->nextPtr) {
+ if (tlFocusPtr->nextPtr &&
+ tlFocusPtr->nextPtr->topLevelPtr == winPtr) {
+ tmpPtr = tlFocusPtr->nextPtr;
+ tlFocusPtr->nextPtr = tmpPtr->nextPtr;
+ ckfree(tmpPtr);
+ break;
+ }
+ }
+ }
+}
+
+/*
+ * Local Variables:
+ * mode: c
+ * c-basic-offset: 4
+ * fill-column: 78
+ * End:
+ */
diff --git a/tk8.6/generic/tkFont.c b/tk8.6/generic/tkFont.c
new file mode 100644
index 0000000..102fc6e
--- /dev/null
+++ b/tk8.6/generic/tkFont.c
@@ -0,0 +1,4255 @@
+/*
+ * tkFont.c --
+ *
+ * This file maintains a database of fonts for the Tk toolkit. It also
+ * provides several utility functions for measuring and displaying text.
+ *
+ * Copyright (c) 1990-1994 The Regents of the University of California.
+ * Copyright (c) 1994-1998 Sun Microsystems, Inc.
+ *
+ * See the file "license.terms" for information on usage and redistribution of
+ * this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ */
+
+#include "tkInt.h"
+#include "tkFont.h"
+
+/*
+ * The following structure is used to keep track of all the fonts that exist
+ * in the current application. It must be stored in the TkMainInfo for the
+ * application.
+ */
+
+typedef struct TkFontInfo {
+ Tcl_HashTable fontCache; /* Map a string to an existing Tk_Font. Keys
+ * are string font names, values are TkFont
+ * pointers. */
+ Tcl_HashTable namedTable; /* Map a name to a set of attributes for a
+ * font, used when constructing a Tk_Font from
+ * a named font description. Keys are strings,
+ * values are NamedFont pointers. */
+ TkMainInfo *mainPtr; /* Application that owns this structure. */
+ int updatePending; /* Non-zero when a World Changed event has
+ * already been queued to handle a change to a
+ * named font. */
+} TkFontInfo;
+
+/*
+ * The following data structure is used to keep track of the font attributes
+ * for each named font that has been defined. The named font is only deleted
+ * when the last reference to it goes away.
+ */
+
+typedef struct NamedFont {
+ int refCount; /* Number of users of named font. */
+ int deletePending; /* Non-zero if font should be deleted when
+ * last reference goes away. */
+ TkFontAttributes fa; /* Desired attributes for named font. */
+} NamedFont;
+
+/*
+ * The following two structures are used to keep track of string measurement
+ * information when using the text layout facilities.
+ *
+ * A LayoutChunk represents a contiguous range of text that can be measured
+ * and displayed by low-level text calls. In general, chunks will be delimited
+ * by newlines and tabs. Low-level, platform-specific things like kerning and
+ * non-integer character widths may occur between the characters in a single
+ * chunk, but not between characters in different chunks.
+ *
+ * A TextLayout is a collection of LayoutChunks. It can be displayed with
+ * respect to any origin. It is the implementation of the Tk_TextLayout opaque
+ * token.
+ */
+
+typedef struct LayoutChunk {
+ const char *start; /* Pointer to simple string to be displayed.
+ * This is a pointer into the TkTextLayout's
+ * string. */
+ int numBytes; /* The number of bytes in this chunk. */
+ int numChars; /* The number of characters in this chunk. */
+ int numDisplayChars; /* The number of characters to display when
+ * this chunk is displayed. Can be less than
+ * numChars if extra space characters were
+ * absorbed by the end of the chunk. This will
+ * be < 0 if this is a chunk that is holding a
+ * tab or newline. */
+ int x, y; /* The origin of the first character in this
+ * chunk with respect to the upper-left hand
+ * corner of the TextLayout. */
+ int totalWidth; /* Width in pixels of this chunk. Used when
+ * hit testing the invisible spaces at the end
+ * of a chunk. */
+ int displayWidth; /* Width in pixels of the displayable
+ * characters in this chunk. Can be less than
+ * width if extra space characters were
+ * absorbed by the end of the chunk. */
+} LayoutChunk;
+
+typedef struct TextLayout {
+ Tk_Font tkfont; /* The font used when laying out the text. */
+ const char *string; /* The string that was layed out. */
+ int width; /* The maximum width of all lines in the text
+ * layout. */
+ int numChunks; /* Number of chunks actually used in following
+ * array. */
+ LayoutChunk chunks[1]; /* Array of chunks. The actual size will be
+ * maxChunks. THIS FIELD MUST BE THE LAST IN
+ * THE STRUCTURE. */
+} TextLayout;
+
+/*
+ * The following structures are used as two-way maps between the values for
+ * the fields in the TkFontAttributes structure and the strings used in Tcl,
+ * when parsing both option-value format and style-list format font name
+ * strings.
+ */
+
+static const TkStateMap weightMap[] = {
+ {TK_FW_NORMAL, "normal"},
+ {TK_FW_BOLD, "bold"},
+ {TK_FW_UNKNOWN, NULL}
+};
+
+static const TkStateMap slantMap[] = {
+ {TK_FS_ROMAN, "roman"},
+ {TK_FS_ITALIC, "italic"},
+ {TK_FS_UNKNOWN, NULL}
+};
+
+static const TkStateMap underlineMap[] = {
+ {1, "underline"},
+ {0, NULL}
+};
+
+static const TkStateMap overstrikeMap[] = {
+ {1, "overstrike"},
+ {0, NULL}
+};
+
+/*
+ * The following structures are used when parsing XLFD's into a set of
+ * TkFontAttributes.
+ */
+
+static const TkStateMap xlfdWeightMap[] = {
+ {TK_FW_NORMAL, "normal"},
+ {TK_FW_NORMAL, "medium"},
+ {TK_FW_NORMAL, "book"},
+ {TK_FW_NORMAL, "light"},
+ {TK_FW_BOLD, "bold"},
+ {TK_FW_BOLD, "demi"},
+ {TK_FW_BOLD, "demibold"},
+ {TK_FW_NORMAL, NULL} /* Assume anything else is "normal". */
+};
+
+static const TkStateMap xlfdSlantMap[] = {
+ {TK_FS_ROMAN, "r"},
+ {TK_FS_ITALIC, "i"},
+ {TK_FS_OBLIQUE, "o"},
+ {TK_FS_ROMAN, NULL} /* Assume anything else is "roman". */
+};
+
+static const TkStateMap xlfdSetwidthMap[] = {
+ {TK_SW_NORMAL, "normal"},
+ {TK_SW_CONDENSE, "narrow"},
+ {TK_SW_CONDENSE, "semicondensed"},
+ {TK_SW_CONDENSE, "condensed"},
+ {TK_SW_UNKNOWN, NULL}
+};
+
+/*
+ * The following structure and defines specify the valid builtin options when
+ * configuring a set of font attributes.
+ */
+
+static const char *const fontOpt[] = {
+ "-family",
+ "-size",
+ "-weight",
+ "-slant",
+ "-underline",
+ "-overstrike",
+ NULL
+};
+
+#define FONT_FAMILY 0
+#define FONT_SIZE 1
+#define FONT_WEIGHT 2
+#define FONT_SLANT 3
+#define FONT_UNDERLINE 4
+#define FONT_OVERSTRIKE 5
+#define FONT_NUMFIELDS 6
+
+/*
+ * Hardcoded font aliases. These are used to describe (mostly) identical fonts
+ * whose names differ from platform to platform. If the user-supplied font
+ * name matches any of the names in one of the alias lists, the other names in
+ * the alias list are also automatically tried.
+ */
+
+static const char *const timesAliases[] = {
+ "Times", /* Unix. */
+ "Times New Roman", /* Windows. */
+ "New York", /* Mac. */
+ NULL
+};
+
+static const char *const helveticaAliases[] = {
+ "Helvetica", /* Unix. */
+ "Arial", /* Windows. */
+ "Geneva", /* Mac. */
+ NULL
+};
+
+static const char *const courierAliases[] = {
+ "Courier", /* Unix and Mac. */
+ "Courier New", /* Windows. */
+ NULL
+};
+
+static const char *const 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 const char *const 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 const char *const dingbatsAliases[] = {
+ "dingbats", "zapfdingbats", "itc zapfdingbats",
+ /* Unix. */
+ /* Windows. */
+ "zapf dingbats", /* Mac. */
+ NULL
+};
+
+static const char *const *const 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 const char *const systemClass[] = {
+ "fixed", /* Unix. */
+ /* Windows. */
+ "chicago", "osaka", "sistemny",
+ /* Mac. */
+ NULL
+};
+
+static const char *const serifClass[] = {
+ "times", "palatino", "mincho",
+ /* All platforms. */
+ "song ti", /* Unix. */
+ "ms serif", "simplified arabic",
+ /* Windows. */
+ "latinski", /* Mac. */
+ NULL
+};
+
+static const char *const sansClass[] = {
+ "helvetica", "gothic", /* All platforms. */
+ /* Unix. */
+ "ms sans serif", "traditional arabic",
+ /* Windows. */
+ "bastion", /* Mac. */
+ NULL
+};
+
+static const char *const monoClass[] = {
+ "courier", "gothic", /* All platforms. */
+ "fangsong ti", /* Unix. */
+ "simplified arabic fixed", /* Windows. */
+ "monaco", "pryamoy", /* Mac. */
+ NULL
+};
+
+static const char *const symbolClass[] = {
+ "symbol", "dingbats", "wingdings", NULL
+};
+
+static const char *const *const 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 const char *const globalFontClass[] = {
+ "symbol", /* All platforms. */
+ /* Unix. */
+ "lucida sans unicode", /* Windows. */
+ "bitstream cyberbit", /* Windows popular CJK font */
+ "chicago", /* Mac. */
+ NULL
+};
+
+#define GetFontAttributes(tkfont) \
+ ((const TkFontAttributes *) &((TkFont *) (tkfont))->fa)
+
+#define GetFontMetrics(tkfont) \
+ ((const TkFontMetrics *) &((TkFont *) (tkfont))->fm)
+
+
+static int ConfigAttributesObj(Tcl_Interp *interp,
+ Tk_Window tkwin, int objc, Tcl_Obj *const objv[],
+ TkFontAttributes *faPtr);
+static void DupFontObjProc(Tcl_Obj *srcObjPtr, Tcl_Obj *dupObjPtr);
+static int FieldSpecified(const char *field);
+static void FreeFontObj(Tcl_Obj *objPtr);
+static void FreeFontObjProc(Tcl_Obj *objPtr);
+static int GetAttributeInfoObj(Tcl_Interp *interp,
+ const TkFontAttributes *faPtr, Tcl_Obj *objPtr);
+static LayoutChunk * NewChunk(TextLayout **layoutPtrPtr, int *maxPtr,
+ const char *start, int numChars, int curX,
+ int newX, int y);
+static int ParseFontNameObj(Tcl_Interp *interp, Tk_Window tkwin,
+ Tcl_Obj *objPtr, TkFontAttributes *faPtr);
+static void RecomputeWidgets(TkWindow *winPtr);
+static int SetFontFromAny(Tcl_Interp *interp, Tcl_Obj *objPtr);
+static void TheWorldHasChanged(ClientData clientData);
+static void UpdateDependentFonts(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.
+ */
+
+const Tcl_ObjType tkFontObjType = {
+ "font", /* name */
+ FreeFontObjProc, /* freeIntRepProc */
+ DupFontObjProc, /* dupIntRepProc */
+ NULL, /* updateStringProc */
+ SetFontFromAny /* setFromAnyProc */
+};
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * TkFontPkgInit --
+ *
+ * This function is called when an application is created. It initializes
+ * all the structures that are used by the font package on a per
+ * application basis.
+ *
+ * Results:
+ * Stores a token in the mainPtr to hold information needed by this
+ * package on a per application basis.
+ *
+ * Side effects:
+ * Memory allocated.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+void
+TkFontPkgInit(
+ TkMainInfo *mainPtr) /* The application being created. */
+{
+ TkFontInfo *fiPtr = ckalloc(sizeof(TkFontInfo));
+
+ Tcl_InitHashTable(&fiPtr->fontCache, TCL_STRING_KEYS);
+ Tcl_InitHashTable(&fiPtr->namedTable, TCL_STRING_KEYS);
+ fiPtr->mainPtr = mainPtr;
+ fiPtr->updatePending = 0;
+ mainPtr->fontInfoPtr = fiPtr;
+
+ TkpFontPkgInit(mainPtr);
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * TkFontPkgFree --
+ *
+ * This function is called when an application is deleted. It deletes all
+ * the structures that were used by the font package for this
+ * application.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Memory freed.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+void
+TkFontPkgFree(
+ TkMainInfo *mainPtr) /* The application being deleted. */
+{
+ TkFontInfo *fiPtr = mainPtr->fontInfoPtr;
+ Tcl_HashEntry *hPtr, *searchPtr;
+ Tcl_HashSearch search;
+ int fontsLeft = 0;
+
+ for (searchPtr = Tcl_FirstHashEntry(&fiPtr->fontCache, &search);
+ searchPtr != NULL;
+ searchPtr = Tcl_NextHashEntry(&search)) {
+ fontsLeft++;
+#ifdef DEBUG_FONTS
+ fprintf(stderr, "Font %s still in cache.\n",
+ (char *) Tcl_GetHashKey(&fiPtr->fontCache, searchPtr));
+#endif
+ }
+
+#ifdef PURIFY
+ if (fontsLeft) {
+ Tcl_Panic("TkFontPkgFree: all fonts should have been freed already");
+ }
+#endif
+
+ Tcl_DeleteHashTable(&fiPtr->fontCache);
+
+ hPtr = Tcl_FirstHashEntry(&fiPtr->namedTable, &search);
+ while (hPtr != NULL) {
+ ckfree(Tcl_GetHashValue(hPtr));
+ hPtr = Tcl_NextHashEntry(&search);
+ }
+ Tcl_DeleteHashTable(&fiPtr->namedTable);
+ if (fiPtr->updatePending) {
+ Tcl_CancelIdleCall(TheWorldHasChanged, fiPtr);
+ }
+ ckfree(fiPtr);
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * Tk_FontObjCmd --
+ *
+ * This function is implemented to process the "font" Tcl command. See
+ * the user documentation for details on what it does.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * See the user documentation.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tk_FontObjCmd(
+ ClientData clientData, /* Main window associated with interpreter. */
+ Tcl_Interp *interp, /* Current interpreter. */
+ int objc, /* Number of arguments. */
+ Tcl_Obj *const objv[]) /* Argument objects. */
+{
+ int index;
+ Tk_Window tkwin = clientData;
+ TkFontInfo *fiPtr = ((TkWindow *) tkwin)->mainPtr->fontInfoPtr;
+ static const char *const optionStrings[] = {
+ "actual", "configure", "create", "delete",
+ "families", "measure", "metrics", "names",
+ NULL
+ };
+ enum options {
+ FONT_ACTUAL, FONT_CONFIGURE, FONT_CREATE, FONT_DELETE,
+ FONT_FAMILIES, FONT_MEASURE, FONT_METRICS, FONT_NAMES
+ };
+
+ if (objc < 2) {
+ Tcl_WrongNumArgs(interp, 1, objv, "option ?arg?");
+ return TCL_ERROR;
+ }
+ if (Tcl_GetIndexFromObj(interp, objv[1], optionStrings, "option", 0,
+ &index) != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ switch ((enum options) index) {
+ case FONT_ACTUAL: {
+ int skip, result, n;
+ const char *s;
+ Tk_Font tkfont;
+ Tcl_Obj *optPtr, *charPtr, *resultPtr;
+ Tcl_UniChar uniChar = 0;
+ const TkFontAttributes *faPtr;
+ TkFontAttributes fa;
+
+ /*
+ * Params 0 and 1 are 'font actual'. Param 2 is the font name. 3-4 may
+ * be '-displayof $window'
+ */
+
+ skip = TkGetDisplayOf(interp, objc - 3, objv + 3, &tkwin);
+ if (skip < 0) {
+ return TCL_ERROR;
+ }
+
+ /*
+ * Next parameter may be an option.
+ */
+
+ n = skip + 3;
+ optPtr = NULL;
+ charPtr = NULL;
+ if (n < objc) {
+ s = Tcl_GetString(objv[n]);
+ if (s[0] == '-' && s[1] != '-') {
+ optPtr = objv[n];
+ n++;
+ } else {
+ optPtr = NULL;
+ }
+ }
+
+ /*
+ * Next parameter may be '--' to mark end of options.
+ */
+
+ if (n < objc) {
+ if (!strcmp(Tcl_GetString(objv[n]), "--")) {
+ n++;
+ }
+ }
+
+ /*
+ * Next parameter is the character to get font information for.
+ */
+
+ if (n < objc) {
+ charPtr = objv[n];
+ n++;
+ }
+
+ /*
+ * If there were fewer than 3 args, or args remain, that's an error.
+ */
+
+ if (objc < 3 || n < objc) {
+ Tcl_WrongNumArgs(interp, 2, objv,
+ "font ?-displayof window? ?option? ?--? ?char?");
+ return TCL_ERROR;
+ }
+
+ /*
+ * The 'charPtr' arg must be a single Unicode.
+ */
+
+ if (charPtr != NULL) {
+ if (Tcl_GetCharLength(charPtr) != 1) {
+ resultPtr = Tcl_NewStringObj(
+ "expected a single character but got \"", -1);
+ Tcl_AppendLimitedToObj(resultPtr, Tcl_GetString(charPtr),
+ -1, 40, "...");
+ Tcl_AppendToObj(resultPtr, "\"", -1);
+ Tcl_SetObjResult(interp, resultPtr);
+ Tcl_SetErrorCode(interp, "TK", "VALUE", "FONT_SAMPLE", NULL);
+ return TCL_ERROR;
+ }
+ uniChar = Tcl_GetUniChar(charPtr, 0);
+ }
+
+ /*
+ * Find the font.
+ */
+
+ tkfont = Tk_AllocFontFromObj(interp, tkwin, objv[2]);
+ if (tkfont == NULL) {
+ return TCL_ERROR;
+ }
+
+ /*
+ * Determine the font attributes.
+ */
+
+ if (charPtr == NULL) {
+ faPtr = GetFontAttributes(tkfont);
+ } else {
+ TkpGetFontAttrsForChar(tkwin, tkfont, uniChar, &fa);
+ faPtr = &fa;
+ }
+ result = GetAttributeInfoObj(interp, faPtr, optPtr);
+
+ Tk_FreeFont(tkfont);
+ return result;
+ }
+ case FONT_CONFIGURE: {
+ int result;
+ const char *string;
+ Tcl_Obj *objPtr;
+ NamedFont *nfPtr;
+ Tcl_HashEntry *namedHashPtr;
+
+ if (objc < 3) {
+ Tcl_WrongNumArgs(interp, 2, objv, "fontname ?-option value ...?");
+ return TCL_ERROR;
+ }
+ string = Tcl_GetString(objv[2]);
+ namedHashPtr = Tcl_FindHashEntry(&fiPtr->namedTable, string);
+ nfPtr = NULL; /* lint. */
+ if (namedHashPtr != NULL) {
+ nfPtr = Tcl_GetHashValue(namedHashPtr);
+ }
+ if ((namedHashPtr == NULL) || nfPtr->deletePending) {
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "named font \"%s\" doesn't exist", string));
+ Tcl_SetErrorCode(interp, "TK", "LOOKUP", "FONT", string, NULL);
+ return TCL_ERROR;
+ }
+ if (objc == 3) {
+ objPtr = NULL;
+ } else if (objc == 4) {
+ objPtr = objv[3];
+ } else {
+ result = ConfigAttributesObj(interp, tkwin, objc - 3, objv + 3,
+ &nfPtr->fa);
+ UpdateDependentFonts(fiPtr, tkwin, namedHashPtr);
+ return result;
+ }
+ return GetAttributeInfoObj(interp, &nfPtr->fa, objPtr);
+ }
+ case FONT_CREATE: {
+ int skip = 3, i;
+ const char *name;
+ char buf[16 + TCL_INTEGER_SPACE];
+ TkFontAttributes fa;
+ Tcl_HashEntry *namedHashPtr;
+
+ if (objc < 3) {
+ name = NULL;
+ } else {
+ name = Tcl_GetString(objv[2]);
+ if (name[0] == '-') {
+ name = NULL;
+ }
+ }
+ if (name == NULL) {
+ /*
+ * No font name specified. Generate one of the form "fontX".
+ */
+
+ for (i = 1; ; i++) {
+ sprintf(buf, "font%d", i);
+ namedHashPtr = Tcl_FindHashEntry(&fiPtr->namedTable, buf);
+ if (namedHashPtr == NULL) {
+ break;
+ }
+ }
+ name = buf;
+ skip = 2;
+ }
+ TkInitFontAttributes(&fa);
+ if (ConfigAttributesObj(interp, tkwin, objc - skip, objv + skip,
+ &fa) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (TkCreateNamedFont(interp, tkwin, name, &fa) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(name, -1));
+ break;
+ }
+ case FONT_DELETE: {
+ int i, result = TCL_OK;
+ const char *string;
+
+ /*
+ * Delete the named font. If there are still widgets using this font,
+ * then it isn't deleted right away.
+ */
+
+ if (objc < 3) {
+ Tcl_WrongNumArgs(interp, 2, objv, "fontname ?fontname ...?");
+ return TCL_ERROR;
+ }
+ for (i = 2; (i < objc) && (result == TCL_OK); i++) {
+ string = Tcl_GetString(objv[i]);
+ result = TkDeleteNamedFont(interp, tkwin, string);
+ }
+ return result;
+ }
+ case FONT_FAMILIES: {
+ int skip = TkGetDisplayOf(interp, objc - 2, objv + 2, &tkwin);
+
+ if (skip < 0) {
+ return TCL_ERROR;
+ }
+ if (objc - skip != 2) {
+ Tcl_WrongNumArgs(interp, 2, objv, "?-displayof window?");
+ return TCL_ERROR;
+ }
+ TkpGetFontFamilies(interp, tkwin);
+ break;
+ }
+ case FONT_MEASURE: {
+ const char *string;
+ Tk_Font tkfont;
+ int length = 0, skip = 0;
+
+ if (objc > 4) {
+ skip = TkGetDisplayOf(interp, objc - 3, objv + 3, &tkwin);
+ if (skip < 0) {
+ return TCL_ERROR;
+ }
+ }
+ if (objc - skip != 4) {
+ Tcl_WrongNumArgs(interp, 2, objv,
+ "font ?-displayof window? text");
+ return TCL_ERROR;
+ }
+ tkfont = Tk_AllocFontFromObj(interp, tkwin, objv[2]);
+ if (tkfont == NULL) {
+ return TCL_ERROR;
+ }
+ string = Tcl_GetStringFromObj(objv[3 + skip], &length);
+ Tcl_SetObjResult(interp, Tcl_NewIntObj(
+ Tk_TextWidth(tkfont, string, length)));
+ Tk_FreeFont(tkfont);
+ break;
+ }
+ case FONT_METRICS: {
+ Tk_Font tkfont;
+ int skip, index, i;
+ const TkFontMetrics *fmPtr;
+ static const char *const switches[] = {
+ "-ascent", "-descent", "-linespace", "-fixed", NULL
+ };
+
+ skip = TkGetDisplayOf(interp, objc - 3, objv + 3, &tkwin);
+ if (skip < 0) {
+ return TCL_ERROR;
+ }
+ if ((objc < 3) || ((objc - skip) > 4)) {
+ Tcl_WrongNumArgs(interp, 2, objv,
+ "font ?-displayof window? ?option?");
+ return TCL_ERROR;
+ }
+ tkfont = Tk_AllocFontFromObj(interp, tkwin, objv[2]);
+ if (tkfont == NULL) {
+ return TCL_ERROR;
+ }
+ objc -= skip;
+ objv += skip;
+ fmPtr = GetFontMetrics(tkfont);
+ if (objc == 3) {
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "-ascent %d -descent %d -linespace %d -fixed %d",
+ fmPtr->ascent, fmPtr->descent,
+ fmPtr->ascent + fmPtr->descent, fmPtr->fixed));
+ } else {
+ if (Tcl_GetIndexFromObj(interp, objv[3], switches, "metric", 0,
+ &index) != TCL_OK) {
+ Tk_FreeFont(tkfont);
+ return TCL_ERROR;
+ }
+ i = 0; /* Needed only to prevent compiler warning. */
+ switch (index) {
+ case 0: i = fmPtr->ascent; break;
+ case 1: i = fmPtr->descent; break;
+ case 2: i = fmPtr->ascent + fmPtr->descent; break;
+ case 3: i = fmPtr->fixed; break;
+ }
+ Tcl_SetObjResult(interp, Tcl_NewIntObj(i));
+ }
+ Tk_FreeFont(tkfont);
+ break;
+ }
+ case FONT_NAMES: {
+ Tcl_HashSearch search;
+ Tcl_HashEntry *namedHashPtr;
+ Tcl_Obj *resultPtr;
+
+ if (objc != 2) {
+ Tcl_WrongNumArgs(interp, 1, objv, "names");
+ return TCL_ERROR;
+ }
+ resultPtr = Tcl_NewObj();
+ namedHashPtr = Tcl_FirstHashEntry(&fiPtr->namedTable, &search);
+ while (namedHashPtr != NULL) {
+ NamedFont *nfPtr = Tcl_GetHashValue(namedHashPtr);
+
+ if (!nfPtr->deletePending) {
+ char *string = Tcl_GetHashKey(&fiPtr->namedTable,
+ namedHashPtr);
+
+ Tcl_ListObjAppendElement(NULL, resultPtr,
+ Tcl_NewStringObj(string, -1));
+ }
+ namedHashPtr = Tcl_NextHashEntry(&search);
+ }
+ Tcl_SetObjResult(interp, resultPtr);
+ break;
+ }
+ }
+ return TCL_OK;
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * UpdateDependentFonts, TheWorldHasChanged, RecomputeWidgets --
+ *
+ * Called when the attributes of a named font changes. Updates all the
+ * instantiated fonts that depend on that named font and then uses the
+ * brute force approach and prepares every widget to recompute its
+ * geometry.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Things get queued for redisplay.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+static void
+UpdateDependentFonts(
+ TkFontInfo *fiPtr, /* Info about application's fonts. */
+ Tk_Window tkwin, /* A window in the application. */
+ Tcl_HashEntry *namedHashPtr)/* The named font that is changing. */
+{
+ Tcl_HashEntry *cacheHashPtr;
+ Tcl_HashSearch search;
+ TkFont *fontPtr;
+ NamedFont *nfPtr = Tcl_GetHashValue(namedHashPtr);
+
+ if (nfPtr->refCount == 0) {
+ /*
+ * Well nobody's using this named font, so don't have to tell any
+ * widgets to recompute themselves.
+ */
+
+ return;
+ }
+
+ cacheHashPtr = Tcl_FirstHashEntry(&fiPtr->fontCache, &search);
+ while (cacheHashPtr != NULL) {
+ for (fontPtr = Tcl_GetHashValue(cacheHashPtr);
+ fontPtr != NULL; fontPtr = fontPtr->nextPtr) {
+ if (fontPtr->namedHashPtr == namedHashPtr) {
+ TkpGetFontFromAttributes(fontPtr, tkwin, &nfPtr->fa);
+ if (!fiPtr->updatePending) {
+ fiPtr->updatePending = 1;
+ Tcl_DoWhenIdle(TheWorldHasChanged, fiPtr);
+ }
+ }
+ }
+ cacheHashPtr = Tcl_NextHashEntry(&search);
+ }
+}
+
+static void
+TheWorldHasChanged(
+ ClientData clientData) /* Info about application's fonts. */
+{
+ TkFontInfo *fiPtr = clientData;
+
+ fiPtr->updatePending = 0;
+ RecomputeWidgets(fiPtr->mainPtr->winPtr);
+}
+
+static void
+RecomputeWidgets(
+ TkWindow *winPtr) /* Window to which command is sent. */
+{
+ Tk_ClassWorldChangedProc *proc =
+ Tk_GetClassProc(winPtr->classProcsPtr, worldChangedProc);
+
+ if (proc != NULL) {
+ proc(winPtr->instanceData);
+ }
+
+ /*
+ * Notify all the descendants of this window that the world has changed.
+ *
+ * This could be done recursively or iteratively. The recursive version is
+ * easier to implement and understand, and typically, windows with a -font
+ * option will be leaf nodes in the widget heirarchy (buttons, labels,
+ * etc.), so the recursion depth will be shallow.
+ *
+ * However, the additional overhead of the recursive calls may become a
+ * performance problem if typical usage alters such that -font'ed widgets
+ * appear high in the heirarchy, causing deep recursion. This could happen
+ * with text widgets, or more likely with the (not yet existant) labeled
+ * frame widget. With these widgets it is possible, even likely, that a
+ * -font'ed widget (text or labeled frame) will not be a leaf node, but
+ * will instead have many descendants. If this is ever found to cause a
+ * performance problem, it may be worth investigating an iterative version
+ * of the code below.
+ */
+
+ for (winPtr=winPtr->childList ; winPtr!=NULL ; winPtr=winPtr->nextPtr) {
+ RecomputeWidgets(winPtr);
+ }
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * TkCreateNamedFont --
+ *
+ * Create the specified named font with the given attributes in the named
+ * font table associated with the interp.
+ *
+ * Results:
+ * Returns TCL_OK if the font was successfully created, or TCL_ERROR if
+ * the named font already existed. If TCL_ERROR is returned, an error
+ * message is left in the interp's result.
+ *
+ * Side effects:
+ * Assume there used to exist a named font by the specified name, and
+ * that the named font had been deleted, but there were still some
+ * widgets using the named font at the time it was deleted. If a new
+ * named font is created with the same name, all those widgets that were
+ * using the old named font will be redisplayed using the new named
+ * font's attributes.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+int
+TkCreateNamedFont(
+ Tcl_Interp *interp, /* Interp for error return (can be NULL). */
+ Tk_Window tkwin, /* A window associated with interp. */
+ const char *name, /* Name for the new named font. */
+ TkFontAttributes *faPtr) /* Attributes for the new named font. */
+{
+ TkFontInfo *fiPtr = ((TkWindow *) tkwin)->mainPtr->fontInfoPtr;
+ Tcl_HashEntry *namedHashPtr;
+ int isNew;
+ NamedFont *nfPtr;
+
+ namedHashPtr = Tcl_CreateHashEntry(&fiPtr->namedTable, name, &isNew);
+ if (!isNew) {
+ nfPtr = Tcl_GetHashValue(namedHashPtr);
+ if (!nfPtr->deletePending) {
+ if (interp) {
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "named font \"%s\" already exists", name));
+ Tcl_SetErrorCode(interp, "TK", "FONT", "EXISTS", NULL);
+ }
+ return TCL_ERROR;
+ }
+
+ /*
+ * Recreating a named font with the same name as a previous named
+ * font. Some widgets were still using that named font, so they need
+ * to get redisplayed.
+ */
+
+ nfPtr->fa = *faPtr;
+ nfPtr->deletePending = 0;
+ UpdateDependentFonts(fiPtr, tkwin, namedHashPtr);
+ return TCL_OK;
+ }
+
+ nfPtr = ckalloc(sizeof(NamedFont));
+ nfPtr->deletePending = 0;
+ Tcl_SetHashValue(namedHashPtr, nfPtr);
+ nfPtr->fa = *faPtr;
+ nfPtr->refCount = 0;
+ nfPtr->deletePending = 0;
+ return TCL_OK;
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * TkDeleteNamedFont --
+ *
+ * Delete the named font. If there are still widgets using this font,
+ * then it isn't deleted right away.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+int
+TkDeleteNamedFont(
+ Tcl_Interp *interp, /* Interp for error return (can be NULL). */
+ Tk_Window tkwin, /* A window associated with interp. */
+ const char *name) /* Name for the new named font. */
+{
+ TkFontInfo *fiPtr = ((TkWindow *) tkwin)->mainPtr->fontInfoPtr;
+ NamedFont *nfPtr;
+ Tcl_HashEntry *namedHashPtr;
+
+ namedHashPtr = Tcl_FindHashEntry(&fiPtr->namedTable, name);
+ if (namedHashPtr == NULL) {
+ if (interp) {
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "named font \"%s\" doesn't exist", name));
+ Tcl_SetErrorCode(interp, "TK", "LOOKUP", "FONT", name, NULL);
+ }
+ return TCL_ERROR;
+ }
+ nfPtr = Tcl_GetHashValue(namedHashPtr);
+ if (nfPtr->refCount != 0) {
+ nfPtr->deletePending = 1;
+ } else {
+ Tcl_DeleteHashEntry(namedHashPtr);
+ ckfree(nfPtr);
+ }
+ return TCL_OK;
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * Tk_GetFont --
+ *
+ * Given a string description of a font, map the description to a
+ * corresponding Tk_Font that represents the font.
+ *
+ * Results:
+ * The return value is token for the font, or NULL if an error prevented
+ * the font from being created. If NULL is returned, an error message
+ * will be left in the interp's result.
+ *
+ * Side effects:
+ * The font is added to an internal database with a reference count. For
+ * each call to this function, there should eventually be a call to
+ * Tk_FreeFont() or Tk_FreeFontFromObj() so that the database is cleaned
+ * up when fonts aren't in use anymore.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+Tk_Font
+Tk_GetFont(
+ Tcl_Interp *interp, /* Interp for database and error return. */
+ Tk_Window tkwin, /* For display on which font will be used. */
+ const char *string) /* String describing font, as: named font,
+ * native format, or parseable string. */
+{
+ Tk_Font tkfont;
+ Tcl_Obj *strPtr;
+
+ strPtr = Tcl_NewStringObj(string, -1);
+ Tcl_IncrRefCount(strPtr);
+ tkfont = Tk_AllocFontFromObj(interp, tkwin, strPtr);
+ Tcl_DecrRefCount(strPtr);
+ return tkfont;
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * Tk_AllocFontFromObj --
+ *
+ * Given a string description of a font, map the description to a
+ * corresponding Tk_Font that represents the font.
+ *
+ * Results:
+ * The return value is token for the font, or NULL if an error prevented
+ * the font from being created. If NULL is returned, an error message
+ * will be left in interp's result object.
+ *
+ * Side effects:
+ * The font is added to an internal database with a reference count. For
+ * each call to this function, there should eventually be a call to
+ * Tk_FreeFont() or Tk_FreeFontFromObj() so that the database is cleaned
+ * up when fonts aren't in use anymore.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+Tk_Font
+Tk_AllocFontFromObj(
+ Tcl_Interp *interp, /* Interp for database and error return. */
+ Tk_Window tkwin, /* For screen on which font will be used. */
+ Tcl_Obj *objPtr) /* Object describing font, as: named font,
+ * native format, or parseable string. */
+{
+ TkFontInfo *fiPtr = ((TkWindow *) tkwin)->mainPtr->fontInfoPtr;
+ Tcl_HashEntry *cacheHashPtr, *namedHashPtr;
+ TkFont *fontPtr, *firstFontPtr, *oldFontPtr;
+ int isNew, descent;
+ NamedFont *nfPtr;
+
+ if (objPtr->typePtr != &tkFontObjType
+ || objPtr->internalRep.twoPtrValue.ptr2 != fiPtr) {
+ SetFontFromAny(interp, objPtr);
+ }
+
+ oldFontPtr = objPtr->internalRep.twoPtrValue.ptr1;
+ if (oldFontPtr != NULL) {
+ if (oldFontPtr->resourceRefCount == 0) {
+ /*
+ * This is a stale reference: it refers to a TkFont that's no
+ * longer in use. Clear the reference.
+ */
+
+ FreeFontObj(objPtr);
+ oldFontPtr = NULL;
+ } else if (Tk_Screen(tkwin) == oldFontPtr->screen) {
+ oldFontPtr->resourceRefCount++;
+ return (Tk_Font) oldFontPtr;
+ }
+ }
+
+ /*
+ * Next, search the list of fonts that have the name we want, to see if
+ * one of them is for the right screen.
+ */
+
+ isNew = 0;
+ if (oldFontPtr != NULL) {
+ cacheHashPtr = oldFontPtr->cacheHashPtr;
+ FreeFontObj(objPtr);
+ } else {
+ cacheHashPtr = Tcl_CreateHashEntry(&fiPtr->fontCache,
+ Tcl_GetString(objPtr), &isNew);
+ }
+ firstFontPtr = 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 = fontPtr;
+ objPtr->internalRep.twoPtrValue.ptr2 = fiPtr;
+ return (Tk_Font) fontPtr;
+ }
+ }
+
+ /*
+ * The desired font isn't in the table. Make a new one.
+ */
+
+ namedHashPtr = Tcl_FindHashEntry(&fiPtr->namedTable,
+ Tcl_GetString(objPtr));
+ if (namedHashPtr != NULL) {
+ /*
+ * Construct a font based on a named font.
+ */
+
+ nfPtr = Tcl_GetHashValue(namedHashPtr);
+ nfPtr->refCount++;
+
+ fontPtr = TkpGetFontFromAttributes(NULL, tkwin, &nfPtr->fa);
+ } else {
+ /*
+ * Native font?
+ */
+
+ fontPtr = TkpGetNativeFont(tkwin, Tcl_GetString(objPtr));
+ if (fontPtr == NULL) {
+ TkFontAttributes fa;
+ Tcl_Obj *dupObjPtr = Tcl_DuplicateObj(objPtr);
+
+ if (ParseFontNameObj(interp, tkwin, dupObjPtr, &fa) != TCL_OK) {
+ if (isNew) {
+ Tcl_DeleteHashEntry(cacheHashPtr);
+ }
+ Tcl_DecrRefCount(dupObjPtr);
+ return NULL;
+ }
+ Tcl_DecrRefCount(dupObjPtr);
+
+ /*
+ * String contained the attributes inline.
+ */
+
+ fontPtr = TkpGetFontFromAttributes(NULL, tkwin, &fa);
+ }
+ }
+
+ /*
+ * Detect the system font engine going wrong and fail more gracefully.
+ */
+
+ if (fontPtr == NULL) {
+ if (isNew) {
+ Tcl_DeleteHashEntry(cacheHashPtr);
+ }
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "failed to allocate font due to internal system font engine"
+ " problem", -1));
+ Tcl_SetErrorCode(interp, "TK", "FONT", "INTERNAL_PROBLEM", NULL);
+ return NULL;
+ }
+
+ fontPtr->resourceRefCount = 1;
+ fontPtr->objRefCount = 1;
+ fontPtr->cacheHashPtr = cacheHashPtr;
+ fontPtr->namedHashPtr = namedHashPtr;
+ fontPtr->screen = Tk_Screen(tkwin);
+ fontPtr->nextPtr = firstFontPtr;
+ Tcl_SetHashValue(cacheHashPtr, fontPtr);
+
+ Tk_MeasureChars((Tk_Font) fontPtr, "0", 1, -1, 0, &fontPtr->tabWidth);
+ if (fontPtr->tabWidth == 0) {
+ fontPtr->tabWidth = fontPtr->fm.maxWidth;
+ }
+ fontPtr->tabWidth *= 8;
+
+ /*
+ * Make sure the tab width isn't zero (some fonts may not have enough
+ * information to set a reasonable tab width).
+ */
+
+ if (fontPtr->tabWidth == 0) {
+ fontPtr->tabWidth = 1;
+ }
+
+ /*
+ * Get information used for drawing underlines in generic code on a
+ * non-underlined font.
+ */
+
+ descent = fontPtr->fm.descent;
+ fontPtr->underlinePos = descent / 2;
+ fontPtr->underlineHeight = TkFontGetPixels(tkwin, fontPtr->fa.size) / 10;
+ if (fontPtr->underlineHeight == 0) {
+ fontPtr->underlineHeight = 1;
+ }
+ if (fontPtr->underlinePos + fontPtr->underlineHeight > descent) {
+ /*
+ * If this set of values would cause the bottom of the underline bar
+ * to stick below the descent of the font, jack the underline up a bit
+ * higher.
+ */
+
+ fontPtr->underlineHeight = descent - fontPtr->underlinePos;
+ if (fontPtr->underlineHeight == 0) {
+ fontPtr->underlinePos--;
+ fontPtr->underlineHeight = 1;
+ }
+ }
+
+ objPtr->internalRep.twoPtrValue.ptr1 = fontPtr;
+ objPtr->internalRep.twoPtrValue.ptr2 = fiPtr;
+ 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(
+ Tk_Window tkwin, /* The window that the font will be used
+ * in. */
+ Tcl_Obj *objPtr) /* The object from which to get the font. */
+{
+ TkFontInfo *fiPtr = ((TkWindow *) tkwin)->mainPtr->fontInfoPtr;
+ TkFont *fontPtr;
+ Tcl_HashEntry *hashPtr;
+
+ if (objPtr->typePtr != &tkFontObjType
+ || objPtr->internalRep.twoPtrValue.ptr2 != fiPtr) {
+ SetFontFromAny(NULL, objPtr);
+ }
+
+ fontPtr = 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.
+ */
+
+ FreeFontObj(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;
+ FreeFontObj(objPtr);
+ } else {
+ hashPtr = Tcl_FindHashEntry(&fiPtr->fontCache, Tcl_GetString(objPtr));
+ }
+ if (hashPtr != NULL) {
+ for (fontPtr = Tcl_GetHashValue(hashPtr); fontPtr != NULL;
+ fontPtr = fontPtr->nextPtr) {
+ if (Tk_Screen(tkwin) == fontPtr->screen) {
+ fontPtr->objRefCount++;
+ objPtr->internalRep.twoPtrValue.ptr1 = fontPtr;
+ objPtr->internalRep.twoPtrValue.ptr2 = fiPtr;
+ return (Tk_Font) fontPtr;
+ }
+ }
+ }
+
+ Tcl_Panic("Tk_GetFontFromObj called with non-existent font!");
+ return NULL;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * SetFontFromAny --
+ *
+ * Convert the internal representation of a Tcl object to the font
+ * internal form.
+ *
+ * Results:
+ * Always returns TCL_OK.
+ *
+ * Side effects:
+ * The object is left with its typePtr pointing to tkFontObjType. The
+ * TkFont pointer is NULL.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+SetFontFromAny(
+ Tcl_Interp *interp, /* Used for error reporting if not NULL. */
+ Tcl_Obj *objPtr) /* The object to convert. */
+{
+ const Tcl_ObjType *typePtr;
+
+ /*
+ * Free the old internalRep before setting the new one.
+ */
+
+ Tcl_GetString(objPtr);
+ typePtr = objPtr->typePtr;
+ if ((typePtr != NULL) && (typePtr->freeIntRepProc != NULL)) {
+ typePtr->freeIntRepProc(objPtr);
+ }
+ objPtr->typePtr = &tkFontObjType;
+ objPtr->internalRep.twoPtrValue.ptr1 = NULL;
+ objPtr->internalRep.twoPtrValue.ptr2 = NULL;
+
+ return TCL_OK;
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * Tk_NameOfFont --
+ *
+ * Given a font, return a textual string identifying it.
+ *
+ * Results:
+ * The return value is the description that was passed to Tk_GetFont() to
+ * create the font. The storage for the returned string is only
+ * guaranteed to persist until the font is deleted. The caller should not
+ * modify this string.
+ *
+ * Side effects:
+ * None.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+const char *
+Tk_NameOfFont(
+ Tk_Font tkfont) /* Font whose name is desired. */
+{
+ TkFont *fontPtr = (TkFont *) tkfont;
+
+ return fontPtr->cacheHashPtr->key.string;
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * Tk_FreeFont --
+ *
+ * Called to release a font allocated by Tk_GetFont().
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The reference count associated with font is decremented, and only
+ * deallocated when no one is using it.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+void
+Tk_FreeFont(
+ Tk_Font tkfont) /* Font to be released. */
+{
+ TkFont *fontPtr = (TkFont *) tkfont, *prevPtr;
+ NamedFont *nfPtr;
+
+ if (fontPtr == NULL) {
+ return;
+ }
+ 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 = Tcl_GetHashValue(fontPtr->namedHashPtr);
+ nfPtr->refCount--;
+ if ((nfPtr->refCount == 0) && nfPtr->deletePending) {
+ Tcl_DeleteHashEntry(fontPtr->namedHashPtr);
+ ckfree(nfPtr);
+ }
+ }
+
+ prevPtr = Tcl_GetHashValue(fontPtr->cacheHashPtr);
+ if (prevPtr == fontPtr) {
+ if (fontPtr->nextPtr == NULL) {
+ Tcl_DeleteHashEntry(fontPtr->cacheHashPtr);
+ } else {
+ Tcl_SetHashValue(fontPtr->cacheHashPtr, fontPtr->nextPtr);
+ }
+ } else {
+ while (prevPtr->nextPtr != fontPtr) {
+ prevPtr = prevPtr->nextPtr;
+ }
+ prevPtr->nextPtr = fontPtr->nextPtr;
+ }
+
+ TkpDeleteFont(fontPtr);
+ if (fontPtr->objRefCount == 0) {
+ ckfree(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(
+ 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, FreeFontObj --
+ *
+ * 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(
+ Tcl_Obj *objPtr) /* The object we are releasing. */
+{
+ FreeFontObj(objPtr);
+ objPtr->typePtr = NULL;
+}
+
+static void
+FreeFontObj(
+ Tcl_Obj *objPtr) /* The object we are releasing. */
+{
+ TkFont *fontPtr = objPtr->internalRep.twoPtrValue.ptr1;
+
+ if (fontPtr != NULL) {
+ fontPtr->objRefCount--;
+ if ((fontPtr->resourceRefCount == 0) && (fontPtr->objRefCount == 0)) {
+ ckfree(fontPtr);
+ }
+ objPtr->internalRep.twoPtrValue.ptr1 = NULL;
+ objPtr->internalRep.twoPtrValue.ptr2 = 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(
+ Tcl_Obj *srcObjPtr, /* The object we are copying from. */
+ Tcl_Obj *dupObjPtr) /* The object we are copying to. */
+{
+ TkFont *fontPtr = srcObjPtr->internalRep.twoPtrValue.ptr1;
+
+ dupObjPtr->typePtr = srcObjPtr->typePtr;
+ dupObjPtr->internalRep.twoPtrValue.ptr1 = fontPtr;
+ dupObjPtr->internalRep.twoPtrValue.ptr2
+ = srcObjPtr->internalRep.twoPtrValue.ptr2;
+
+ if (fontPtr != NULL) {
+ fontPtr->objRefCount++;
+ }
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * Tk_FontId --
+ *
+ * Given a font, return an opaque handle that should be selected into the
+ * XGCValues structure in order to get the constructed gc to use this
+ * font. This function would go away if the XGCValues structure were
+ * replaced with a TkGCValues structure.
+ *
+ * Results:
+ * As above.
+ *
+ * Side effects:
+ * None.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+Font
+Tk_FontId(
+ Tk_Font tkfont) /* Font that is going to be selected into
+ * GC. */
+{
+ TkFont *fontPtr = (TkFont *) tkfont;
+
+ return fontPtr->fid;
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * Tk_GetFontMetrics --
+ *
+ * Returns overall ascent and descent metrics for the given font. These
+ * values can be used to space multiple lines of text and to align the
+ * baselines of text in different fonts.
+ *
+ * Results:
+ * If *heightPtr is non-NULL, it is filled with the overall height of the
+ * font, which is the sum of the ascent and descent. If *ascentPtr or
+ * *descentPtr is non-NULL, they are filled with the ascent and/or
+ * descent information for the font.
+ *
+ * Side effects:
+ * None.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+void
+Tk_GetFontMetrics(
+ Tk_Font tkfont, /* Font in which metrics are calculated. */
+ Tk_FontMetrics *fmPtr) /* Pointer to structure in which font metrics
+ * for tkfont will be stored. */
+{
+ TkFont *fontPtr = (TkFont *) tkfont;
+
+ fmPtr->ascent = fontPtr->fm.ascent;
+ fmPtr->descent = fontPtr->fm.descent;
+ fmPtr->linespace = fontPtr->fm.ascent + fontPtr->fm.descent;
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * Tk_PostscriptFontName --
+ *
+ * Given a Tk_Font, return the name of the corresponding Postscript font.
+ *
+ * Results:
+ * The return value is the pointsize of the given Tk_Font. The name of
+ * the Postscript font is appended to dsPtr.
+ *
+ * Side effects:
+ * If the font does not exist on the printer, the print job will fail at
+ * print time. Given a "reasonable" Postscript printer, the following
+ * Tk_Font font families should print correctly:
+ *
+ * Avant Garde, Arial, Bookman, Courier, Courier New, Geneva,
+ * Helvetica, Monaco, New Century Schoolbook, New York,
+ * Palatino, Symbol, Times, Times New Roman, Zapf Chancery,
+ * and Zapf Dingbats.
+ *
+ * Any other Tk_Font font families may not print correctly because the
+ * computed Postscript font name may be incorrect.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+int
+Tk_PostscriptFontName(
+ Tk_Font tkfont, /* Font in which text will be printed. */
+ Tcl_DString *dsPtr) /* Pointer to an initialized Tcl_DString to
+ * which the name of the Postscript font that
+ * corresponds to tkfont will be appended. */
+{
+ TkFont *fontPtr = (TkFont *) tkfont;
+ Tk_Uid family, weightString, slantString;
+ char *src, *dest;
+ int upper, len;
+
+ len = Tcl_DStringLength(dsPtr);
+
+ /*
+ * Convert the case-insensitive Tk_Font family name to the case-sensitive
+ * Postscript family name. Take out any spaces and capitalize the first
+ * letter of each word.
+ */
+
+ family = fontPtr->fa.family;
+ if (strncasecmp(family, "itc ", 4) == 0) {
+ family = family + 4;
+ }
+ if ((strcasecmp(family, "Arial") == 0)
+ || (strcasecmp(family, "Geneva") == 0)) {
+ family = "Helvetica";
+ } else if ((strcasecmp(family, "Times New Roman") == 0)
+ || (strcasecmp(family, "New York") == 0)) {
+ family = "Times";
+ } else if ((strcasecmp(family, "Courier New") == 0)
+ || (strcasecmp(family, "Monaco") == 0)) {
+ family = "Courier";
+ } else if (strcasecmp(family, "AvantGarde") == 0) {
+ family = "AvantGarde";
+ } else if (strcasecmp(family, "ZapfChancery") == 0) {
+ family = "ZapfChancery";
+ } else if (strcasecmp(family, "ZapfDingbats") == 0) {
+ family = "ZapfDingbats";
+ } else {
+ Tcl_UniChar ch;
+
+ /*
+ * Inline, capitalize the first letter of each word, lowercase the
+ * rest of the letters in each word, and then take out the spaces
+ * between the words. This may make the DString shorter, which is safe
+ * to do.
+ */
+
+ Tcl_DStringAppend(dsPtr, family, -1);
+
+ src = dest = Tcl_DStringValue(dsPtr) + len;
+ upper = 1;
+ for (; *src != '\0'; ) {
+ while (isspace(UCHAR(*src))) { /* INTL: ISO space */
+ src++;
+ upper = 1;
+ }
+ src += Tcl_UtfToUniChar(src, &ch);
+ if (upper) {
+ ch = Tcl_UniCharToUpper(ch);
+ upper = 0;
+ } else {
+ ch = Tcl_UniCharToLower(ch);
+ }
+ dest += Tcl_UniCharToUtf(ch, dest);
+ }
+ *dest = '\0';
+ Tcl_DStringSetLength(dsPtr, dest - Tcl_DStringValue(dsPtr));
+ family = Tcl_DStringValue(dsPtr) + len;
+ }
+ if (family != Tcl_DStringValue(dsPtr) + len) {
+ Tcl_DStringAppend(dsPtr, family, -1);
+ family = Tcl_DStringValue(dsPtr) + len;
+ }
+
+ if (strcasecmp(family, "NewCenturySchoolbook") == 0) {
+ Tcl_DStringSetLength(dsPtr, len);
+ Tcl_DStringAppend(dsPtr, "NewCenturySchlbk", -1);
+ family = Tcl_DStringValue(dsPtr) + len;
+ }
+
+ /*
+ * Get the string to use for the weight.
+ */
+
+ weightString = NULL;
+ if (fontPtr->fa.weight == TK_FW_NORMAL) {
+ if (strcmp(family, "Bookman") == 0) {
+ weightString = "Light";
+ } else if (strcmp(family, "AvantGarde") == 0) {
+ weightString = "Book";
+ } else if (strcmp(family, "ZapfChancery") == 0) {
+ weightString = "Medium";
+ }
+ } else {
+ if ((strcmp(family, "Bookman") == 0)
+ || (strcmp(family, "AvantGarde") == 0)) {
+ weightString = "Demi";
+ } else {
+ weightString = "Bold";
+ }
+ }
+
+ /*
+ * Get the string to use for the slant.
+ */
+
+ slantString = NULL;
+ if (fontPtr->fa.slant == TK_FS_ROMAN) {
+ /* Do nothing */
+ } else if ((strcmp(family, "Helvetica") == 0)
+ || (strcmp(family, "Courier") == 0)
+ || (strcmp(family, "AvantGarde") == 0)) {
+ slantString = "Oblique";
+ } else {
+ slantString = "Italic";
+ }
+
+ /*
+ * The string "Roman" needs to be added to some fonts that are not bold
+ * and not italic.
+ */
+
+ if ((slantString == NULL) && (weightString == NULL)) {
+ if ((strcmp(family, "Times") == 0)
+ || (strcmp(family, "NewCenturySchlbk") == 0)
+ || (strcmp(family, "Palatino") == 0)) {
+ Tcl_DStringAppend(dsPtr, "-Roman", -1);
+ }
+ } else {
+ Tcl_DStringAppend(dsPtr, "-", -1);
+ if (weightString != NULL) {
+ Tcl_DStringAppend(dsPtr, weightString, -1);
+ }
+ if (slantString != NULL) {
+ Tcl_DStringAppend(dsPtr, slantString, -1);
+ }
+ }
+
+ return fontPtr->fa.size;
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * Tk_TextWidth --
+ *
+ * A wrapper function for the more complicated interface of
+ * Tk_MeasureChars. Computes how much space the given simple string
+ * needs.
+ *
+ * Results:
+ * The return value is the width (in pixels) of the given string.
+ *
+ * Side effects:
+ * None.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+int
+Tk_TextWidth(
+ Tk_Font tkfont, /* Font in which text will be measured. */
+ const char *string, /* String whose width will be computed. */
+ int numBytes) /* Number of bytes to consider from string, or
+ * < 0 for strlen(). */
+{
+ int width;
+
+ if (numBytes < 0) {
+ numBytes = strlen(string);
+ }
+ Tk_MeasureChars(tkfont, string, numBytes, -1, 0, &width);
+ return width;
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * Tk_UnderlineChars, TkUnderlineCharsInContext --
+ *
+ * These procedures draw an underline for a given range of characters in
+ * a given string. They don't draw the characters (which are assumed to
+ * have been displayed previously); they just draw the underline. These
+ * procedures would mainly be used to quickly underline a few characters
+ * without having to construct an underlined font. To produce properly
+ * underlined text, the appropriate underlined font should be constructed
+ * and used.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Information gets displayed in "drawable".
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tk_UnderlineChars(
+ Display *display, /* Display on which to draw. */
+ Drawable drawable, /* Window or pixmap in which to draw. */
+ GC gc, /* Graphics context for actually drawing
+ * line. */
+ Tk_Font tkfont, /* Font used in GC; must have been allocated
+ * by Tk_GetFont(). Used for character
+ * dimensions, etc. */
+ const char *string, /* String containing characters to be
+ * underlined or overstruck. */
+ int x, int y, /* Coordinates at which first character of
+ * string is drawn. */
+ int firstByte, /* Index of first byte of first character. */
+ int lastByte) /* Index of first byte after the last
+ * character. */
+{
+ TkUnderlineCharsInContext(display, drawable, gc, tkfont, string,
+ lastByte, x, y, firstByte, lastByte);
+}
+
+void
+TkUnderlineCharsInContext(
+ Display *display, /* Display on which to draw. */
+ Drawable drawable, /* Window or pixmap in which to draw. */
+ GC gc, /* Graphics context for actually drawing
+ * line. */
+ Tk_Font tkfont, /* Font used in GC; must have been allocated
+ * by Tk_GetFont(). Used for character
+ * dimensions, etc. */
+ const char *string, /* String containing characters to be
+ * underlined or overstruck. */
+ int numBytes, /* Number of bytes in string. */
+ int x, int y, /* Coordinates at which the first character of
+ * the whole string would be drawn. */
+ int firstByte, /* Index of first byte of first character. */
+ int lastByte) /* Index of first byte after the last
+ * character. */
+{
+ TkFont *fontPtr = (TkFont *) tkfont;
+ int startX, endX;
+
+ TkpMeasureCharsInContext(tkfont, string, numBytes, 0, firstByte, -1, 0,
+ &startX);
+ TkpMeasureCharsInContext(tkfont, string, numBytes, 0, lastByte, -1, 0,
+ &endX);
+
+ XFillRectangle(display, drawable, gc, x + startX,
+ y + fontPtr->underlinePos, (unsigned) (endX - startX),
+ (unsigned) fontPtr->underlineHeight);
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * Tk_ComputeTextLayout --
+ *
+ * Computes the amount of screen space needed to display a multi-line,
+ * justified string of text. Records all the measurements that were done
+ * to determine to size and positioning of the individual lines of text;
+ * this information can be used by the Tk_DrawTextLayout() function to
+ * display the text quickly (without remeasuring it).
+ *
+ * This function is useful for simple widgets that want to display
+ * single-font, multi-line text and want Tk to handle the details.
+ *
+ * Results:
+ * The return value is a Tk_TextLayout token that holds the measurement
+ * information for the given string. The token is only valid for the
+ * given string. If the string is freed, the token is no longer valid and
+ * must also be freed. To free the token, call Tk_FreeTextLayout().
+ *
+ * The dimensions of the screen area needed to display the text are
+ * stored in *widthPtr and *heightPtr.
+ *
+ * Side effects:
+ * Memory is allocated to hold the measurement information.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+Tk_TextLayout
+Tk_ComputeTextLayout(
+ Tk_Font tkfont, /* Font that will be used to display text. */
+ const char *string, /* String whose dimensions are to be
+ * computed. */
+ int numChars, /* Number of characters to consider from
+ * string, or < 0 for strlen(). */
+ int wrapLength, /* Longest permissible line length, in pixels.
+ * <= 0 means no automatic wrapping: just let
+ * lines get as long as needed. */
+ Tk_Justify justify, /* How to justify lines. */
+ int flags, /* Flag bits OR-ed together. TK_IGNORE_TABS
+ * means that tab characters should not be
+ * expanded. TK_IGNORE_NEWLINES means that
+ * newline characters should not cause a line
+ * break. */
+ int *widthPtr, /* Filled with width of string. */
+ int *heightPtr) /* Filled with height of string. */
+{
+ TkFont *fontPtr = (TkFont *) tkfont;
+ const char *start, *end, *special;
+ int n, y, bytesThisChunk, maxChunks, curLine, layoutHeight;
+ int baseline, height, curX, newX, maxWidth, *lineLengths;
+ TextLayout *layoutPtr;
+ LayoutChunk *chunkPtr;
+ const TkFontMetrics *fmPtr;
+ Tcl_DString lineBuffer;
+
+ Tcl_DStringInit(&lineBuffer);
+
+ if ((fontPtr == NULL) || (string == NULL)) {
+ if (widthPtr != NULL) {
+ *widthPtr = 0;
+ }
+ if (heightPtr != NULL) {
+ *heightPtr = 0;
+ }
+ return NULL;
+ }
+
+ fmPtr = &fontPtr->fm;
+
+ height = fmPtr->ascent + fmPtr->descent;
+
+ if (numChars < 0) {
+ numChars = Tcl_NumUtfChars(string, -1);
+ }
+ if (wrapLength == 0) {
+ wrapLength = -1;
+ }
+
+ maxChunks = 1;
+
+ layoutPtr = ckalloc(sizeof(TextLayout)
+ + (maxChunks-1) * sizeof(LayoutChunk));
+ layoutPtr->tkfont = tkfont;
+ layoutPtr->string = string;
+ layoutPtr->numChunks = 0;
+
+ baseline = fmPtr->ascent;
+ maxWidth = 0;
+
+ /*
+ * Divide the string up into simple strings and measure each string.
+ */
+
+ curX = 0;
+
+ end = Tcl_UtfAtIndex(string, numChars);
+ special = string;
+
+ flags &= TK_IGNORE_TABS | TK_IGNORE_NEWLINES;
+ flags |= TK_WHOLE_WORDS | TK_AT_LEAST_ONE;
+ for (start = string; start < end; ) {
+ if (start >= special) {
+ /*
+ * Find the next special character in the string.
+ *
+ * INTL: Note that it is safe to increment by byte, because we are
+ * looking for 7-bit characters that will appear unchanged in
+ * UTF-8. At some point we may need to support the full Unicode
+ * whitespace set.
+ */
+
+ for (special = start; special < end; special++) {
+ if (!(flags & TK_IGNORE_NEWLINES)) {
+ if ((*special == '\n') || (*special == '\r')) {
+ break;
+ }
+ }
+ if (!(flags & TK_IGNORE_TABS)) {
+ if (*special == '\t') {
+ break;
+ }
+ }
+ }
+ }
+
+ /*
+ * Special points at the next special character (or the end of the
+ * string). Process characters between start and special.
+ */
+
+ chunkPtr = NULL;
+ if (start < special) {
+ bytesThisChunk = Tk_MeasureChars(tkfont, start, special - start,
+ wrapLength - curX, flags, &newX);
+ newX += curX;
+ flags &= ~TK_AT_LEAST_ONE;
+ if (bytesThisChunk > 0) {
+ chunkPtr = NewChunk(&layoutPtr, &maxChunks, start,
+ bytesThisChunk, curX, newX, baseline);
+
+ start += bytesThisChunk;
+ curX = newX;
+ }
+ }
+
+ if ((start == special) && (special < end)) {
+ /*
+ * Handle the special character.
+ *
+ * INTL: Special will be pointing at a 7-bit character so we can
+ * safely treat it as a single byte.
+ */
+
+ chunkPtr = NULL;
+ if (*special == '\t') {
+ newX = curX + fontPtr->tabWidth;
+ newX -= newX % fontPtr->tabWidth;
+ NewChunk(&layoutPtr, &maxChunks, start, 1, curX, newX,
+ baseline)->numDisplayChars = -1;
+ start++;
+ curX = newX;
+ flags &= ~TK_AT_LEAST_ONE;
+ if ((start < end) &&
+ ((wrapLength <= 0) || (newX <= wrapLength))) {
+ /*
+ * More chars can still fit on this line.
+ */
+
+ continue;
+ }
+ } else {
+ NewChunk(&layoutPtr, &maxChunks, start, 1, curX, curX,
+ baseline)->numDisplayChars = -1;
+ start++;
+ goto wrapLine;
+ }
+ }
+
+ /*
+ * No more characters are going to go on this line, either because no
+ * more characters can fit or there are no more characters left.
+ * Consume all extra spaces at end of line.
+ */
+
+ while ((start < end) && isspace(UCHAR(*start))) { /* INTL: ISO space */
+ if (!(flags & TK_IGNORE_NEWLINES)) {
+ if ((*start == '\n') || (*start == '\r')) {
+ break;
+ }
+ }
+ if (!(flags & TK_IGNORE_TABS)) {
+ if (*start == '\t') {
+ break;
+ }
+ }
+ start++;
+ }
+ if (chunkPtr != NULL) {
+ const char *end;
+
+ /*
+ * Append all the extra spaces on this line to the end of the last
+ * text chunk. This is a little tricky because we are switching
+ * back and forth between characters and bytes.
+ */
+
+ end = chunkPtr->start + chunkPtr->numBytes;
+ bytesThisChunk = start - end;
+ if (bytesThisChunk > 0) {
+ bytesThisChunk = Tk_MeasureChars(tkfont, end, bytesThisChunk,
+ -1, 0, &chunkPtr->totalWidth);
+ chunkPtr->numBytes += bytesThisChunk;
+ chunkPtr->numChars += Tcl_NumUtfChars(end, bytesThisChunk);
+ chunkPtr->totalWidth += curX;
+ }
+ }
+
+ wrapLine:
+ flags |= TK_AT_LEAST_ONE;
+
+ /*
+ * Save current line length, then move current position to start of
+ * next line.
+ */
+
+ if (curX > maxWidth) {
+ maxWidth = curX;
+ }
+
+ /*
+ * Remember width of this line, so that all chunks on this line can be
+ * centered or right justified, if necessary.
+ */
+
+ Tcl_DStringAppend(&lineBuffer, (char *) &curX, sizeof(curX));
+
+ curX = 0;
+ baseline += height;
+ }
+
+ /*
+ * If last line ends with a newline, then we need to make a 0 width chunk
+ * on the next line. Otherwise "Hello" and "Hello\n" are the same height.
+ */
+
+ if ((layoutPtr->numChunks > 0) && !(flags & TK_IGNORE_NEWLINES)) {
+ if (layoutPtr->chunks[layoutPtr->numChunks - 1].start[0] == '\n') {
+ chunkPtr = NewChunk(&layoutPtr, &maxChunks, start, 0, curX,
+ curX, baseline);
+ chunkPtr->numDisplayChars = -1;
+ Tcl_DStringAppend(&lineBuffer, (char *) &curX, sizeof(curX));
+ baseline += height;
+ }
+ }
+
+ layoutPtr->width = maxWidth;
+ layoutHeight = baseline - fmPtr->ascent;
+ if (layoutPtr->numChunks == 0) {
+ layoutHeight = height;
+
+ /*
+ * This fake chunk is used by the other functions so that they can
+ * pretend that there is a chunk with no chars in it, which makes the
+ * coding simpler.
+ */
+
+ layoutPtr->numChunks = 1;
+ layoutPtr->chunks[0].start = string;
+ layoutPtr->chunks[0].numBytes = 0;
+ layoutPtr->chunks[0].numChars = 0;
+ layoutPtr->chunks[0].numDisplayChars = -1;
+ layoutPtr->chunks[0].x = 0;
+ layoutPtr->chunks[0].y = fmPtr->ascent;
+ layoutPtr->chunks[0].totalWidth = 0;
+ layoutPtr->chunks[0].displayWidth = 0;
+ } else {
+ /*
+ * Using maximum line length, shift all the chunks so that the lines
+ * are all justified correctly.
+ */
+
+ curLine = 0;
+ chunkPtr = layoutPtr->chunks;
+ y = chunkPtr->y;
+ lineLengths = (int *) Tcl_DStringValue(&lineBuffer);
+ for (n = 0; n < layoutPtr->numChunks; n++) {
+ int extra;
+
+ if (chunkPtr->y != y) {
+ curLine++;
+ y = chunkPtr->y;
+ }
+ extra = maxWidth - lineLengths[curLine];
+ if (justify == TK_JUSTIFY_CENTER) {
+ chunkPtr->x += extra / 2;
+ } else if (justify == TK_JUSTIFY_RIGHT) {
+ chunkPtr->x += extra;
+ }
+ chunkPtr++;
+ }
+ }
+
+ if (widthPtr != NULL) {
+ *widthPtr = layoutPtr->width;
+ }
+ if (heightPtr != NULL) {
+ *heightPtr = layoutHeight;
+ }
+ Tcl_DStringFree(&lineBuffer);
+
+ return (Tk_TextLayout) layoutPtr;
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * Tk_FreeTextLayout --
+ *
+ * This function is called to release the storage associated with a
+ * Tk_TextLayout when it is no longer needed.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Memory is freed.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+void
+Tk_FreeTextLayout(
+ Tk_TextLayout textLayout) /* The text layout to be released. */
+{
+ TextLayout *layoutPtr = (TextLayout *) textLayout;
+
+ if (layoutPtr != NULL) {
+ ckfree(layoutPtr);
+ }
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * Tk_DrawTextLayout --
+ *
+ * Use the information in the Tk_TextLayout token to display a
+ * multi-line, justified string of text.
+ *
+ * This function is useful for simple widgets that need to display
+ * single-font, multi-line text and want Tk to handle the details.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Text drawn on the screen.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+void
+Tk_DrawTextLayout(
+ Display *display, /* Display on which to draw. */
+ Drawable drawable, /* Window or pixmap in which to draw. */
+ GC gc, /* Graphics context to use for drawing
+ * text. */
+ Tk_TextLayout layout, /* Layout information, from a previous call to
+ * Tk_ComputeTextLayout(). */
+ int x, int y, /* Upper-left hand corner of rectangle in
+ * which to draw (pixels). */
+ int firstChar, /* The index of the first character to draw
+ * from the given text item. 0 specfies the
+ * beginning. */
+ int lastChar) /* The index just after the last character to
+ * draw from the given text item. A number < 0
+ * means to draw all characters. */
+{
+ TextLayout *layoutPtr = (TextLayout *) layout;
+ int i, numDisplayChars, drawX;
+ const char *firstByte, *lastByte;
+ LayoutChunk *chunkPtr;
+
+ if (layoutPtr == NULL) {
+ return;
+ }
+
+ if (lastChar < 0) {
+ lastChar = 100000000;
+ }
+ chunkPtr = layoutPtr->chunks;
+ for (i = 0; i < layoutPtr->numChunks; i++) {
+ numDisplayChars = chunkPtr->numDisplayChars;
+ if ((numDisplayChars > 0) && (firstChar < numDisplayChars)) {
+ if (firstChar <= 0) {
+ drawX = 0;
+ firstChar = 0;
+ firstByte = chunkPtr->start;
+ } else {
+ firstByte = Tcl_UtfAtIndex(chunkPtr->start, firstChar);
+ Tk_MeasureChars(layoutPtr->tkfont, chunkPtr->start,
+ firstByte - chunkPtr->start, -1, 0, &drawX);
+ }
+ if (lastChar < numDisplayChars) {
+ numDisplayChars = lastChar;
+ }
+ lastByte = Tcl_UtfAtIndex(chunkPtr->start, numDisplayChars);
+ Tk_DrawChars(display, drawable, gc, layoutPtr->tkfont, firstByte,
+ lastByte - firstByte, x+chunkPtr->x+drawX, y+chunkPtr->y);
+ }
+ firstChar -= chunkPtr->numChars;
+ lastChar -= chunkPtr->numChars;
+ if (lastChar <= 0) {
+ break;
+ }
+ chunkPtr++;
+ }
+}
+
+void
+TkDrawAngledTextLayout(
+ Display *display, /* Display on which to draw. */
+ Drawable drawable, /* Window or pixmap in which to draw. */
+ GC gc, /* Graphics context to use for drawing
+ * text. */
+ Tk_TextLayout layout, /* Layout information, from a previous call to
+ * Tk_ComputeTextLayout(). */
+ int x, int y, /* Upper-left hand corner of rectangle in
+ * which to draw (pixels). */
+ double angle,
+ int firstChar, /* The index of the first character to draw
+ * from the given text item. 0 specfies the
+ * beginning. */
+ int lastChar) /* The index just after the last character to
+ * draw from the given text item. A number < 0
+ * means to draw all characters. */
+{
+ TextLayout *layoutPtr = (TextLayout *) layout;
+ int i, numDisplayChars, drawX;
+ const char *firstByte, *lastByte;
+ LayoutChunk *chunkPtr;
+ double sinA = sin(angle * PI/180.0), cosA = cos(angle * PI/180.0);
+
+ if (layoutPtr == NULL) {
+ return;
+ }
+
+ if (lastChar < 0) {
+ lastChar = 100000000;
+ }
+ chunkPtr = layoutPtr->chunks;
+ for (i = 0; i < layoutPtr->numChunks; i++) {
+ numDisplayChars = chunkPtr->numDisplayChars;
+ if ((numDisplayChars > 0) && (firstChar < numDisplayChars)) {
+ double dx, dy;
+
+ if (firstChar <= 0) {
+ drawX = 0;
+ firstChar = 0;
+ firstByte = chunkPtr->start;
+ } else {
+ firstByte = Tcl_UtfAtIndex(chunkPtr->start, firstChar);
+ Tk_MeasureChars(layoutPtr->tkfont, chunkPtr->start,
+ firstByte - chunkPtr->start, -1, 0, &drawX);
+ }
+ if (lastChar < numDisplayChars) {
+ numDisplayChars = lastChar;
+ }
+ lastByte = Tcl_UtfAtIndex(chunkPtr->start, numDisplayChars);
+ dx = cosA * (chunkPtr->x + drawX) + sinA * (chunkPtr->y);
+ dy = -sinA * (chunkPtr->x + drawX) + cosA * (chunkPtr->y);
+ if (angle == 0.0) {
+ Tk_DrawChars(display, drawable, gc, layoutPtr->tkfont,
+ firstByte, lastByte - firstByte,
+ (int)(x + dx), (int)(y + dy));
+ } else {
+ TkDrawAngledChars(display, drawable, gc, layoutPtr->tkfont,
+ firstByte, lastByte - firstByte, x+dx, y+dy, angle);
+ }
+ }
+ firstChar -= chunkPtr->numChars;
+ lastChar -= chunkPtr->numChars;
+ if (lastChar <= 0) {
+ break;
+ }
+ chunkPtr++;
+ }
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * Tk_UnderlineTextLayout --
+ *
+ * Use the information in the Tk_TextLayout token to display an underline
+ * below an individual character. This function does not draw the text,
+ * just the underline.
+ *
+ * This function is useful for simple widgets that need to display
+ * single-font, multi-line text with an individual character underlined
+ * and want Tk to handle the details. To display larger amounts of
+ * underlined text, construct and use an underlined font.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Underline drawn on the screen.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+void
+Tk_UnderlineTextLayout(
+ Display *display, /* Display on which to draw. */
+ Drawable drawable, /* Window or pixmap in which to draw. */
+ GC gc, /* Graphics context to use for drawing text. */
+ Tk_TextLayout layout, /* Layout information, from a previous call to
+ * Tk_ComputeTextLayout(). */
+ int x, int y, /* Upper-left hand corner of rectangle in
+ * which to draw (pixels). */
+ int underline) /* Index of the single character to underline,
+ * or -1 for no underline. */
+{
+ int xx, yy, width, height;
+
+ if ((Tk_CharBbox(layout, underline, &xx, &yy, &width, &height) != 0)
+ && (width != 0)) {
+ TextLayout *layoutPtr = (TextLayout *) layout;
+ TkFont *fontPtr = (TkFont *) layoutPtr->tkfont;
+
+ XFillRectangle(display, drawable, gc, x + xx,
+ y + yy + fontPtr->fm.ascent + fontPtr->underlinePos,
+ (unsigned) width, (unsigned) fontPtr->underlineHeight);
+ }
+}
+
+void
+TkUnderlineAngledTextLayout(
+ Display *display, /* Display on which to draw. */
+ Drawable drawable, /* Window or pixmap in which to draw. */
+ GC gc, /* Graphics context to use for drawing
+ * text. */
+ Tk_TextLayout layout, /* Layout information, from a previous call to
+ * Tk_ComputeTextLayout(). */
+ int x, int y, /* Upper-left hand corner of rectangle in
+ * which to draw (pixels). */
+ double angle,
+ int underline) /* Index of the single character to underline,
+ * or -1 for no underline. */
+{
+ int xx, yy, width, height;
+
+ if (angle == 0.0) {
+ Tk_UnderlineTextLayout(display, drawable, gc, layout, x,y, underline);
+ return;
+ }
+
+ if ((Tk_CharBbox(layout, underline, &xx, &yy, &width, &height) != 0)
+ && (width != 0)) {
+ TextLayout *layoutPtr = (TextLayout *) layout;
+ TkFont *fontPtr = (TkFont *) layoutPtr->tkfont;
+ double sinA = sin(angle*PI/180), cosA = cos(angle*PI/180);
+ double dy = yy + fontPtr->fm.ascent + fontPtr->underlinePos;
+ XPoint points[5];
+
+ /*
+ * Note that we're careful to only round a double value once, which
+ * minimizes roundoff errors.
+ */
+
+ points[0].x = x + ROUND16(xx*cosA + dy*sinA);
+ points[0].y = y + ROUND16(dy*cosA - xx*sinA);
+ points[1].x = x + ROUND16(xx*cosA + dy*sinA + width*cosA);
+ points[1].y = y + ROUND16(dy*cosA - xx*sinA - width*sinA);
+ if (fontPtr->underlineHeight == 1) {
+ /*
+ * Thin underlines look better when rotated when drawn as a line
+ * rather than a rectangle; the rasterizer copes better.
+ */
+
+ XDrawLines(display, drawable, gc, points, 2, CoordModeOrigin);
+ } else {
+ points[2].x = x + ROUND16(xx*cosA + dy*sinA + width*cosA
+ + fontPtr->underlineHeight*sinA);
+ points[2].y = y + ROUND16(dy*cosA - xx*sinA - width*sinA
+ + fontPtr->underlineHeight*cosA);
+ points[3].x = x + ROUND16(xx*cosA + dy*sinA
+ + fontPtr->underlineHeight*sinA);
+ points[3].y = y + ROUND16(dy*cosA - xx*sinA
+ + fontPtr->underlineHeight*cosA);
+ points[4].x = points[0].x;
+ points[4].y = points[0].y;
+ XFillPolygon(display, drawable, gc, points, 5, Complex,
+ CoordModeOrigin);
+ XDrawLines(display, drawable, gc, points, 5, CoordModeOrigin);
+ }
+ }
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * Tk_PointToChar --
+ *
+ * Use the information in the Tk_TextLayout token to determine the
+ * character closest to the given point. The point must be specified with
+ * respect to the upper-left hand corner of the text layout, which is
+ * considered to be located at (0, 0).
+ *
+ * Any point whose y-value is less that 0 will be considered closest to
+ * the first character in the text layout; any point whose y-value is
+ * greater than the height of the text layout will be considered closest
+ * to the last character in the text layout.
+ *
+ * Any point whose x-value is less than 0 will be considered closest to
+ * the first character on that line; any point whose x-value is greater
+ * than the width of the text layout will be considered closest to the
+ * last character on that line.
+ *
+ * Results:
+ * The return value is the index of the character that was closest to the
+ * point. Given a text layout with no characters, the value 0 will always
+ * be returned, referring to a hypothetical zero-width placeholder
+ * character.
+ *
+ * Side effects:
+ * None.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+int
+Tk_PointToChar(
+ Tk_TextLayout layout, /* Layout information, from a previous call to
+ * Tk_ComputeTextLayout(). */
+ int x, int y) /* Coordinates of point to check, with respect
+ * to the upper-left corner of the text
+ * layout. */
+{
+ TextLayout *layoutPtr = (TextLayout *) layout;
+ LayoutChunk *chunkPtr, *lastPtr;
+ TkFont *fontPtr;
+ int i, n, dummy, baseline, pos, numChars;
+
+ if (y < 0) {
+ /*
+ * Point lies above any line in this layout. Return the index of the
+ * first char.
+ */
+
+ return 0;
+ }
+
+ /*
+ * Find which line contains the point.
+ */
+
+ fontPtr = (TkFont *) layoutPtr->tkfont;
+ lastPtr = chunkPtr = layoutPtr->chunks;
+ numChars = 0;
+ for (i = 0; i < layoutPtr->numChunks; i++) {
+ baseline = chunkPtr->y;
+ if (y < baseline + fontPtr->fm.descent) {
+ if (x < chunkPtr->x) {
+ /*
+ * Point is to the left of all chunks on this line. Return the
+ * index of the first character on this line.
+ */
+
+ return numChars;
+ }
+ if (x >= layoutPtr->width) {
+ /*
+ * If point lies off right side of the text layout, return the
+ * last char in the last chunk on this line. Without this, it
+ * might return the index of the first char that was located
+ * outside of the text layout.
+ */
+
+ x = INT_MAX;
+ }
+
+ /*
+ * Examine all chunks on this line to see which one contains the
+ * specified point.
+ */
+
+ lastPtr = chunkPtr;
+ while ((i < layoutPtr->numChunks) && (chunkPtr->y == baseline)) {
+ if (x < chunkPtr->x + chunkPtr->totalWidth) {
+ /*
+ * Point falls on one of the characters in this chunk.
+ */
+
+ if (chunkPtr->numDisplayChars < 0) {
+ /*
+ * This is a special chunk that encapsulates a single
+ * tab or newline char.
+ */
+
+ return numChars;
+ }
+ n = Tk_MeasureChars((Tk_Font) fontPtr, chunkPtr->start,
+ chunkPtr->numBytes, x - chunkPtr->x, 0, &dummy);
+ return numChars + Tcl_NumUtfChars(chunkPtr->start, n);
+ }
+ numChars += chunkPtr->numChars;
+ lastPtr = chunkPtr;
+ chunkPtr++;
+ i++;
+ }
+
+ /*
+ * Point is to the right of all chars in all the chunks on this
+ * line. Return the index just past the last char in the last
+ * chunk on this line.
+ */
+
+ pos = numChars;
+ if (i < layoutPtr->numChunks) {
+ pos--;
+ }
+ return pos;
+ }
+ numChars += chunkPtr->numChars;
+ lastPtr = chunkPtr;
+ chunkPtr++;
+ }
+
+ /*
+ * Point lies below any line in this text layout. Return the index just
+ * past the last char.
+ */
+
+ return (lastPtr->start + lastPtr->numChars) - layoutPtr->string;
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * Tk_CharBbox --
+ *
+ * Use the information in the Tk_TextLayout token to return the bounding
+ * box for the character specified by index.
+ *
+ * The width of the bounding box is the advance width of the character,
+ * and does not include and left- or right-bearing. Any character that
+ * extends partially outside of the text layout is considered to be
+ * truncated at the edge. Any character which is located completely
+ * outside of the text layout is considered to be zero-width and pegged
+ * against the edge.
+ *
+ * The height of the bounding box is the line height for this font,
+ * extending from the top of the ascent to the bottom of the descent.
+ * Information about the actual height of the individual letter is not
+ * available.
+ *
+ * A text layout that contains no characters is considered to contain a
+ * single zero-width placeholder character.
+ *
+ * Results:
+ * The return value is 0 if the index did not specify a character in the
+ * text layout, or non-zero otherwise. In that case, *bbox is filled with
+ * the bounding box of the character.
+ *
+ * Side effects:
+ * None.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+int
+Tk_CharBbox(
+ Tk_TextLayout layout, /* Layout information, from a previous call to
+ * Tk_ComputeTextLayout(). */
+ int index, /* The index of the character whose bbox is
+ * desired. */
+ int *xPtr, int *yPtr, /* Filled with the upper-left hand corner, in
+ * pixels, of the bounding box for the
+ * character specified by index, if
+ * non-NULL. */
+ int *widthPtr, int *heightPtr)
+ /* Filled with the width and height of the
+ * bounding box for the character specified by
+ * index, if non-NULL. */
+{
+ TextLayout *layoutPtr = (TextLayout *) layout;
+ LayoutChunk *chunkPtr;
+ int i, x = 0, w;
+ Tk_Font tkfont;
+ TkFont *fontPtr;
+ const char *end;
+
+ if (index < 0) {
+ return 0;
+ }
+
+ chunkPtr = layoutPtr->chunks;
+ tkfont = layoutPtr->tkfont;
+ fontPtr = (TkFont *) tkfont;
+
+ for (i = 0; i < layoutPtr->numChunks; i++) {
+ if (chunkPtr->numDisplayChars < 0) {
+ if (index == 0) {
+ x = chunkPtr->x;
+ w = chunkPtr->totalWidth;
+ goto check;
+ }
+ } else if (index < chunkPtr->numChars) {
+ end = Tcl_UtfAtIndex(chunkPtr->start, index);
+ if (xPtr != NULL) {
+ Tk_MeasureChars(tkfont, chunkPtr->start,
+ end - chunkPtr->start, -1, 0, &x);
+ x += chunkPtr->x;
+ }
+ if (widthPtr != NULL) {
+ Tk_MeasureChars(tkfont, end, Tcl_UtfNext(end) - end,
+ -1, 0, &w);
+ }
+ goto check;
+ }
+ index -= chunkPtr->numChars;
+ chunkPtr++;
+ }
+ if (index != 0) {
+ return 0;
+ }
+
+ /*
+ * Special case to get location just past last char in layout.
+ */
+
+ chunkPtr--;
+ x = chunkPtr->x + chunkPtr->totalWidth;
+ w = 0;
+
+ /*
+ * Ensure that the bbox lies within the text layout. This forces all chars
+ * that extend off the right edge of the text layout to have truncated
+ * widths, and all chars that are completely off the right edge of the
+ * text layout to peg to the edge and have 0 width.
+ */
+
+ check:
+ if (yPtr != NULL) {
+ *yPtr = chunkPtr->y - fontPtr->fm.ascent;
+ }
+ if (heightPtr != NULL) {
+ *heightPtr = fontPtr->fm.ascent + fontPtr->fm.descent;
+ }
+
+ if (x > layoutPtr->width) {
+ x = layoutPtr->width;
+ }
+ if (xPtr != NULL) {
+ *xPtr = x;
+ }
+ if (widthPtr != NULL) {
+ if (x + w > layoutPtr->width) {
+ w = layoutPtr->width - x;
+ }
+ *widthPtr = w;
+ }
+
+ return 1;
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * Tk_DistanceToTextLayout --
+ *
+ * Computes the distance in pixels from the given point to the given text
+ * layout. Non-displaying space characters that occur at the end of
+ * individual lines in the text layout are ignored for hit detection
+ * purposes.
+ *
+ * Results:
+ * The return value is 0 if the point (x, y) is inside the text layout.
+ * If the point isn't inside the text layout then the return value is the
+ * distance in pixels from the point to the text item.
+ *
+ * Side effects:
+ * None.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+int
+Tk_DistanceToTextLayout(
+ Tk_TextLayout layout, /* Layout information, from a previous call
+ * to Tk_ComputeTextLayout(). */
+ int x, int y) /* Coordinates of point to check, with respect
+ * to the upper-left corner of the text layout
+ * (in pixels). */
+{
+ int i, x1, x2, y1, y2, xDiff, yDiff, dist, minDist, ascent, descent;
+ TextLayout *layoutPtr = (TextLayout *) layout;
+ LayoutChunk *chunkPtr;
+ TkFont *fontPtr;
+
+ fontPtr = (TkFont *) layoutPtr->tkfont;
+ ascent = fontPtr->fm.ascent;
+ descent = fontPtr->fm.descent;
+
+ minDist = 0;
+ chunkPtr = layoutPtr->chunks;
+ for (i = 0; i < layoutPtr->numChunks; i++) {
+ if (chunkPtr->start[0] == '\n') {
+ /*
+ * Newline characters are not counted when computing distance (but
+ * tab characters would still be considered).
+ */
+
+ chunkPtr++;
+ continue;
+ }
+
+ x1 = chunkPtr->x;
+ y1 = chunkPtr->y - ascent;
+ x2 = chunkPtr->x + chunkPtr->displayWidth;
+ y2 = chunkPtr->y + descent;
+
+ if (x < x1) {
+ xDiff = x1 - x;
+ } else if (x >= x2) {
+ xDiff = x - x2 + 1;
+ } else {
+ xDiff = 0;
+ }
+
+ if (y < y1) {
+ yDiff = y1 - y;
+ } else if (y >= y2) {
+ yDiff = y - y2 + 1;
+ } else {
+ yDiff = 0;
+ }
+ if ((xDiff == 0) && (yDiff == 0)) {
+ return 0;
+ }
+ dist = (int) hypot((double) xDiff, (double) yDiff);
+ if ((dist < minDist) || (minDist == 0)) {
+ minDist = dist;
+ }
+ chunkPtr++;
+ }
+ return minDist;
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * Tk_IntersectTextLayout --
+ *
+ * Determines whether a text layout lies entirely inside, entirely
+ * outside, or overlaps a given rectangle. Non-displaying space
+ * characters that occur at the end of individual lines in the text
+ * layout are ignored for intersection calculations.
+ *
+ * Results:
+ * The return value is -1 if the text layout is entirely outside of the
+ * rectangle, 0 if it overlaps, and 1 if it is entirely inside of the
+ * rectangle.
+ *
+ * Side effects:
+ * None.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+int
+Tk_IntersectTextLayout(
+ Tk_TextLayout layout, /* Layout information, from a previous call to
+ * Tk_ComputeTextLayout(). */
+ int x, int y, /* Upper-left hand corner, in pixels, of
+ * rectangular area to compare with text
+ * layout. Coordinates are with respect to the
+ * upper-left hand corner of the text layout
+ * itself. */
+ int width, int height) /* The width and height of the above
+ * rectangular area, in pixels. */
+{
+ int result, i, x1, y1, x2, y2;
+ TextLayout *layoutPtr = (TextLayout *) layout;
+ LayoutChunk *chunkPtr;
+ TkFont *fontPtr;
+ int left, top, right, bottom;
+
+ /*
+ * Scan the chunks one at a time, seeing whether each is entirely in,
+ * entirely out, or overlapping the rectangle. If an overlap is detected,
+ * return immediately; otherwise wait until all chunks have been processed
+ * and see if they were all inside or all outside.
+ */
+
+ chunkPtr = layoutPtr->chunks;
+ fontPtr = (TkFont *) layoutPtr->tkfont;
+
+ left = x;
+ top = y;
+ right = x + width;
+ bottom = y + height;
+
+ result = 0;
+ for (i = 0; i < layoutPtr->numChunks; i++) {
+ if ((chunkPtr->start[0] == '\n') || (chunkPtr->numBytes == 0)) {
+ /*
+ * Newline characters and empty chunks are not counted when
+ * computing area intersection (but tab characters would still be
+ * considered).
+ */
+
+ chunkPtr++;
+ continue;
+ }
+
+ x1 = chunkPtr->x;
+ y1 = chunkPtr->y - fontPtr->fm.ascent;
+ x2 = chunkPtr->x + chunkPtr->displayWidth;
+ y2 = chunkPtr->y + fontPtr->fm.descent;
+
+ if ((right < x1) || (left >= x2)
+ || (bottom < y1) || (top >= y2)) {
+ if (result == 1) {
+ return 0;
+ }
+ result = -1;
+ } else if ((x1 < left) || (x2 >= right)
+ || (y1 < top) || (y2 >= bottom)) {
+ return 0;
+ } else if (result == -1) {
+ return 0;
+ } else {
+ result = 1;
+ }
+ chunkPtr++;
+ }
+ return result;
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * TkIntersectAngledTextLayout --
+ *
+ * Determines whether a text layout that has been turned by an angle
+ * about its top-left coordinae lies entirely inside, entirely outside,
+ * or overlaps a given rectangle. Non-displaying space characters that
+ * occur at the end of individual lines in the text layout are ignored
+ * for intersection calculations.
+ *
+ * Results:
+ * The return value is -1 if the text layout is entirely outside of the
+ * rectangle, 0 if it overlaps, and 1 if it is entirely inside of the
+ * rectangle.
+ *
+ * Side effects:
+ * None.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+static inline int
+PointInQuadrilateral(
+ double qx[],
+ double qy[],
+ double x,
+ double y)
+{
+ int i;
+
+ for (i=0 ; i<4 ; i++) {
+ double sideDX = qx[(i+1)%4] - qx[i];
+ double sideDY = qy[(i+1)%4] - qy[i];
+ double dx = x - qx[i];
+ double dy = y - qy[i];
+
+ if (sideDX*dy < sideDY*dx) {
+ return 0;
+ }
+ }
+ return 1;
+}
+
+static inline int
+SidesIntersect(
+ double ax1, double ay1, double ax2, double ay2,
+ double bx1, double by1, double bx2, double by2)
+{
+#if 0
+/* http://www.freelunchdesign.com/cgi-bin/codwiki.pl?DiscussionTopics/CollideMeUpBaby */
+
+ double a1, b1, c1, a2, b2, c2, r1, r2, r3, r4, denom;
+
+ a1 = ay2 - ay1;
+ b1 = ax1 - ax2;
+ c1 = (ax2 * ay1) - (ax1 * ay2);
+ r3 = (a1 * bx1) + (b1 * by1) + c1;
+ r4 = (a1 * bx2) + (b1 * by2) + c1;
+ if ((r3 != 0.0) && (r4 != 0.0) && (r3*r4 > 0.0)) {
+ return 0;
+ }
+
+ a2 = by2 - by1;
+ b2 = bx1 - bx2;
+ c2 = (bx2 * by1) - (bx1 * by2);
+ r1 = (a2 * ax1) + (b2 * ay1) + c2;
+ r2 = (a2 * ax2) + (b2 * ay2) + c2;
+ if ((r1 != 0.0) && (r2 != 0.0) && (r1*r2 > 0.0)) {
+ return 0;
+ }
+
+ denom = (a1 * b2) - (a2 * b1);
+ return (denom != 0.0);
+#else
+ /*
+ * A more efficient version. Two line segments intersect if, when seen
+ * from the perspective of one line, the two endpoints of the other
+ * segment lie on opposite sides of the line, and vice versa. "Lie on
+ * opposite sides" is computed by taking the cross products and seeing if
+ * they are of opposite signs.
+ */
+
+ double dx, dy, dx1, dy1;
+
+ dx = ax2 - ax1;
+ dy = ay2 - ay1;
+ dx1 = bx1 - ax1;
+ dy1 = by1 - ay1;
+ if ((dx*dy1-dy*dx1 > 0.0) == (dx*(by2-ay1)-dy*(bx2-ax1) > 0.0)) {
+ return 0;
+ }
+ dx = bx2 - bx1;
+ dy = by2 - by1;
+ if ((dy*dx1-dx*dy1 > 0.0) == (dx*(ay2-by1)-dy*(ax2-bx1) > 0.0)) {
+ return 0;
+ }
+ return 1;
+#endif
+}
+
+int
+TkIntersectAngledTextLayout(
+ Tk_TextLayout layout, /* Layout information, from a previous call to
+ * Tk_ComputeTextLayout(). */
+ int x, int y, /* Upper-left hand corner, in pixels, of
+ * rectangular area to compare with text
+ * layout. Coordinates are with respect to the
+ * upper-left hand corner of the text layout
+ * itself. */
+ int width, int height, /* The width and height of the above
+ * rectangular area, in pixels. */
+ double angle)
+{
+ int i, x1, y1, x2, y2;
+ TextLayout *layoutPtr;
+ LayoutChunk *chunkPtr;
+ TkFont *fontPtr;
+ double c = cos(angle * PI/180.0), s = sin(angle * PI/180.0);
+ double rx[4], ry[4];
+
+ if (angle == 0.0) {
+ return Tk_IntersectTextLayout(layout, x, y, width, height);
+ }
+
+ /*
+ * Compute the coordinates of the rectangle, rotated into text layout
+ * space.
+ */
+
+ rx[0] = x*c - y*s;
+ ry[0] = y*c + x*s;
+ rx[1] = (x+width)*c - y*s;
+ ry[1] = y*c + (x+width)*s;
+ rx[2] = (x+width)*c - (y+height)*s;
+ ry[2] = (y+height)*c + (x+width)*s;
+ rx[3] = x*c - (y+height)*s;
+ ry[3] = (y+height)*c + x*s;
+
+ /*
+ * Want to know if all chunks are inside the rectangle, or if there is any
+ * overlap. First, we check to see if all chunks are inside; if and only
+ * if they are, we're in the "inside" case.
+ */
+
+ layoutPtr = (TextLayout *) layout;
+ chunkPtr = layoutPtr->chunks;
+ fontPtr = (TkFont *) layoutPtr->tkfont;
+
+ for (i=0 ; i<layoutPtr->numChunks ; i++,chunkPtr++) {
+ if (chunkPtr->start[0] == '\n') {
+ /*
+ * Newline characters are not counted when computing area
+ * intersection (but tab characters would still be considered).
+ */
+
+ continue;
+ }
+
+ x1 = chunkPtr->x;
+ y1 = chunkPtr->y - fontPtr->fm.ascent;
+ x2 = chunkPtr->x + chunkPtr->displayWidth;
+ y2 = chunkPtr->y + fontPtr->fm.descent;
+ if ( !PointInQuadrilateral(rx, ry, x1, y1) ||
+ !PointInQuadrilateral(rx, ry, x2, y1) ||
+ !PointInQuadrilateral(rx, ry, x2, y2) ||
+ !PointInQuadrilateral(rx, ry, x1, y2)) {
+ goto notInside;
+ }
+ }
+ return 1;
+
+ /*
+ * Next, check to see if all the points of the rectangle are inside a
+ * single chunk; if they are, we're in an "overlap" case.
+ */
+
+ notInside:
+ chunkPtr = layoutPtr->chunks;
+
+ for (i=0 ; i<layoutPtr->numChunks ; i++,chunkPtr++) {
+ double cx[4], cy[4];
+
+ if (chunkPtr->start[0] == '\n') {
+ /*
+ * Newline characters are not counted when computing area
+ * intersection (but tab characters would still be considered).
+ */
+
+ continue;
+ }
+
+ cx[0] = cx[3] = chunkPtr->x;
+ cy[0] = cy[1] = chunkPtr->y - fontPtr->fm.ascent;
+ cx[1] = cx[2] = chunkPtr->x + chunkPtr->displayWidth;
+ cy[2] = cy[3] = chunkPtr->y + fontPtr->fm.descent;
+ if ( !PointInQuadrilateral(cx, cy, rx[0], ry[0]) ||
+ !PointInQuadrilateral(cx, cy, rx[1], ry[1]) ||
+ !PointInQuadrilateral(cx, cy, rx[2], ry[2]) ||
+ !PointInQuadrilateral(cx, cy, rx[3], ry[3])) {
+ goto notReverseInside;
+ }
+ }
+ return 0;
+
+ /*
+ * If we're overlapping now, we must be partially in and out of at least
+ * one chunk. If that is the case, there must be one line segment of the
+ * rectangle that is touching or crossing a line segment of a chunk.
+ */
+
+ notReverseInside:
+ chunkPtr = layoutPtr->chunks;
+
+ for (i=0 ; i<layoutPtr->numChunks ; i++,chunkPtr++) {
+ int j;
+
+ if (chunkPtr->start[0] == '\n') {
+ /*
+ * Newline characters are not counted when computing area
+ * intersection (but tab characters would still be considered).
+ */
+
+ continue;
+ }
+
+ x1 = chunkPtr->x;
+ y1 = chunkPtr->y - fontPtr->fm.ascent;
+ x2 = chunkPtr->x + chunkPtr->displayWidth;
+ y2 = chunkPtr->y + fontPtr->fm.descent;
+
+ for (j=0 ; j<4 ; j++) {
+ int k = (j+1) % 4;
+
+ if ( SidesIntersect(rx[j],ry[j], rx[k],ry[k], x1,y1, x2,y1) ||
+ SidesIntersect(rx[j],ry[j], rx[k],ry[k], x2,y1, x2,y2) ||
+ SidesIntersect(rx[j],ry[j], rx[k],ry[k], x2,y2, x1,y2) ||
+ SidesIntersect(rx[j],ry[j], rx[k],ry[k], x1,y2, x1,y1)) {
+ return 0;
+ }
+ }
+ }
+
+ /*
+ * They must be wholly non-overlapping.
+ */
+
+ return -1;
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * Tk_TextLayoutToPostscript --
+ *
+ * Outputs the contents of a text layout in Postscript format. The set of
+ * lines in the text layout will be rendered by the user supplied
+ * Postscript function. The function should be of the form:
+ *
+ * justify x y string function --
+ *
+ * Justify is -1, 0, or 1, depending on whether the following string
+ * should be left, center, or right justified, x and y is the location
+ * for the origin of the string, string is the sequence of characters to
+ * be printed, and function is the name of the caller-provided function;
+ * the function should leave nothing on the stack.
+ *
+ * The meaning of the origin of the string (x and y) depends on the
+ * justification. For left justification, x is where the left edge of the
+ * string should appear. For center justification, x is where the center
+ * of the string should appear. And for right justification, x is where
+ * the right edge of the string should appear. This behavior is necessary
+ * because, for example, right justified text on the screen is justified
+ * with screen metrics. The same string needs to be justified with
+ * printer metrics on the printer to appear in the correct place with
+ * respect to other similarly justified strings. In all circumstances, y
+ * is the location of the baseline for the string.
+ *
+ * Results:
+ * The interp's result is modified to hold the Postscript code that will
+ * render the text layout.
+ *
+ * Side effects:
+ * None.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+void
+Tk_TextLayoutToPostscript(
+ Tcl_Interp *interp, /* Filled with Postscript code. */
+ Tk_TextLayout layout) /* The layout to be rendered. */
+{
+ TextLayout *layoutPtr = (TextLayout *) layout;
+ LayoutChunk *chunkPtr = layoutPtr->chunks;
+ int baseline = chunkPtr->y;
+ Tcl_Obj *psObj = Tcl_NewObj();
+ int i, j, len;
+ const char *p, *glyphname;
+ char uindex[5], c, *ps;
+ Tcl_UniChar ch;
+
+ Tcl_AppendToObj(psObj, "[(", -1);
+ for (i = 0; i < layoutPtr->numChunks; i++, chunkPtr++) {
+ if (baseline != chunkPtr->y) {
+ Tcl_AppendToObj(psObj, ")]\n[(", -1);
+ baseline = chunkPtr->y;
+ }
+ if (chunkPtr->numDisplayChars <= 0) {
+ if (chunkPtr->start[0] == '\t') {
+ Tcl_AppendToObj(psObj, "\\t", -1);
+ }
+ continue;
+ }
+
+ for (p=chunkPtr->start, j=0; j<chunkPtr->numDisplayChars; j++) {
+ /*
+ * INTL: We only handle symbols that have an encoding as a glyph
+ * from the standard set defined by Adobe. The rest get punted.
+ * Eventually this should be revised to handle more sophsticiated
+ * international postscript fonts.
+ */
+
+ p += Tcl_UtfToUniChar(p, &ch);
+ if ((ch == '(') || (ch == ')') || (ch == '\\') || (ch < 0x20)) {
+ /*
+ * Tricky point: the "03" is necessary in the sprintf below,
+ * so that a full three digits of octal are always generated.
+ * Without the "03", a number following this sequence could be
+ * interpreted by Postscript as part of this sequence.
+ */
+
+ Tcl_AppendPrintfToObj(psObj, "\\%03o", ch);
+ continue;
+ } else if (ch <= 0x7f) {
+ /*
+ * Normal ASCII character.
+ */
+
+ c = (char) ch;
+ Tcl_AppendToObj(psObj, &c, 1);
+ continue;
+ }
+
+ /*
+ * This character doesn't belong to the ASCII character set, so we
+ * use the full glyph name.
+ */
+
+ sprintf(uindex, "%04X", ch); /* endianness? */
+ glyphname = Tcl_GetVar2(interp, "::tk::psglyphs", uindex, 0);
+ if (glyphname) {
+ ps = Tcl_GetStringFromObj(psObj, &len);
+ if (ps[len-1] == '(') {
+ /*
+ * In-place edit. Ewww!
+ */
+
+ ps[len-1] = '/';
+ } else {
+ Tcl_AppendToObj(psObj, ")/", -1);
+ }
+ Tcl_AppendToObj(psObj, glyphname, -1);
+ Tcl_AppendToObj(psObj, "(", -1);
+ } else {
+ /*
+ * No known mapping for the character into the space of
+ * PostScript glyphs. Ignore it. :-(
+ */
+
+#ifdef TK_DEBUG_POSTSCRIPT_OUTPUT
+ fprintf(stderr, "Warning: no mapping to PostScript "
+ "glyphs for \\u%04x\n", ch);
+#endif
+ }
+ }
+ }
+ Tcl_AppendToObj(psObj, ")]\n", -1);
+ Tcl_AppendObjToObj(Tcl_GetObjResult(interp), psObj);
+ Tcl_DecrRefCount(psObj);
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * ConfigAttributesObj --
+ *
+ * Process command line options to fill in fields of a properly
+ * initialized font attributes structure.
+ *
+ * Results:
+ * A standard Tcl return value. If TCL_ERROR is returned, an error
+ * message will be left in interp's result object.
+ *
+ * Side effects:
+ * The fields of the font attributes structure get filled in with
+ * information from argc/argv. If an error occurs while parsing, the font
+ * attributes structure will contain all modifications specified in the
+ * command line options up to the point of the error.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+static int
+ConfigAttributesObj(
+ Tcl_Interp *interp, /* Interp for error return. */
+ Tk_Window tkwin, /* For display on which font will be used. */
+ int objc, /* Number of elements in argv. */
+ Tcl_Obj *const objv[], /* Command line options. */
+ TkFontAttributes *faPtr) /* Font attributes structure whose fields are
+ * to be modified. Structure must already be
+ * properly initialized. */
+{
+ int i, n, index;
+ Tcl_Obj *optionPtr, *valuePtr;
+ const char *value;
+
+ for (i = 0; i < objc; i += 2) {
+ optionPtr = objv[i];
+
+ 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.
+ */
+
+ if (interp != NULL) {
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "value for \"%s\" option missing",
+ Tcl_GetString(optionPtr)));
+ Tcl_SetErrorCode(interp, "TK", "FONT", "NO_ATTRIBUTE", NULL);
+ }
+ return TCL_ERROR;
+ }
+ valuePtr = objv[i + 1];
+
+ switch (index) {
+ case FONT_FAMILY:
+ value = Tcl_GetString(valuePtr);
+ faPtr->family = Tk_GetUid(value);
+ break;
+ case FONT_SIZE:
+ if (Tcl_GetIntFromObj(interp, valuePtr, &n) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ faPtr->size = n;
+ break;
+ case FONT_WEIGHT:
+ n = TkFindStateNumObj(interp, optionPtr, weightMap, valuePtr);
+ if (n == TK_FW_UNKNOWN) {
+ return TCL_ERROR;
+ }
+ faPtr->weight = n;
+ break;
+ case FONT_SLANT:
+ n = TkFindStateNumObj(interp, optionPtr, slantMap, valuePtr);
+ if (n == TK_FS_UNKNOWN) {
+ return TCL_ERROR;
+ }
+ faPtr->slant = n;
+ break;
+ case FONT_UNDERLINE:
+ if (Tcl_GetBooleanFromObj(interp, valuePtr, &n) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ faPtr->underline = n;
+ break;
+ case FONT_OVERSTRIKE:
+ if (Tcl_GetBooleanFromObj(interp, valuePtr, &n) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ faPtr->overstrike = n;
+ break;
+ }
+ }
+ return TCL_OK;
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * GetAttributeInfoObj --
+ *
+ * Return information about the font attributes as a Tcl list.
+ *
+ * Results:
+ * The return value is TCL_OK if the objPtr was non-NULL and specified a
+ * valid font attribute, TCL_ERROR otherwise. If TCL_OK is returned, the
+ * interp's result object is modified to hold a description of either the
+ * current value of a single option, or a list of all options and their
+ * current values for the given font attributes. If TCL_ERROR is
+ * returned, the interp's result is set to an error message describing
+ * that the objPtr did not refer to a valid option.
+ *
+ * Side effects:
+ * None.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+static int
+GetAttributeInfoObj(
+ Tcl_Interp *interp, /* Interp to hold result. */
+ const TkFontAttributes *faPtr,
+ /* The font attributes to inspect. */
+ Tcl_Obj *objPtr) /* If non-NULL, indicates the single option
+ * whose value is to be returned. Otherwise
+ * information is returned for all options. */
+{
+ int i, index, start, end;
+ const char *str;
+ Tcl_Obj *valuePtr, *resultPtr = NULL;
+
+ start = 0;
+ end = FONT_NUMFIELDS;
+ if (objPtr != NULL) {
+ if (Tcl_GetIndexFromObj(interp, objPtr, fontOpt, "option", TCL_EXACT,
+ &index) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ start = index;
+ end = index + 1;
+ }
+
+ valuePtr = NULL;
+ if (objPtr == NULL) {
+ resultPtr = Tcl_NewObj();
+ }
+ for (i = start; i < end; i++) {
+ switch (i) {
+ case FONT_FAMILY:
+ str = faPtr->family;
+ valuePtr = Tcl_NewStringObj(str, ((str == NULL) ? 0 : -1));
+ break;
+
+ case FONT_SIZE:
+ valuePtr = Tcl_NewIntObj(faPtr->size);
+ break;
+
+ case FONT_WEIGHT:
+ str = TkFindStateString(weightMap, faPtr->weight);
+ valuePtr = Tcl_NewStringObj(str, -1);
+ break;
+
+ case FONT_SLANT:
+ str = TkFindStateString(slantMap, faPtr->slant);
+ valuePtr = Tcl_NewStringObj(str, -1);
+ break;
+
+ case FONT_UNDERLINE:
+ valuePtr = Tcl_NewBooleanObj(faPtr->underline);
+ break;
+
+ case FONT_OVERSTRIKE:
+ valuePtr = Tcl_NewBooleanObj(faPtr->overstrike);
+ break;
+ }
+ if (objPtr != NULL) {
+ Tcl_SetObjResult(interp, valuePtr);
+ return TCL_OK;
+ }
+ Tcl_ListObjAppendElement(NULL, resultPtr,
+ Tcl_NewStringObj(fontOpt[i], -1));
+ Tcl_ListObjAppendElement(NULL, resultPtr, valuePtr);
+ }
+ Tcl_SetObjResult(interp, resultPtr);
+ return TCL_OK;
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * ParseFontNameObj --
+ *
+ * Converts a object into a set of font attributes that can be used to
+ * construct a font.
+ *
+ * The string rep of the object can be one of the following forms:
+ * XLFD (see X documentation)
+ * "family [size] [style1 [style2 ...]"
+ * "-option value [-option value ...]"
+ *
+ * Results:
+ * The return value is TCL_ERROR if the object was syntactically invalid.
+ * In that case an error message is left in interp's result object.
+ * Otherwise, fills the font attribute buffer with the values parsed from
+ * the string and returns TCL_OK;
+ *
+ * Side effects:
+ * None.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+static int
+ParseFontNameObj(
+ Tcl_Interp *interp, /* Interp for error return. */
+ Tk_Window tkwin, /* For display on which font is used. */
+ Tcl_Obj *objPtr, /* Parseable font description object. */
+ TkFontAttributes *faPtr) /* 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;
+ const char *string;
+
+ TkInitFontAttributes(faPtr);
+
+ string = Tcl_GetString(objPtr);
+ if (*string == '-') {
+ /*
+ * This may be an XLFD or an "-option value" string.
+ *
+ * If the string begins with "-*" or a "-foundry-family-*" pattern,
+ * then consider it an XLFD.
+ */
+
+ if (string[1] == '*') {
+ goto xlfd;
+ }
+ dash = strchr(string + 1, '-');
+ if ((dash != NULL)
+ && !isspace(UCHAR(dash[-1]))) { /* INTL: ISO space */
+ goto xlfd;
+ }
+
+ if (Tcl_ListObjGetElements(interp, objPtr, &objc, &objv) != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ return ConfigAttributesObj(interp, tkwin, objc, objv, faPtr);
+ }
+
+ if (*string == '*') {
+ /*
+ * This is appears to be an XLFD. Under Unix, all valid XLFDs were
+ * already handled by TkpGetNativeFont. If we are here, either we have
+ * something that initially looks like an XLFD but isn't or we have
+ * encountered an XLFD on Windows or Mac.
+ */
+
+ xlfd:
+ result = TkFontParseXLFD(string, faPtr, NULL);
+ if (result == TCL_OK) {
+ return TCL_OK;
+ }
+
+ /*
+ * If the string failed to parse but was considered to be a XLFD
+ * then it may be a "-option value" string with a hyphenated family
+ * name as per bug 2791352
+ */
+
+ if (Tcl_ListObjGetElements(interp, objPtr, &objc, &objv) != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ if (ConfigAttributesObj(interp, tkwin, objc, objv, faPtr) == TCL_OK) {
+ return TCL_OK;
+ }
+ }
+
+ /*
+ * Wasn't an XLFD or "-option value" string. Try it as a "font size style"
+ * list.
+ */
+
+ if ((Tcl_ListObjGetElements(NULL, objPtr, &objc, &objv) != TCL_OK)
+ || (objc < 1)) {
+ if (interp != NULL) {
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "font \"%s\" doesn't exist", string));
+ Tcl_SetErrorCode(interp, "TK", "LOOKUP", "FONT", string, NULL);
+ }
+ return TCL_ERROR;
+ }
+
+ faPtr->family = Tk_GetUid(Tcl_GetString(objv[0]));
+ if (objc > 1) {
+ if (Tcl_GetIntFromObj(interp, objv[1], &n) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ faPtr->size = n;
+ }
+
+ i = 2;
+ if (objc == 3) {
+ if (Tcl_ListObjGetElements(interp, objv[2], &objc, &objv) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ i = 0;
+ }
+ for ( ; i < objc; i++) {
+ n = TkFindStateNumObj(NULL, NULL, weightMap, objv[i]);
+ if (n != TK_FW_UNKNOWN) {
+ faPtr->weight = n;
+ continue;
+ }
+ n = TkFindStateNumObj(NULL, NULL, slantMap, objv[i]);
+ if (n != TK_FS_UNKNOWN) {
+ faPtr->slant = n;
+ continue;
+ }
+ n = TkFindStateNumObj(NULL, NULL, underlineMap, objv[i]);
+ if (n != 0) {
+ faPtr->underline = n;
+ continue;
+ }
+ n = TkFindStateNumObj(NULL, NULL, overstrikeMap, objv[i]);
+ if (n != 0) {
+ faPtr->overstrike = n;
+ continue;
+ }
+
+ /*
+ * Unknown style.
+ */
+
+ if (interp != NULL) {
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "unknown font style \"%s\"", Tcl_GetString(objv[i])));
+ Tcl_SetErrorCode(interp, "TK", "LOOKUP", "FONT_STYLE",
+ Tcl_GetString(objv[i]), NULL);
+ }
+ return TCL_ERROR;
+ }
+ return TCL_OK;
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * NewChunk --
+ *
+ * Helper function for Tk_ComputeTextLayout(). Encapsulates a measured
+ * set of characters in a chunk that can be quickly drawn.
+ *
+ * Results:
+ * A pointer to the new chunk in the text layout.
+ *
+ * Side effects:
+ * The text layout is reallocated to hold more chunks as necessary.
+ *
+ * Currently, Tk_ComputeTextLayout() stores contiguous ranges of "normal"
+ * characters in a chunk, along with individual tab and newline chars in
+ * their own chunks. All characters in the text layout are accounted for.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+static LayoutChunk *
+NewChunk(
+ 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 = ckrealloc(layoutPtr, s);
+
+ *layoutPtrPtr = layoutPtr;
+ *maxPtr = maxChunks;
+ }
+ numChars = Tcl_NumUtfChars(start, numBytes);
+ chunkPtr = &layoutPtr->chunks[layoutPtr->numChunks];
+ chunkPtr->start = start;
+ chunkPtr->numBytes = numBytes;
+ chunkPtr->numChars = numChars;
+ chunkPtr->numDisplayChars = numChars;
+ chunkPtr->x = curX;
+ chunkPtr->y = y;
+ chunkPtr->totalWidth = newX - curX;
+ chunkPtr->displayWidth = newX - curX;
+ layoutPtr->numChunks++;
+
+ return chunkPtr;
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * TkFontParseXLFD --
+ *
+ * Break up a fully specified XLFD into a set of font attributes.
+ *
+ * Results:
+ * Return value is TCL_ERROR if string was not a fully specified XLFD.
+ * Otherwise, fills font attribute buffer with the values parsed from the
+ * XLFD and returns TCL_OK.
+ *
+ * Side effects:
+ * None.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+int
+TkFontParseXLFD(
+ const char *string, /* Parseable font description string. */
+ TkFontAttributes *faPtr, /* Filled with attributes parsed from font
+ * name. Any attributes that were not
+ * specified in font name are filled with
+ * default values. */
+ TkXLFDAttributes *xaPtr) /* Filled with X-specific attributes parsed
+ * from font name. Any attributes that were
+ * not specified in font name are filled with
+ * default values. May be NULL if such
+ * information is not desired. */
+{
+ char *src;
+ const char *str;
+ int i, j;
+ char *field[XLFD_NUMFIELDS + 2];
+ Tcl_DString ds;
+ TkXLFDAttributes xa;
+
+ if (xaPtr == NULL) {
+ xaPtr = &xa;
+ }
+ TkInitFontAttributes(faPtr);
+ TkInitXLFDAttributes(xaPtr);
+
+ memset(field, '\0', sizeof(field));
+
+ str = string;
+ if (*str == '-') {
+ str++;
+ }
+
+ Tcl_DStringInit(&ds);
+ Tcl_DStringAppend(&ds, str, -1);
+ src = Tcl_DStringValue(&ds);
+
+ field[0] = src;
+ for (i = 0; *src != '\0'; src++) {
+ if (!(*src & 0x80)
+ && Tcl_UniCharIsUpper(UCHAR(*src))) {
+ *src = (char) Tcl_UniCharToLower(UCHAR(*src));
+ }
+ if (*src == '-') {
+ i++;
+ if (i == XLFD_NUMFIELDS) {
+ continue;
+ }
+ *src = '\0';
+ field[i] = src + 1;
+ if (i > XLFD_NUMFIELDS) {
+ break;
+ }
+ }
+ }
+
+ /*
+ * An XLFD of the form -adobe-times-medium-r-*-12-*-* is pretty common,
+ * but it is (strictly) malformed, because the first * is eliding both the
+ * Setwidth and the Addstyle fields. If the Addstyle field is a number,
+ * then assume the above incorrect form was used and shift all the rest of
+ * the fields right by one, so the number gets interpreted as a pixelsize.
+ * This fix is so that we don't get a million reports that "it works under
+ * X (as a native font name), but gives a syntax error under Windows (as a
+ * parsed set of attributes)".
+ */
+
+ if ((i > XLFD_ADD_STYLE) && FieldSpecified(field[XLFD_ADD_STYLE])) {
+ if (atoi(field[XLFD_ADD_STYLE]) != 0) {
+ for (j = XLFD_NUMFIELDS - 1; j >= XLFD_ADD_STYLE; j--) {
+ field[j + 1] = field[j];
+ }
+ field[XLFD_ADD_STYLE] = NULL;
+ i++;
+ }
+ }
+
+ /*
+ * Bail if we don't have enough of the fields (up to pointsize).
+ */
+
+ if (i < XLFD_FAMILY) {
+ Tcl_DStringFree(&ds);
+ return TCL_ERROR;
+ }
+
+ if (FieldSpecified(field[XLFD_FOUNDRY])) {
+ xaPtr->foundry = Tk_GetUid(field[XLFD_FOUNDRY]);
+ }
+
+ if (FieldSpecified(field[XLFD_FAMILY])) {
+ faPtr->family = Tk_GetUid(field[XLFD_FAMILY]);
+ }
+ if (FieldSpecified(field[XLFD_WEIGHT])) {
+ faPtr->weight = TkFindStateNum(NULL, NULL, xlfdWeightMap,
+ field[XLFD_WEIGHT]);
+ }
+ if (FieldSpecified(field[XLFD_SLANT])) {
+ xaPtr->slant = TkFindStateNum(NULL, NULL, xlfdSlantMap,
+ field[XLFD_SLANT]);
+ if (xaPtr->slant == TK_FS_ROMAN) {
+ faPtr->slant = TK_FS_ROMAN;
+ } else {
+ faPtr->slant = TK_FS_ITALIC;
+ }
+ }
+ if (FieldSpecified(field[XLFD_SETWIDTH])) {
+ xaPtr->setwidth = TkFindStateNum(NULL, NULL, xlfdSetwidthMap,
+ field[XLFD_SETWIDTH]);
+ }
+
+ /* XLFD_ADD_STYLE ignored. */
+
+ /*
+ * Pointsize in tenths of a point, but treat it as tenths of a pixel for
+ * historical compatibility.
+ */
+
+ faPtr->size = 12;
+
+ if (FieldSpecified(field[XLFD_POINT_SIZE])) {
+ if (field[XLFD_POINT_SIZE][0] == '[') {
+ /*
+ * Some X fonts have the point size specified as follows:
+ *
+ * [ N1 N2 N3 N4 ]
+ *
+ * where N1 is the point size (in points, not decipoints!), and
+ * N2, N3, and N4 are some additional numbers that I don't know
+ * the purpose of, so I ignore them.
+ */
+
+ faPtr->size = atoi(field[XLFD_POINT_SIZE] + 1);
+ } else if (Tcl_GetInt(NULL, field[XLFD_POINT_SIZE],
+ &faPtr->size) == TCL_OK) {
+ faPtr->size /= 10;
+ } else {
+ return TCL_ERROR;
+ }
+ }
+
+ /*
+ * Pixel height of font. If specified, overrides pointsize.
+ */
+
+ if (FieldSpecified(field[XLFD_PIXEL_SIZE])) {
+ if (field[XLFD_PIXEL_SIZE][0] == '[') {
+ /*
+ * Some X fonts have the pixel size specified as follows:
+ *
+ * [ N1 N2 N3 N4 ]
+ *
+ * where N1 is the pixel size, and where N2, N3, and N4 are some
+ * additional numbers that I don't know the purpose of, so I
+ * ignore them.
+ */
+
+ faPtr->size = atoi(field[XLFD_PIXEL_SIZE] + 1);
+ } else if (Tcl_GetInt(NULL, field[XLFD_PIXEL_SIZE],
+ &faPtr->size) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ }
+
+ faPtr->size = -faPtr->size;
+
+ /* XLFD_RESOLUTION_X ignored. */
+
+ /* XLFD_RESOLUTION_Y ignored. */
+
+ /* XLFD_SPACING ignored. */
+
+ /* XLFD_AVERAGE_WIDTH ignored. */
+
+ if (FieldSpecified(field[XLFD_CHARSET])) {
+ xaPtr->charset = Tk_GetUid(field[XLFD_CHARSET]);
+ } else {
+ xaPtr->charset = Tk_GetUid("iso8859-1");
+ }
+ Tcl_DStringFree(&ds);
+ return TCL_OK;
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * FieldSpecified --
+ *
+ * Helper function for TkParseXLFD(). Determines if a field in the XLFD
+ * was set to a non-null, non-don't-care value.
+ *
+ * Results:
+ * The return value is 0 if the field in the XLFD was not set and should
+ * be ignored, non-zero otherwise.
+ *
+ * Side effects:
+ * None.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+static int
+FieldSpecified(
+ const char *field) /* The field of the XLFD to check. Strictly
+ * speaking, only when the string is "*" does
+ * it mean don't-care. However, an unspecified
+ * or question mark is also interpreted as
+ * don't-care. */
+{
+ char ch;
+
+ if (field == NULL) {
+ return 0;
+ }
+ ch = field[0];
+ return (ch != '*' && ch != '?');
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * TkFontGetPixels --
+ *
+ * Given a font size specification (as described in the TkFontAttributes
+ * structure) return the number of pixels it represents.
+ *
+ * Results:
+ * As above.
+ *
+ * Side effects:
+ * None.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+int
+TkFontGetPixels(
+ Tk_Window tkwin, /* For point->pixel conversion factor. */
+ int size) /* Font size. */
+{
+ double d;
+
+ if (size < 0) {
+ return -size;
+ }
+
+ d = size * 25.4 / 72.0;
+ d *= WidthOfScreen(Tk_Screen(tkwin));
+ d /= WidthMMOfScreen(Tk_Screen(tkwin));
+ return (int) (d + 0.5);
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * TkFontGetPoints --
+ *
+ * Given a font size specification (as described in the TkFontAttributes
+ * structure) return the number of points it represents.
+ *
+ * Results:
+ * As above.
+ *
+ * Side effects:
+ * None.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+int
+TkFontGetPoints(
+ Tk_Window tkwin, /* For pixel->point conversion factor. */
+ int size) /* Font size. */
+{
+ double d;
+
+ if (size >= 0) {
+ return size;
+ }
+
+ d = -size * 72.0 / 25.4;
+ d *= WidthMMOfScreen(Tk_Screen(tkwin));
+ d /= WidthOfScreen(Tk_Screen(tkwin));
+ return (int) (d + 0.5);
+}
+
+/*
+ *-------------------------------------------------------------------------
+ *
+ * TkFontGetAliasList --
+ *
+ * Given a font name, find the list of all aliases for that font name.
+ * One of the names in this list will probably be the name that this
+ * platform expects when asking for the font.
+ *
+ * Results:
+ * As above. The return value is NULL if the font name has no aliases.
+ *
+ * Side effects:
+ * None.
+ *
+ *-------------------------------------------------------------------------
+ */
+
+const char *const *
+TkFontGetAliasList(
+ 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.
+ *
+ *-------------------------------------------------------------------------
+ */
+
+const char *const *const *
+TkFontGetFallbacks(void)
+{
+ 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.
+ *
+ *-------------------------------------------------------------------------
+ */
+
+const char *const *
+TkFontGetGlobalClass(void)
+{
+ 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.
+ *
+ *-------------------------------------------------------------------------
+ */
+
+const char *const *
+TkFontGetSymbolClass(void)
+{
+ return symbolClass;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkDebugFont --
+ *
+ * This function 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(
+ Tk_Window tkwin, /* The window in which the font will be used
+ * (not currently used). */
+ const 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 = Tcl_GetHashValue(hashPtr);
+ if (fontPtr == NULL) {
+ Tcl_Panic("TkDebugFont found empty hash table entry");
+ }
+ for ( ; (fontPtr != NULL); fontPtr = fontPtr->nextPtr) {
+ objPtr = Tcl_NewObj();
+ Tcl_ListObjAppendElement(NULL, objPtr,
+ Tcl_NewIntObj(fontPtr->resourceRefCount));
+ Tcl_ListObjAppendElement(NULL, objPtr,
+ Tcl_NewIntObj(fontPtr->objRefCount));
+ Tcl_ListObjAppendElement(NULL, resultPtr, objPtr);
+ }
+ }
+ return resultPtr;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkFontGetFirstTextLayout --
+ *
+ * This function returns the first chunk of a Tk_TextLayout, i.e. until
+ * the first font change on the first line (or the whole first line if
+ * there is no such font change).
+ *
+ * Results:
+ * The return value is the byte length of the chunk, the chunk itself is
+ * copied into dst and its Tk_Font into font.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TkFontGetFirstTextLayout(
+ Tk_TextLayout layout, /* Layout information, from a previous call to
+ * Tk_ComputeTextLayout(). */
+ Tk_Font *font,
+ char *dst)
+{
+ TextLayout *layoutPtr = (TextLayout *) layout;
+ LayoutChunk *chunkPtr;
+ int numBytesInChunk;
+
+ if ((layoutPtr == NULL) || (layoutPtr->numChunks == 0)
+ || (layoutPtr->chunks->numDisplayChars <= 0)) {
+ dst[0] = '\0';
+ return 0;
+ }
+ chunkPtr = layoutPtr->chunks;
+ numBytesInChunk = chunkPtr->numBytes;
+ strncpy(dst, chunkPtr->start, (size_t) numBytesInChunk);
+ *font = layoutPtr->tkfont;
+ return numBytesInChunk;
+}
+
+/*
+ * Local Variables:
+ * mode: c
+ * c-basic-offset: 4
+ * fill-column: 78
+ * End:
+ */
diff --git a/tk8.6/generic/tkFont.h b/tk8.6/generic/tkFont.h
new file mode 100644
index 0000000..b8de885
--- /dev/null
+++ b/tk8.6/generic/tkFont.h
@@ -0,0 +1,224 @@
+/*
+ * tkFont.h --
+ *
+ * Declarations for interfaces between the generic and platform-specific
+ * parts of the font package. This information is not visible outside of
+ * the font package.
+ *
+ * Copyright (c) 1996-1997 Sun Microsystems, Inc.
+ *
+ * See the file "license.terms" for information on usage and redistribution of
+ * this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ */
+
+#ifndef _TKFONT
+#define _TKFONT
+
+/*
+ * The following structure keeps track of the attributes of a font. It can be
+ * used to keep track of either the desired attributes or the actual
+ * attributes gotten when the font was instantiated.
+ */
+
+struct TkFontAttributes {
+ Tk_Uid family; /* Font family, or NULL to represent plaform-
+ * specific default system font. */
+ int size; /* Pointsize of font, 0 for default size, or
+ * negative number meaning pixel size. */
+ int weight; /* Weight flag; see below for def'n. */
+ int slant; /* Slant flag; see below for def'n. */
+ int underline; /* Non-zero for underline font. */
+ int overstrike; /* Non-zero for overstrike font. */
+};
+
+/*
+ * Possible values for the "weight" field in a TkFontAttributes structure.
+ * Weight is a subjective term and depends on what the company that created
+ * the font considers bold.
+ */
+
+#define TK_FW_NORMAL 0
+#define TK_FW_BOLD 1
+
+#define TK_FW_UNKNOWN -1 /* Unknown weight. This value is used for
+ * error checking and is never actually stored
+ * in the weight field. */
+
+/*
+ * Possible values for the "slant" field in a TkFontAttributes structure.
+ */
+
+#define TK_FS_ROMAN 0
+#define TK_FS_ITALIC 1
+#define TK_FS_OBLIQUE 2 /* This value is only used when parsing X font
+ * names to determine the closest match. It is
+ * only stored in the XLFDAttributes
+ * structure, never in the slant field of the
+ * TkFontAttributes. */
+
+#define TK_FS_UNKNOWN -1 /* Unknown slant. This value is used for error
+ * checking and is never actually stored in
+ * the slant field. */
+
+/*
+ * The following structure keeps track of the metrics for an instantiated
+ * font. The metrics are the physical properties of the font itself.
+ */
+
+typedef struct TkFontMetrics {
+ int ascent; /* From baseline to top of font. */
+ int descent; /* From baseline to bottom of font. */
+ int maxWidth; /* Width of widest character in font. */
+ int fixed; /* Non-zero if this is a fixed-width font,
+ * 0 otherwise. */
+} TkFontMetrics;
+
+/*
+ * The following structure is used to keep track of the generic information
+ * about a font. Each platform-specific font is represented by a structure
+ * with the following structure at its beginning, plus any platform-specific
+ * stuff after that.
+ */
+
+typedef struct TkFont {
+ /*
+ * Fields used and maintained exclusively by generic code.
+ */
+
+ int resourceRefCount; /* Number of active uses of this font (each
+ * active use corresponds to a call to
+ * Tk_AllocFontFromTable or Tk_GetFont). If
+ * this count is 0, then this TkFont structure
+ * is no longer valid and it isn't present in
+ * a hash table: it is being kept around only
+ * because there are objects referring to it.
+ * The structure is freed when
+ * resourceRefCount and objRefCount are both
+ * 0. */
+ int objRefCount; /* The number of Tcl objects that reference
+ * this structure. */
+ Tcl_HashEntry *cacheHashPtr;/* Entry in font cache for this structure,
+ * used when deleting it. */
+ Tcl_HashEntry *namedHashPtr;/* Pointer to hash table entry that
+ * corresponds to the named font that the
+ * tkfont was based on, or NULL if the tkfont
+ * was not based on a named font. */
+ Screen *screen; /* The screen where this font is valid. */
+ int tabWidth; /* Width of tabs in this font (pixels). */
+ int underlinePos; /* Offset from baseline to origin of underline
+ * bar (used for drawing underlines on a
+ * non-underlined font). */
+ int underlineHeight; /* Height of underline bar (used for drawing
+ * underlines on a non-underlined font). */
+
+ /*
+ * Fields used in the generic code that are filled in by
+ * platform-specific code.
+ */
+
+ Font fid; /* For backwards compatibility with XGCValues
+ * structures. Remove when TkGCValues is
+ * implemented. */
+ TkFontAttributes fa; /* Actual font attributes obtained when the
+ * the font was created, as opposed to the
+ * desired attributes passed in to
+ * TkpGetFontFromAttributes(). The desired
+ * metrics can be determined from the string
+ * that was used to create this font. */
+ TkFontMetrics fm; /* Font metrics determined when font was
+ * created. */
+ struct TkFont *nextPtr; /* Points to the next TkFont structure with
+ * the same name. All fonts with the same name
+ * (but different displays) are chained
+ * together off a single entry in a hash
+ * table. */
+} TkFont;
+
+/*
+ * The following structure is used to return attributes when parsing an XLFD.
+ * The extra information is of interest to the Unix-specific code when
+ * attempting to find the closest matching font.
+ */
+
+typedef struct TkXLFDAttributes {
+ Tk_Uid foundry; /* The foundry of the font. */
+ int slant; /* The tristate value for the slant, which is
+ * significant under X. */
+ int setwidth; /* The proportionate width, see below for
+ * definition. */
+ Tk_Uid charset; /* The actual charset string. */
+} TkXLFDAttributes;
+
+/*
+ * Possible values for the "setwidth" field in a TkXLFDAttributes structure.
+ * The setwidth is whether characters are considered wider or narrower than
+ * normal.
+ */
+
+#define TK_SW_NORMAL 0
+#define TK_SW_CONDENSE 1
+#define TK_SW_EXPAND 2
+#define TK_SW_UNKNOWN 3 /* Unknown setwidth. This value may be stored
+ * in the setwidth field. */
+
+/*
+ * The following defines specify the meaning of the fields in a fully
+ * qualified XLFD.
+ */
+
+#define XLFD_FOUNDRY 0
+#define XLFD_FAMILY 1
+#define XLFD_WEIGHT 2
+#define XLFD_SLANT 3
+#define XLFD_SETWIDTH 4
+#define XLFD_ADD_STYLE 5
+#define XLFD_PIXEL_SIZE 6
+#define XLFD_POINT_SIZE 7
+#define XLFD_RESOLUTION_X 8
+#define XLFD_RESOLUTION_Y 9
+#define XLFD_SPACING 10
+#define XLFD_AVERAGE_WIDTH 11
+#define XLFD_CHARSET 12
+#define XLFD_NUMFIELDS 13 /* Number of fields in XLFD. */
+
+/*
+ * Helper macro. How to correctly round a double to a short.
+ */
+
+#define ROUND16(x) ((short) floor((x) + 0.5))
+
+/*
+ * Low-level API exported by generic code to platform-specific code.
+ */
+
+#define TkInitFontAttributes(fa) memset((fa), 0, sizeof(TkFontAttributes));
+#define TkInitXLFDAttributes(xa) memset((xa), 0, sizeof(TkXLFDAttributes));
+
+MODULE_SCOPE int TkFontParseXLFD(const char *string,
+ TkFontAttributes *faPtr, TkXLFDAttributes *xaPtr);
+MODULE_SCOPE const char *const * TkFontGetAliasList(const char *faceName);
+MODULE_SCOPE const char *const *const * TkFontGetFallbacks(void);
+MODULE_SCOPE int TkFontGetPixels(Tk_Window tkwin, int size);
+MODULE_SCOPE int TkFontGetPoints(Tk_Window tkwin, int size);
+MODULE_SCOPE const char *const * TkFontGetGlobalClass(void);
+MODULE_SCOPE const char *const * TkFontGetSymbolClass(void);
+MODULE_SCOPE int TkCreateNamedFont(Tcl_Interp *interp, Tk_Window tkwin,
+ const char *name, TkFontAttributes *faPtr);
+MODULE_SCOPE int TkDeleteNamedFont(Tcl_Interp *interp,
+ Tk_Window tkwin, const char *name);
+MODULE_SCOPE int TkFontGetFirstTextLayout(Tk_TextLayout layout,
+ Tk_Font *font, char *dst);
+
+/*
+ * Low-level API exported by platform-specific code to generic code.
+ */
+
+MODULE_SCOPE void TkpDeleteFont(TkFont *tkFontPtr);
+MODULE_SCOPE void TkpFontPkgInit(TkMainInfo *mainPtr);
+MODULE_SCOPE TkFont * TkpGetFontFromAttributes(TkFont *tkFontPtr,
+ Tk_Window tkwin, const TkFontAttributes *faPtr);
+MODULE_SCOPE void TkpGetFontFamilies(Tcl_Interp *interp,
+ Tk_Window tkwin);
+MODULE_SCOPE TkFont * TkpGetNativeFont(Tk_Window tkwin, const char *name);
+
+#endif /* _TKFONT */
diff --git a/tk8.6/generic/tkFrame.c b/tk8.6/generic/tkFrame.c
new file mode 100644
index 0000000..f6edfb0
--- /dev/null
+++ b/tk8.6/generic/tkFrame.c
@@ -0,0 +1,2039 @@
+/*
+ * tkFrame.c --
+ *
+ * This module implements "frame", "labelframe" and "toplevel" widgets
+ * for the Tk toolkit. Frames are windows with a background color and
+ * possibly a 3-D effect, but not much else in the way of attributes.
+ *
+ * Copyright (c) 1990-1994 The Regents of the University of California.
+ * Copyright (c) 1994-1997 Sun Microsystems, Inc.
+ *
+ * See the file "license.terms" for information on usage and redistribution of
+ * this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ */
+
+#include "default.h"
+#include "tkInt.h"
+
+/*
+ * The following enum is used to define the type of the frame.
+ */
+
+enum FrameType {
+ TYPE_FRAME, TYPE_TOPLEVEL, TYPE_LABELFRAME
+};
+
+/*
+ * A data structure of the following type is kept for each
+ * frame that currently exists for this process:
+ */
+
+typedef struct {
+ Tk_Window tkwin; /* Window that embodies the frame. NULL means
+ * that the window has been destroyed but the
+ * data structures haven't yet been cleaned
+ * up. */
+ Display *display; /* Display containing widget. Used, among
+ * other things, so that resources can be
+ * freed even after tkwin has gone away. */
+ Tcl_Interp *interp; /* Interpreter associated with widget. Used to
+ * delete widget command. */
+ Tcl_Command widgetCmd; /* Token for frame's widget command. */
+ Tk_OptionTable optionTable; /* Table that defines configuration options
+ * available for this widget. */
+ char *className; /* Class name for widget (from configuration
+ * option). Malloc-ed. */
+ enum FrameType type; /* Type of widget, such as TYPE_FRAME. */
+ char *screenName; /* Screen on which widget is created. Non-null
+ * only for top-levels. Malloc-ed, may be
+ * NULL. */
+ char *visualName; /* Textual description of visual for window,
+ * from -visual option. Malloc-ed, may be
+ * NULL. */
+ char *colormapName; /* Textual description of colormap for window,
+ * from -colormap option. Malloc-ed, may be
+ * NULL. */
+ char *menuName; /* Textual description of menu to use for
+ * menubar. Malloc-ed, may be NULL. */
+ Colormap colormap; /* If not None, identifies a colormap
+ * allocated for this window, which must be
+ * freed when the window is deleted. */
+ Tk_3DBorder border; /* Structure used to draw 3-D border and
+ * background. NULL means no background or
+ * border. */
+ int borderWidth; /* Width of 3-D border (if any). */
+ int relief; /* 3-d effect: TK_RELIEF_RAISED etc. */
+ int highlightWidth; /* Width in pixels of highlight to draw around
+ * widget when it has the focus. 0 means don't
+ * draw a highlight. */
+ XColor *highlightBgColorPtr;
+ /* Color for drawing traversal highlight area
+ * when highlight is off. */
+ XColor *highlightColorPtr; /* Color for drawing traversal highlight. */
+ int width; /* Width to request for window. <= 0 means
+ * don't request any size. */
+ int height; /* Height to request for window. <= 0 means
+ * don't request any size. */
+ Tk_Cursor cursor; /* Current cursor for window, or None. */
+ char *takeFocus; /* Value of -takefocus option; not used in the
+ * C code, but used by keyboard traversal
+ * scripts. Malloc'ed, but may be NULL. */
+ int isContainer; /* 1 means this window is a container, 0 means
+ * that it isn't. */
+ char *useThis; /* If the window is embedded, this points to
+ * the name of the window in which it is
+ * embedded (malloc'ed). For non-embedded
+ * windows this is NULL. */
+ int flags; /* Various flags; see below for
+ * definitions. */
+ Tcl_Obj *padXPtr; /* Value of -padx option: specifies how many
+ * pixels of extra space to leave on left and
+ * right of child area. */
+ int padX; /* Integer value corresponding to padXPtr. */
+ Tcl_Obj *padYPtr; /* Value of -padx option: specifies how many
+ * pixels of extra space to leave above and
+ * below child area. */
+ int padY; /* Integer value corresponding to padYPtr. */
+} Frame;
+
+/*
+ * A data structure of the following type is kept for each labelframe widget
+ * managed by this file:
+ */
+
+typedef struct {
+ Frame frame; /* A pointer to the generic frame structure.
+ * This must be the first element of the
+ * Labelframe. */
+ /*
+ * Labelframe specific configuration settings.
+ */
+ Tcl_Obj *textPtr; /* Value of -text option: specifies text to
+ * display in button. */
+ Tk_Font tkfont; /* Value of -font option: specifies font to
+ * use for display text. */
+ XColor *textColorPtr; /* Value of -fg option: specifies foreground
+ * color in normal mode. */
+ int labelAnchor; /* Value of -labelanchor option: specifies
+ * where to place the label. */
+ Tk_Window labelWin; /* Value of -labelwidget option: Window to use
+ * as label for the frame. */
+ /*
+ * Labelframe specific fields for use with configuration settings above.
+ */
+ GC textGC; /* GC for drawing text in normal mode. */
+ Tk_TextLayout textLayout; /* Stored text layout information. */
+ XRectangle labelBox; /* The label's actual size and position. */
+ int labelReqWidth; /* The label's requested width. */
+ int labelReqHeight; /* The label's requested height. */
+ int labelTextX, labelTextY; /* Position of the text to be drawn. */
+} Labelframe;
+
+/*
+ * The following macros define how many extra pixels to leave around a label's
+ * text.
+ */
+
+#define LABELSPACING 1
+#define LABELMARGIN 4
+
+/*
+ * Flag bits for frames:
+ *
+ * REDRAW_PENDING: Non-zero means a DoWhenIdle handler has
+ * already been queued to redraw this window.
+ * GOT_FOCUS: Non-zero means this widget currently has the
+ * input focus.
+ */
+
+#define REDRAW_PENDING 1
+#define GOT_FOCUS 4
+
+/*
+ * The following enum is used to define a type for the -labelanchor option of
+ * the Labelframe widget. These values are used as indices into the string
+ * table below.
+ */
+
+enum labelanchor {
+ LABELANCHOR_E, LABELANCHOR_EN, LABELANCHOR_ES,
+ LABELANCHOR_N, LABELANCHOR_NE, LABELANCHOR_NW,
+ LABELANCHOR_S, LABELANCHOR_SE, LABELANCHOR_SW,
+ LABELANCHOR_W, LABELANCHOR_WN, LABELANCHOR_WS
+};
+
+static const char *const labelAnchorStrings[] = {
+ "e", "en", "es", "n", "ne", "nw", "s", "se", "sw", "w", "wn", "ws",
+ NULL
+};
+
+/*
+ * Information used for parsing configuration options. There are one common
+ * table used by all and one table for each widget class.
+ */
+
+static const Tk_OptionSpec commonOptSpec[] = {
+ {TK_OPTION_BORDER, "-background", "background", "Background",
+ DEF_FRAME_BG_COLOR, -1, Tk_Offset(Frame, border),
+ TK_OPTION_NULL_OK, DEF_FRAME_BG_MONO, 0},
+ {TK_OPTION_SYNONYM, "-bg", NULL, NULL,
+ NULL, 0, -1, 0, "-background", 0},
+ {TK_OPTION_STRING, "-colormap", "colormap", "Colormap",
+ DEF_FRAME_COLORMAP, -1, Tk_Offset(Frame, colormapName),
+ TK_OPTION_NULL_OK, 0, 0},
+ /*
+ * Having -container is useless in a labelframe since a container has
+ * no border. It should be deprecated.
+ */
+ {TK_OPTION_BOOLEAN, "-container", "container", "Container",
+ DEF_FRAME_CONTAINER, -1, Tk_Offset(Frame, isContainer), 0, 0, 0},
+ {TK_OPTION_CURSOR, "-cursor", "cursor", "Cursor",
+ DEF_FRAME_CURSOR, -1, Tk_Offset(Frame, cursor),
+ TK_OPTION_NULL_OK, 0, 0},
+ {TK_OPTION_PIXELS, "-height", "height", "Height",
+ DEF_FRAME_HEIGHT, -1, Tk_Offset(Frame, height), 0, 0, 0},
+ {TK_OPTION_COLOR, "-highlightbackground", "highlightBackground",
+ "HighlightBackground", DEF_FRAME_HIGHLIGHT_BG, -1,
+ Tk_Offset(Frame, highlightBgColorPtr), 0, 0, 0},
+ {TK_OPTION_COLOR, "-highlightcolor", "highlightColor", "HighlightColor",
+ DEF_FRAME_HIGHLIGHT, -1, Tk_Offset(Frame, highlightColorPtr),
+ 0, 0, 0},
+ {TK_OPTION_PIXELS, "-highlightthickness", "highlightThickness",
+ "HighlightThickness", DEF_FRAME_HIGHLIGHT_WIDTH, -1,
+ Tk_Offset(Frame, highlightWidth), 0, 0, 0},
+ {TK_OPTION_PIXELS, "-padx", "padX", "Pad",
+ DEF_FRAME_PADX, Tk_Offset(Frame, padXPtr),
+ Tk_Offset(Frame, padX), 0, 0, 0},
+ {TK_OPTION_PIXELS, "-pady", "padY", "Pad",
+ DEF_FRAME_PADY, Tk_Offset(Frame, padYPtr),
+ Tk_Offset(Frame, padY), 0, 0, 0},
+ {TK_OPTION_STRING, "-takefocus", "takeFocus", "TakeFocus",
+ DEF_FRAME_TAKE_FOCUS, -1, Tk_Offset(Frame, takeFocus),
+ TK_OPTION_NULL_OK, 0, 0},
+ {TK_OPTION_STRING, "-visual", "visual", "Visual",
+ DEF_FRAME_VISUAL, -1, Tk_Offset(Frame, visualName),
+ TK_OPTION_NULL_OK, 0, 0},
+ {TK_OPTION_PIXELS, "-width", "width", "Width",
+ DEF_FRAME_WIDTH, -1, Tk_Offset(Frame, width), 0, 0, 0},
+ {TK_OPTION_END, NULL, NULL, NULL, NULL, 0, 0, 0, 0, 0}
+};
+
+static const Tk_OptionSpec frameOptSpec[] = {
+ {TK_OPTION_SYNONYM, "-bd", NULL, NULL,
+ NULL, 0, -1, 0, "-borderwidth", 0},
+ {TK_OPTION_PIXELS, "-borderwidth", "borderWidth", "BorderWidth",
+ DEF_FRAME_BORDER_WIDTH, -1, Tk_Offset(Frame, borderWidth), 0, 0, 0},
+ {TK_OPTION_STRING, "-class", "class", "Class",
+ DEF_FRAME_CLASS, -1, Tk_Offset(Frame, className), 0, 0, 0},
+ {TK_OPTION_RELIEF, "-relief", "relief", "Relief",
+ DEF_FRAME_RELIEF, -1, Tk_Offset(Frame, relief), 0, 0, 0},
+ {TK_OPTION_END, NULL, NULL, NULL,
+ NULL, 0, 0, 0, commonOptSpec, 0}
+};
+
+static const Tk_OptionSpec toplevelOptSpec[] = {
+ {TK_OPTION_SYNONYM, "-bd", NULL, NULL,
+ NULL, 0, -1, 0, "-borderwidth", 0},
+ {TK_OPTION_PIXELS, "-borderwidth", "borderWidth", "BorderWidth",
+ DEF_FRAME_BORDER_WIDTH, -1, Tk_Offset(Frame, borderWidth), 0, 0, 0},
+ {TK_OPTION_STRING, "-class", "class", "Class",
+ DEF_TOPLEVEL_CLASS, -1, Tk_Offset(Frame, className), 0, 0, 0},
+ {TK_OPTION_STRING, "-menu", "menu", "Menu",
+ DEF_TOPLEVEL_MENU, -1, Tk_Offset(Frame, menuName),
+ TK_OPTION_NULL_OK, 0, 0},
+ {TK_OPTION_RELIEF, "-relief", "relief", "Relief",
+ DEF_FRAME_RELIEF, -1, Tk_Offset(Frame, relief), 0, 0, 0},
+ {TK_OPTION_STRING, "-screen", "screen", "Screen",
+ DEF_TOPLEVEL_SCREEN, -1, Tk_Offset(Frame, screenName),
+ TK_OPTION_NULL_OK, 0, 0},
+ {TK_OPTION_STRING, "-use", "use", "Use",
+ DEF_TOPLEVEL_USE, -1, Tk_Offset(Frame, useThis),
+ TK_OPTION_NULL_OK, 0, 0},
+ {TK_OPTION_END, NULL, NULL, NULL,
+ NULL, 0, 0, 0, commonOptSpec, 0}
+};
+
+static const Tk_OptionSpec labelframeOptSpec[] = {
+ {TK_OPTION_SYNONYM, "-bd", NULL, NULL,
+ NULL, 0, -1, 0, "-borderwidth", 0},
+ {TK_OPTION_PIXELS, "-borderwidth", "borderWidth", "BorderWidth",
+ DEF_LABELFRAME_BORDER_WIDTH, -1, Tk_Offset(Frame, borderWidth),
+ 0, 0, 0},
+ {TK_OPTION_STRING, "-class", "class", "Class",
+ DEF_LABELFRAME_CLASS, -1, Tk_Offset(Frame, className), 0, 0, 0},
+ {TK_OPTION_SYNONYM, "-fg", "foreground", NULL,
+ NULL, 0, -1, 0, "-foreground", 0},
+ {TK_OPTION_FONT, "-font", "font", "Font",
+ DEF_LABELFRAME_FONT, -1, Tk_Offset(Labelframe, tkfont), 0, 0, 0},
+ {TK_OPTION_COLOR, "-foreground", "foreground", "Foreground",
+ DEF_LABELFRAME_FG, -1, Tk_Offset(Labelframe, textColorPtr), 0, 0, 0},
+ {TK_OPTION_STRING_TABLE, "-labelanchor", "labelAnchor", "LabelAnchor",
+ DEF_LABELFRAME_LABELANCHOR, -1, Tk_Offset(Labelframe, labelAnchor),
+ 0, labelAnchorStrings, 0},
+ {TK_OPTION_WINDOW, "-labelwidget", "labelWidget", "LabelWidget",
+ NULL, -1, Tk_Offset(Labelframe, labelWin), TK_OPTION_NULL_OK, 0, 0},
+ {TK_OPTION_RELIEF, "-relief", "relief", "Relief",
+ DEF_LABELFRAME_RELIEF, -1, Tk_Offset(Frame, relief), 0, 0, 0},
+ {TK_OPTION_STRING, "-text", "text", "Text",
+ DEF_LABELFRAME_TEXT, Tk_Offset(Labelframe, textPtr), -1,
+ TK_OPTION_NULL_OK, 0, 0},
+ {TK_OPTION_END, NULL, NULL, NULL,
+ NULL, 0, 0, 0, commonOptSpec, 0}
+};
+
+/*
+ * Class names for widgets, indexed by FrameType.
+ */
+
+static const char *const classNames[] = {"Frame", "Toplevel", "Labelframe"};
+
+/*
+ * The following table maps from FrameType to the option template for that
+ * class of widgets.
+ */
+
+static const Tk_OptionSpec *const optionSpecs[] = {
+ frameOptSpec,
+ toplevelOptSpec,
+ labelframeOptSpec,
+};
+
+/*
+ * Forward declarations for functions defined later in this file:
+ */
+
+static void ComputeFrameGeometry(Frame *framePtr);
+static int ConfigureFrame(Tcl_Interp *interp, Frame *framePtr,
+ int objc, Tcl_Obj *const objv[]);
+static int CreateFrame(ClientData clientData, Tcl_Interp *interp,
+ int objc, Tcl_Obj *const argv[],
+ enum FrameType type, const char *appName);
+static void DestroyFrame(void *memPtr);
+static void DestroyFramePartly(Frame *framePtr);
+static void DisplayFrame(ClientData clientData);
+static void FrameCmdDeletedProc(ClientData clientData);
+static void FrameEventProc(ClientData clientData,
+ XEvent *eventPtr);
+static void FrameLostSlaveProc(ClientData clientData,
+ Tk_Window tkwin);
+static void FrameRequestProc(ClientData clientData,
+ Tk_Window tkwin);
+static void FrameStructureProc(ClientData clientData,
+ XEvent *eventPtr);
+static int FrameWidgetObjCmd(ClientData clientData,
+ Tcl_Interp *interp, int objc,
+ Tcl_Obj *const objv[]);
+static void FrameWorldChanged(ClientData instanceData);
+static void MapFrame(ClientData clientData);
+
+/*
+ * The structure below defines frame class behavior by means of functions that
+ * can be invoked from generic window code.
+ */
+
+static const Tk_ClassProcs frameClass = {
+ sizeof(Tk_ClassProcs), /* size */
+ FrameWorldChanged, /* worldChangedProc */
+ NULL, /* createProc */
+ NULL /* modalProc */
+};
+
+/*
+ * The structure below defines the official type record for the labelframe's
+ * geometry manager:
+ */
+
+static const Tk_GeomMgr frameGeomType = {
+ "labelframe", /* name */
+ FrameRequestProc, /* requestProc */
+ FrameLostSlaveProc /* lostSlaveProc */
+};
+
+/*
+ *--------------------------------------------------------------
+ *
+ * Tk_FrameObjCmd, Tk_ToplevelObjCmd, Tk_LabelframeObjCmd --
+ *
+ * These functions are invoked to process the "frame", "toplevel" and
+ * "labelframe" Tcl commands. See the user documentation for details on
+ * what they do.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * See the user documentation. These functions are just wrappers; they
+ * call CreateFrame to do all of the real work.
+ *
+ *--------------------------------------------------------------
+ */
+
+int
+Tk_FrameObjCmd(
+ ClientData clientData, /* Either NULL or pointer to option table. */
+ Tcl_Interp *interp, /* Current interpreter. */
+ int objc, /* Number of arguments. */
+ Tcl_Obj *const objv[]) /* Argument objects. */
+{
+ return CreateFrame(clientData, interp, objc, objv, TYPE_FRAME, NULL);
+}
+
+int
+Tk_ToplevelObjCmd(
+ ClientData clientData, /* Either NULL or pointer to option table. */
+ Tcl_Interp *interp, /* Current interpreter. */
+ int objc, /* Number of arguments. */
+ Tcl_Obj *const objv[]) /* Argument objects. */
+{
+ return CreateFrame(clientData, interp, objc, objv, TYPE_TOPLEVEL, NULL);
+}
+
+int
+Tk_LabelframeObjCmd(
+ ClientData clientData, /* Either NULL or pointer to option table. */
+ Tcl_Interp *interp, /* Current interpreter. */
+ int objc, /* Number of arguments. */
+ Tcl_Obj *const objv[]) /* Argument objects. */
+{
+ return CreateFrame(clientData, interp, objc, objv, TYPE_LABELFRAME, NULL);
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * TkCreateFrame --
+ *
+ * This function is the old command function for the "frame" and
+ * "toplevel" commands. Now it is used directly by Tk_Init to create a
+ * new main window. See the user documentation for the "frame" and
+ * "toplevel" commands for details on what it does.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * See the user documentation.
+ *
+ *--------------------------------------------------------------
+ */
+
+int
+TkCreateFrame(
+ ClientData clientData, /* Either NULL or pointer to option table. */
+ Tcl_Interp *interp, /* Current interpreter. */
+ int argc, /* Number of arguments. */
+ const char *const *argv, /* Argument strings. */
+ int toplevel, /* Non-zero means create a toplevel window,
+ * zero means create a frame. */
+ const char *appName) /* Should only be non-NULL if there is no main
+ * window associated with the interpreter.
+ * Gives the base name to use for the new
+ * application. */
+{
+ int result, i;
+ Tcl_Obj **objv = ckalloc((argc+1) * sizeof(Tcl_Obj **));
+
+ for (i=0; i<argc; i++) {
+ objv[i] = Tcl_NewStringObj(argv[i], -1);
+ Tcl_IncrRefCount(objv[i]);
+ }
+ objv[argc] = NULL;
+ result = CreateFrame(clientData, interp, argc, objv,
+ toplevel ? TYPE_TOPLEVEL : TYPE_FRAME, appName);
+ for (i=0; i<argc; i++) {
+ Tcl_DecrRefCount(objv[i]);
+ }
+ ckfree(objv);
+ return result;
+}
+
+int
+TkListCreateFrame(
+ ClientData clientData, /* Either NULL or pointer to option table. */
+ Tcl_Interp *interp, /* Current interpreter. */
+ Tcl_Obj *listObj, /* List of arguments. */
+ int toplevel, /* Non-zero means create a toplevel window,
+ * zero means create a frame. */
+ Tcl_Obj *nameObj) /* Should only be non-NULL if there is no main
+ * window associated with the interpreter.
+ * Gives the base name to use for the new
+ * application. */
+
+{
+ int objc;
+ Tcl_Obj **objv;
+
+ if (TCL_OK != Tcl_ListObjGetElements(interp, listObj, &objc, &objv)) {
+ return TCL_ERROR;
+ }
+ return CreateFrame(clientData, interp, objc, objv,
+ toplevel ? TYPE_TOPLEVEL : TYPE_FRAME,
+ nameObj ? Tcl_GetString(nameObj) : NULL);
+}
+
+static int
+CreateFrame(
+ ClientData clientData, /* NULL. */
+ Tcl_Interp *interp, /* Current interpreter. */
+ int objc, /* Number of arguments. */
+ Tcl_Obj *const objv[], /* Argument objects. */
+ enum FrameType type, /* What widget type to create. */
+ const char *appName) /* Should only be non-NULL if there are no
+ * Main window associated with the
+ * interpreter. Gives the base name to use for
+ * the new application. */
+{
+ Tk_Window tkwin;
+ Frame *framePtr;
+ Tk_OptionTable optionTable;
+ Tk_Window newWin;
+ const char *className, *screenName, *visualName, *colormapName;
+ const char *arg, *useOption;
+ int i, length, depth;
+ unsigned int mask;
+ Colormap colormap;
+ Visual *visual;
+
+ if (objc < 2) {
+ Tcl_WrongNumArgs(interp, 1, objv, "pathName ?-option value ...?");
+ return TCL_ERROR;
+ }
+
+ /*
+ * Create the option table for this widget class. If it has already been
+ * created, the cached pointer will be returned.
+ */
+
+ optionTable = Tk_CreateOptionTable(interp, optionSpecs[type]);
+
+ /*
+ * Pre-process the argument list. Scan through it to find any "-class",
+ * "-screen", "-visual", and "-colormap" options. These arguments need to
+ * be processed specially, before the window is configured using the usual
+ * Tk mechanisms.
+ */
+
+ className = colormapName = screenName = visualName = useOption = NULL;
+ colormap = None;
+ for (i = 2; i < objc; i += 2) {
+ arg = Tcl_GetStringFromObj(objv[i], &length);
+ if (length < 2) {
+ continue;
+ }
+ if ((arg[1] == 'c') && (length >= 3)
+ && (strncmp(arg, "-class", (unsigned) length) == 0)) {
+ className = Tcl_GetString(objv[i+1]);
+ } else if ((arg[1] == 'c') && (length >= 3)
+ && (strncmp(arg, "-colormap", (unsigned) length) == 0)) {
+ colormapName = Tcl_GetString(objv[i+1]);
+ } else if ((arg[1] == 's') && (type == TYPE_TOPLEVEL)
+ && (strncmp(arg, "-screen", (unsigned) length) == 0)) {
+ screenName = Tcl_GetString(objv[i+1]);
+ } else if ((arg[1] == 'u') && (type == TYPE_TOPLEVEL)
+ && (strncmp(arg, "-use", (unsigned) length) == 0)) {
+ useOption = Tcl_GetString(objv[i+1]);
+ } else if ((arg[1] == 'v')
+ && (strncmp(arg, "-visual", (unsigned) length) == 0)) {
+ visualName = Tcl_GetString(objv[i+1]);
+ }
+ }
+
+ /*
+ * Create the window, and deal with the special options -use, -classname,
+ * -colormap, -screenname, and -visual. These options must be handle
+ * before calling ConfigureFrame below, and they must also be processed in
+ * a particular order, for the following reasons:
+ * 1. Must set the window's class before calling ConfigureFrame, so that
+ * unspecified options are looked up in the option database using the
+ * correct class.
+ * 2. Must set visual information before calling ConfigureFrame so that
+ * colors are allocated in a proper colormap.
+ * 3. Must call TkpUseWindow before setting non-default visual
+ * information, since TkpUseWindow changes the defaults.
+ */
+
+ if (screenName == NULL) {
+ screenName = (type == TYPE_TOPLEVEL) ? "" : NULL;
+ }
+
+ /*
+ * Main window associated with interpreter. If we're called by Tk_Init to
+ * create a new application, then this is NULL.
+ */
+
+ tkwin = Tk_MainWindow(interp);
+ if (tkwin != NULL) {
+ newWin = Tk_CreateWindowFromPath(interp, tkwin, Tcl_GetString(objv[1]),
+ screenName);
+ } else if (appName == NULL) {
+ /*
+ * This occurs when someone tried to create a frame/toplevel while we
+ * are being destroyed. Let an error be thrown.
+ */
+
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "unable to create widget \"%s\"", Tcl_GetString(objv[1])));
+ Tcl_SetErrorCode(interp, "TK", "APPLICATION_GONE", NULL);
+ return TCL_ERROR;
+ } else {
+ /*
+ * We were called from Tk_Init; create a new application.
+ */
+
+ newWin = TkCreateMainWindow(interp, screenName, appName);
+ }
+ if (newWin == NULL) {
+ goto error;
+ }
+
+ /*
+ * Mark Tk frames as suitable candidates for [wm manage].
+ */
+
+ ((TkWindow *) newWin)->flags |= TK_WM_MANAGEABLE;
+
+ if (className == NULL) {
+ className = Tk_GetOption(newWin, "class", "Class");
+ if (className == NULL) {
+ className = classNames[type];
+ }
+ }
+ Tk_SetClass(newWin, className);
+ if (useOption == NULL) {
+ useOption = Tk_GetOption(newWin, "use", "Use");
+ }
+ if ((useOption != NULL) && (*useOption != 0)
+ && (TkpUseWindow(interp, newWin, useOption) != TCL_OK)) {
+ goto error;
+ }
+ if (visualName == NULL) {
+ visualName = Tk_GetOption(newWin, "visual", "Visual");
+ }
+ if (colormapName == NULL) {
+ colormapName = Tk_GetOption(newWin, "colormap", "Colormap");
+ }
+ if ((colormapName != NULL) && (*colormapName == 0)) {
+ colormapName = NULL;
+ }
+ if (visualName != NULL) {
+ visual = Tk_GetVisual(interp, newWin, visualName, &depth,
+ (colormapName == NULL) ? &colormap : NULL);
+ if (visual == NULL) {
+ goto error;
+ }
+ Tk_SetWindowVisual(newWin, visual, depth, colormap);
+ }
+ if (colormapName != NULL) {
+ colormap = Tk_GetColormap(interp, newWin, colormapName);
+ if (colormap == None) {
+ goto error;
+ }
+ Tk_SetWindowColormap(newWin, colormap);
+ }
+
+ /*
+ * For top-level windows, provide an initial geometry request of 200x200,
+ * just so the window looks nicer on the screen if it doesn't request a
+ * size for itself.
+ */
+
+ if (type == TYPE_TOPLEVEL) {
+ Tk_GeometryRequest(newWin, 200, 200);
+ }
+
+ /*
+ * Create the widget record, process configuration options, and create
+ * event handlers. Then fill in a few additional fields in the widget
+ * record from the special options.
+ */
+
+ if (type == TYPE_LABELFRAME) {
+ framePtr = ckalloc(sizeof(Labelframe));
+ memset(framePtr, 0, sizeof(Labelframe));
+ } else {
+ framePtr = ckalloc(sizeof(Frame));
+ memset(framePtr, 0, sizeof(Frame));
+ }
+ framePtr->tkwin = newWin;
+ framePtr->display = Tk_Display(newWin);
+ framePtr->interp = interp;
+ framePtr->widgetCmd = Tcl_CreateObjCommand(interp, Tk_PathName(newWin),
+ FrameWidgetObjCmd, framePtr, FrameCmdDeletedProc);
+ framePtr->optionTable = optionTable;
+ framePtr->type = type;
+ framePtr->colormap = colormap;
+ framePtr->relief = TK_RELIEF_FLAT;
+ framePtr->cursor = None;
+
+ if (framePtr->type == TYPE_LABELFRAME) {
+ Labelframe *labelframePtr = (Labelframe *) framePtr;
+
+ labelframePtr->labelAnchor = LABELANCHOR_NW;
+ labelframePtr->textGC = None;
+ }
+
+ /*
+ * Store backreference to frame widget in window structure.
+ */
+
+ Tk_SetClassProcs(newWin, &frameClass, framePtr);
+
+ mask = ExposureMask | StructureNotifyMask | FocusChangeMask;
+ if (type == TYPE_TOPLEVEL) {
+ mask |= ActivateMask;
+ }
+ Tk_CreateEventHandler(newWin, mask, FrameEventProc, framePtr);
+ if ((Tk_InitOptions(interp, (char *) framePtr, optionTable, newWin)
+ != TCL_OK) ||
+ (ConfigureFrame(interp, framePtr, objc-2, objv+2) != TCL_OK)) {
+ goto error;
+ }
+ if (framePtr->isContainer) {
+ if (framePtr->useThis != NULL) {
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "windows cannot have both the -use and the -container"
+ " option set", -1));
+ Tcl_SetErrorCode(interp, "TK", "FRAME", "CONTAINMENT", NULL);
+ goto error;
+ }
+ TkpMakeContainer(framePtr->tkwin);
+ }
+ if (type == TYPE_TOPLEVEL) {
+ Tcl_DoWhenIdle(MapFrame, framePtr);
+ }
+ Tcl_SetObjResult(interp, TkNewWindowObj(newWin));
+ return TCL_OK;
+
+ error:
+ if (newWin != NULL) {
+ Tk_DestroyWindow(newWin);
+ }
+ return TCL_ERROR;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * FrameWidgetObjCmd --
+ *
+ * This function is invoked to process the Tcl command that corresponds
+ * to a frame widget. See the user documentation for details on what it
+ * does.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * See the user documentation.
+ *
+ *--------------------------------------------------------------
+ */
+
+static int
+FrameWidgetObjCmd(
+ ClientData clientData, /* Information about frame widget. */
+ Tcl_Interp *interp, /* Current interpreter. */
+ int objc, /* Number of arguments. */
+ Tcl_Obj *const objv[]) /* Argument objects. */
+{
+ static const char *const frameOptions[] = {
+ "cget", "configure", NULL
+ };
+ enum options {
+ FRAME_CGET, FRAME_CONFIGURE
+ };
+ register Frame *framePtr = clientData;
+ int result = TCL_OK, index;
+ int c, i, length;
+ Tcl_Obj *objPtr;
+
+ if (objc < 2) {
+ Tcl_WrongNumArgs(interp, 1, objv, "option ?arg ...?");
+ return TCL_ERROR;
+ }
+ if (Tcl_GetIndexFromObjStruct(interp, objv[1], frameOptions,
+ sizeof(char *), "option", 0, &index) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ Tcl_Preserve(framePtr);
+ switch ((enum options) index) {
+ case FRAME_CGET:
+ if (objc != 3) {
+ Tcl_WrongNumArgs(interp, 2, objv, "option");
+ result = TCL_ERROR;
+ goto done;
+ }
+ objPtr = Tk_GetOptionValue(interp, (char *) framePtr,
+ framePtr->optionTable, objv[2], framePtr->tkwin);
+ if (objPtr == NULL) {
+ result = TCL_ERROR;
+ goto done;
+ }
+ Tcl_SetObjResult(interp, objPtr);
+ break;
+ case FRAME_CONFIGURE:
+ if (objc <= 3) {
+ objPtr = Tk_GetOptionInfo(interp, (char *) framePtr,
+ framePtr->optionTable, (objc == 3) ? objv[2] : NULL,
+ framePtr->tkwin);
+ if (objPtr == NULL) {
+ result = TCL_ERROR;
+ goto done;
+ }
+ Tcl_SetObjResult(interp, objPtr);
+ } else {
+ /*
+ * Don't allow the options -class, -colormap, -container, -screen,
+ * -use, or -visual to be changed.
+ */
+
+ for (i = 2; i < objc; i++) {
+ const char *arg = Tcl_GetStringFromObj(objv[i], &length);
+
+ if (length < 2) {
+ continue;
+ }
+ c = arg[1];
+ if (((c == 'c') && (length >= 2)
+ && (strncmp(arg, "-class", (unsigned)length) == 0))
+ || ((c == 'c') && (length >= 3)
+ && (strncmp(arg, "-colormap", (unsigned)length) == 0))
+ || ((c == 'c') && (length >= 3)
+ && (strncmp(arg, "-container", (unsigned)length) == 0))
+ || ((c == 's') && (framePtr->type == TYPE_TOPLEVEL)
+ && (strncmp(arg, "-screen", (unsigned)length) == 0))
+ || ((c == 'u') && (framePtr->type == TYPE_TOPLEVEL)
+ && (strncmp(arg, "-use", (unsigned)length) == 0))
+ || ((c == 'v')
+ && (strncmp(arg, "-visual", (unsigned)length) == 0))) {
+
+#ifdef SUPPORT_CONFIG_EMBEDDED
+ if (c == 'u') {
+ const char *string = Tcl_GetString(objv[i+1]);
+
+ if (TkpUseWindow(interp, framePtr->tkwin,
+ string) != TCL_OK) {
+ result = TCL_ERROR;
+ goto done;
+ }
+ continue;
+ }
+#endif
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "can't modify %s option after widget is created",
+ arg));
+ Tcl_SetErrorCode(interp, "TK", "FRAME", "CREATE_ONLY",
+ NULL);
+ result = TCL_ERROR;
+ goto done;
+ }
+ }
+ result = ConfigureFrame(interp, framePtr, objc-2, objv+2);
+ }
+ break;
+ }
+
+ done:
+ Tcl_Release(framePtr);
+ return result;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * DestroyFrame --
+ *
+ * This function is invoked by Tcl_EventuallyFree or Tcl_Release to clean
+ * up the internal structure of a frame at a safe time (when no-one is
+ * using it anymore).
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Everything associated with the frame is freed up.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+DestroyFrame(
+ void *memPtr) /* Info about frame widget. */
+{
+ register Frame *framePtr = memPtr;
+ register Labelframe *labelframePtr = memPtr;
+
+ if (framePtr->type == TYPE_LABELFRAME) {
+ Tk_FreeTextLayout(labelframePtr->textLayout);
+ if (labelframePtr->textGC != None) {
+ Tk_FreeGC(framePtr->display, labelframePtr->textGC);
+ }
+ }
+ if (framePtr->colormap != None) {
+ Tk_FreeColormap(framePtr->display, framePtr->colormap);
+ }
+ ckfree(framePtr);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * DestroyFramePartly --
+ *
+ * This function is invoked to clean up everything that needs tkwin to be
+ * defined when deleted. During the destruction process tkwin is always
+ * set to NULL and this function must be called before that happens.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Some things associated with the frame are freed up.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+DestroyFramePartly(
+ Frame *framePtr) /* Info about frame widget. */
+{
+ register Labelframe *labelframePtr = (Labelframe *) framePtr;
+
+ if (framePtr->type == TYPE_LABELFRAME && labelframePtr->labelWin != NULL) {
+ Tk_DeleteEventHandler(labelframePtr->labelWin, StructureNotifyMask,
+ FrameStructureProc, framePtr);
+ Tk_ManageGeometry(labelframePtr->labelWin, NULL, NULL);
+ if (framePtr->tkwin != Tk_Parent(labelframePtr->labelWin)) {
+ Tk_UnmaintainGeometry(labelframePtr->labelWin, framePtr->tkwin);
+ }
+ Tk_UnmapWindow(labelframePtr->labelWin);
+ labelframePtr->labelWin = NULL;
+ }
+
+ Tk_FreeConfigOptions((char *) framePtr, framePtr->optionTable,
+ framePtr->tkwin);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ConfigureFrame --
+ *
+ * This function is called to process an objv/objc list, plus the Tk
+ * option database, in order to configure (or reconfigure) a frame
+ * widget.
+ *
+ * Results:
+ * The return value is a standard Tcl result. If TCL_ERROR is returned,
+ * then the interp's result contains an error message.
+ *
+ * Side effects:
+ * Configuration information, such as text string, colors, font, etc. get
+ * set for framePtr; old resources get freed, if there were any.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+ConfigureFrame(
+ Tcl_Interp *interp, /* Used for error reporting. */
+ register Frame *framePtr, /* Information about widget; may or may not
+ * already have values for some fields. */
+ int objc, /* Number of valid entries in objv. */
+ Tcl_Obj *const objv[]) /* Arguments. */
+{
+ Tk_SavedOptions savedOptions;
+ char *oldMenuName;
+ Tk_Window oldWindow = NULL;
+ Labelframe *labelframePtr = (Labelframe *) framePtr;
+
+ /*
+ * Need the old menubar name for the menu code to delete it.
+ */
+
+ if (framePtr->menuName == NULL) {
+ oldMenuName = NULL;
+ } else {
+ oldMenuName = ckalloc(strlen(framePtr->menuName) + 1);
+ strcpy(oldMenuName, framePtr->menuName);
+ }
+
+ if (framePtr->type == TYPE_LABELFRAME) {
+ oldWindow = labelframePtr->labelWin;
+ }
+ if (Tk_SetOptions(interp, (char *) framePtr,
+ framePtr->optionTable, objc, objv,
+ framePtr->tkwin, &savedOptions, NULL) != TCL_OK) {
+ if (oldMenuName != NULL) {
+ ckfree(oldMenuName);
+ }
+ return TCL_ERROR;
+ }
+ Tk_FreeSavedOptions(&savedOptions);
+
+ /*
+ * A few of the options require additional processing.
+ */
+
+ if ((((oldMenuName == NULL) && (framePtr->menuName != NULL))
+ || ((oldMenuName != NULL) && (framePtr->menuName == NULL))
+ || ((oldMenuName != NULL) && (framePtr->menuName != NULL)
+ && strcmp(oldMenuName, framePtr->menuName) != 0))
+ && framePtr->type == TYPE_TOPLEVEL) {
+ TkSetWindowMenuBar(interp, framePtr->tkwin, oldMenuName,
+ framePtr->menuName);
+ }
+
+ if (oldMenuName != NULL) {
+ ckfree(oldMenuName);
+ }
+
+ if (framePtr->border != NULL) {
+ Tk_SetBackgroundFromBorder(framePtr->tkwin, framePtr->border);
+ } else {
+ Tk_SetWindowBackgroundPixmap(framePtr->tkwin, None);
+ }
+
+ if (framePtr->highlightWidth < 0) {
+ framePtr->highlightWidth = 0;
+ }
+ if (framePtr->padX < 0) {
+ framePtr->padX = 0;
+ }
+ if (framePtr->padY < 0) {
+ framePtr->padY = 0;
+ }
+
+ /*
+ * If a -labelwidget is specified, check that it is valid and set up
+ * geometry management for it.
+ */
+
+ if (framePtr->type == TYPE_LABELFRAME) {
+ if (oldWindow != labelframePtr->labelWin) {
+ if (oldWindow != NULL) {
+ Tk_DeleteEventHandler(oldWindow, StructureNotifyMask,
+ FrameStructureProc, framePtr);
+ Tk_ManageGeometry(oldWindow, NULL, NULL);
+ Tk_UnmaintainGeometry(oldWindow, framePtr->tkwin);
+ Tk_UnmapWindow(oldWindow);
+ }
+ if (labelframePtr->labelWin != NULL) {
+ Tk_Window ancestor, parent, sibling = NULL;
+
+ /*
+ * Make sure that the frame is either the parent of the window
+ * used as label or a descendant of that parent. Also, don't
+ * allow a top-level window to be managed inside the frame.
+ */
+
+ parent = Tk_Parent(labelframePtr->labelWin);
+ for (ancestor = framePtr->tkwin; ;
+ ancestor = Tk_Parent(ancestor)) {
+ if (ancestor == parent) {
+ break;
+ }
+ sibling = ancestor;
+ if (Tk_IsTopLevel(ancestor)) {
+ goto badLabelWindow;
+ }
+ }
+ if (Tk_IsTopLevel(labelframePtr->labelWin)) {
+ goto badLabelWindow;
+ }
+ if (labelframePtr->labelWin == framePtr->tkwin) {
+ goto badLabelWindow;
+ }
+ Tk_CreateEventHandler(labelframePtr->labelWin,
+ StructureNotifyMask, FrameStructureProc, framePtr);
+ Tk_ManageGeometry(labelframePtr->labelWin, &frameGeomType,
+ framePtr);
+
+ /*
+ * If the frame is not parent to the label, make sure the
+ * label is above its sibling in the stacking order.
+ */
+
+ if (sibling != NULL) {
+ Tk_RestackWindow(labelframePtr->labelWin, Above, sibling);
+ }
+ }
+ }
+ }
+
+ FrameWorldChanged(framePtr);
+ return TCL_OK;
+
+ badLabelWindow:
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "can't use %s as label in this frame",
+ Tk_PathName(labelframePtr->labelWin)));
+ Tcl_SetErrorCode(interp, "TK", "GEOMETRY", "HIERARCHY", NULL);
+ labelframePtr->labelWin = NULL;
+ return TCL_ERROR;
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * FrameWorldChanged --
+ *
+ * This function is called when the world has changed in some way and the
+ * widget needs to recompute all its graphics contexts and determine its
+ * new geometry.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Frame will be relayed out and redisplayed.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+static void
+FrameWorldChanged(
+ ClientData instanceData) /* Information about widget. */
+{
+ Frame *framePtr = instanceData;
+ Labelframe *labelframePtr = instanceData;
+ Tk_Window tkwin = framePtr->tkwin;
+ XGCValues gcValues;
+ GC gc;
+ int anyTextLabel, anyWindowLabel;
+ int bWidthLeft, bWidthRight, bWidthTop, bWidthBottom;
+ const char *labelText;
+
+ anyTextLabel = (framePtr->type == TYPE_LABELFRAME) &&
+ (labelframePtr->textPtr != NULL) &&
+ (labelframePtr->labelWin == NULL);
+ anyWindowLabel = (framePtr->type == TYPE_LABELFRAME) &&
+ (labelframePtr->labelWin != NULL);
+
+ if (framePtr->type == TYPE_LABELFRAME) {
+ /*
+ * The textGC is needed even in the labelWin case, so it's always
+ * created for a labelframe.
+ */
+
+ gcValues.font = Tk_FontId(labelframePtr->tkfont);
+ gcValues.foreground = labelframePtr->textColorPtr->pixel;
+ gcValues.graphics_exposures = False;
+ gc = Tk_GetGC(tkwin, GCForeground | GCFont | GCGraphicsExposures,
+ &gcValues);
+ if (labelframePtr->textGC != None) {
+ Tk_FreeGC(framePtr->display, labelframePtr->textGC);
+ }
+ labelframePtr->textGC = gc;
+
+ /*
+ * Calculate label size.
+ */
+
+ labelframePtr->labelReqWidth = labelframePtr->labelReqHeight = 0;
+
+ if (anyTextLabel) {
+ labelText = Tcl_GetString(labelframePtr->textPtr);
+ Tk_FreeTextLayout(labelframePtr->textLayout);
+ labelframePtr->textLayout =
+ Tk_ComputeTextLayout(labelframePtr->tkfont,
+ labelText, -1, 0, TK_JUSTIFY_CENTER, 0,
+ &labelframePtr->labelReqWidth,
+ &labelframePtr->labelReqHeight);
+ labelframePtr->labelReqWidth += 2 * LABELSPACING;
+ labelframePtr->labelReqHeight += 2 * LABELSPACING;
+ } else if (anyWindowLabel) {
+ labelframePtr->labelReqWidth = Tk_ReqWidth(labelframePtr->labelWin);
+ labelframePtr->labelReqHeight =
+ Tk_ReqHeight(labelframePtr->labelWin);
+ }
+
+ /*
+ * Make sure label size is at least as big as the border. This
+ * simplifies later calculations and gives a better appearance with
+ * thick borders.
+ */
+
+ if ((labelframePtr->labelAnchor >= LABELANCHOR_N) &&
+ (labelframePtr->labelAnchor <= LABELANCHOR_SW)) {
+ if (labelframePtr->labelReqHeight < framePtr->borderWidth) {
+ labelframePtr->labelReqHeight = framePtr->borderWidth;
+ }
+ } else {
+ if (labelframePtr->labelReqWidth < framePtr->borderWidth) {
+ labelframePtr->labelReqWidth = framePtr->borderWidth;
+ }
+ }
+ }
+
+ /*
+ * Calculate individual border widths.
+ */
+
+ bWidthBottom = bWidthTop = bWidthRight = bWidthLeft =
+ framePtr->borderWidth + framePtr->highlightWidth;
+
+ bWidthLeft += framePtr->padX;
+ bWidthRight += framePtr->padX;
+ bWidthTop += framePtr->padY;
+ bWidthBottom += framePtr->padY;
+
+ if (anyTextLabel || anyWindowLabel) {
+ switch (labelframePtr->labelAnchor) {
+ case LABELANCHOR_E:
+ case LABELANCHOR_EN:
+ case LABELANCHOR_ES:
+ bWidthRight += labelframePtr->labelReqWidth -
+ framePtr->borderWidth;
+ break;
+ case LABELANCHOR_N:
+ case LABELANCHOR_NE:
+ case LABELANCHOR_NW:
+ bWidthTop += labelframePtr->labelReqHeight - framePtr->borderWidth;
+ break;
+ case LABELANCHOR_S:
+ case LABELANCHOR_SE:
+ case LABELANCHOR_SW:
+ bWidthBottom += labelframePtr->labelReqHeight -
+ framePtr->borderWidth;
+ break;
+ default:
+ bWidthLeft += labelframePtr->labelReqWidth - framePtr->borderWidth;
+ break;
+ }
+ }
+
+ Tk_SetInternalBorderEx(tkwin, bWidthLeft, bWidthRight, bWidthTop,
+ bWidthBottom);
+
+ ComputeFrameGeometry(framePtr);
+
+ /*
+ * A labelframe should request size for its label.
+ */
+
+ if (framePtr->type == TYPE_LABELFRAME) {
+ int minwidth = labelframePtr->labelReqWidth;
+ int minheight = labelframePtr->labelReqHeight;
+ int padding = framePtr->highlightWidth;
+
+ if (framePtr->borderWidth > 0) {
+ padding += framePtr->borderWidth + LABELMARGIN;
+ }
+ padding *= 2;
+ if ((labelframePtr->labelAnchor >= LABELANCHOR_N) &&
+ (labelframePtr->labelAnchor <= LABELANCHOR_SW)) {
+ minwidth += padding;
+ minheight += framePtr->borderWidth + framePtr->highlightWidth;
+ } else {
+ minheight += padding;
+ minwidth += framePtr->borderWidth + framePtr->highlightWidth;
+ }
+ Tk_SetMinimumRequestSize(tkwin, minwidth, minheight);
+ }
+
+ if ((framePtr->width > 0) || (framePtr->height > 0)) {
+ Tk_GeometryRequest(tkwin, framePtr->width, framePtr->height);
+ }
+
+ if (Tk_IsMapped(tkwin)) {
+ if (!(framePtr->flags & REDRAW_PENDING)) {
+ Tcl_DoWhenIdle(DisplayFrame, framePtr);
+ }
+ framePtr->flags |= REDRAW_PENDING;
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ComputeFrameGeometry --
+ *
+ * This function is called to compute various geometrical information for
+ * a frame, such as where various things get displayed. It's called when
+ * the window is reconfigured.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Display-related numbers get changed in *framePtr.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+ComputeFrameGeometry(
+ register Frame *framePtr) /* Information about widget. */
+{
+ int otherWidth, otherHeight, otherWidthT, otherHeightT, padding;
+ int maxWidth, maxHeight;
+ Tk_Window tkwin;
+ Labelframe *labelframePtr = (Labelframe *) framePtr;
+
+ /*
+ * We have nothing to do here unless there is a label.
+ */
+
+ if (framePtr->type != TYPE_LABELFRAME) {
+ return;
+ }
+ if (labelframePtr->textPtr == NULL && labelframePtr->labelWin == NULL) {
+ return;
+ }
+
+ tkwin = framePtr->tkwin;
+
+ /*
+ * Calculate the available size for the label
+ */
+
+ labelframePtr->labelBox.width = labelframePtr->labelReqWidth;
+ labelframePtr->labelBox.height = labelframePtr->labelReqHeight;
+
+ padding = framePtr->highlightWidth;
+ if (framePtr->borderWidth > 0) {
+ padding += framePtr->borderWidth + LABELMARGIN;
+ }
+ padding *= 2;
+
+ maxHeight = Tk_Height(tkwin);
+ maxWidth = Tk_Width(tkwin);
+
+ if ((labelframePtr->labelAnchor >= LABELANCHOR_N) &&
+ (labelframePtr->labelAnchor <= LABELANCHOR_SW)) {
+ maxWidth -= padding;
+ if (maxWidth < 1) {
+ maxWidth = 1;
+ }
+ } else {
+ maxHeight -= padding;
+ if (maxHeight < 1) {
+ maxHeight = 1;
+ }
+ }
+ if (labelframePtr->labelBox.width > maxWidth) {
+ labelframePtr->labelBox.width = maxWidth;
+ }
+ if (labelframePtr->labelBox.height > maxHeight) {
+ labelframePtr->labelBox.height = maxHeight;
+ }
+
+ /*
+ * Calculate label and text position. The text's position is based on the
+ * requested size (= the text's real size) to get proper alignment if the
+ * text does not fit.
+ */
+
+ otherWidth = Tk_Width(tkwin) - labelframePtr->labelBox.width;
+ otherHeight = Tk_Height(tkwin) - labelframePtr->labelBox.height;
+ otherWidthT = Tk_Width(tkwin) - labelframePtr->labelReqWidth;
+ otherHeightT = Tk_Height(tkwin) - labelframePtr->labelReqHeight;
+ padding = framePtr->highlightWidth;
+
+ switch (labelframePtr->labelAnchor) {
+ case LABELANCHOR_E:
+ case LABELANCHOR_EN:
+ case LABELANCHOR_ES:
+ labelframePtr->labelTextX = otherWidthT - padding;
+ labelframePtr->labelBox.x = otherWidth - padding;
+ break;
+ case LABELANCHOR_N:
+ case LABELANCHOR_NE:
+ case LABELANCHOR_NW:
+ labelframePtr->labelTextY = padding;
+ labelframePtr->labelBox.y = padding;
+ break;
+ case LABELANCHOR_S:
+ case LABELANCHOR_SE:
+ case LABELANCHOR_SW:
+ labelframePtr->labelTextY = otherHeightT - padding;
+ labelframePtr->labelBox.y = otherHeight - padding;
+ break;
+ default:
+ labelframePtr->labelTextX = padding;
+ labelframePtr->labelBox.x = padding;
+ break;
+ }
+
+ if (framePtr->borderWidth > 0) {
+ padding += framePtr->borderWidth + LABELMARGIN;
+ }
+
+ switch (labelframePtr->labelAnchor) {
+ case LABELANCHOR_NW:
+ case LABELANCHOR_SW:
+ labelframePtr->labelTextX = padding;
+ labelframePtr->labelBox.x = padding;
+ break;
+ case LABELANCHOR_N:
+ case LABELANCHOR_S:
+ labelframePtr->labelTextX = otherWidthT / 2;
+ labelframePtr->labelBox.x = otherWidth / 2;
+ break;
+ case LABELANCHOR_NE:
+ case LABELANCHOR_SE:
+ labelframePtr->labelTextX = otherWidthT - padding;
+ labelframePtr->labelBox.x = otherWidth - padding;
+ break;
+ case LABELANCHOR_EN:
+ case LABELANCHOR_WN:
+ labelframePtr->labelTextY = padding;
+ labelframePtr->labelBox.y = padding;
+ break;
+ case LABELANCHOR_E:
+ case LABELANCHOR_W:
+ labelframePtr->labelTextY = otherHeightT / 2;
+ labelframePtr->labelBox.y = otherHeight / 2;
+ break;
+ default:
+ labelframePtr->labelTextY = otherHeightT - padding;
+ labelframePtr->labelBox.y = otherHeight - padding;
+ break;
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * DisplayFrame --
+ *
+ * This function is invoked to display a frame widget.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Commands are output to X to display the frame in its current mode.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+DisplayFrame(
+ ClientData clientData) /* Information about widget. */
+{
+ register Frame *framePtr = clientData;
+ register Tk_Window tkwin = framePtr->tkwin;
+ int bdX1, bdY1, bdX2, bdY2, hlWidth;
+ Pixmap pixmap;
+ TkRegion clipRegion = NULL;
+
+ framePtr->flags &= ~REDRAW_PENDING;
+ if ((framePtr->tkwin == NULL) || !Tk_IsMapped(tkwin)) {
+ return;
+ }
+
+ /*
+ * Highlight shall always be drawn if it exists, so do that first.
+ */
+
+ hlWidth = framePtr->highlightWidth;
+
+ if (hlWidth != 0) {
+ GC fgGC, bgGC;
+
+ bgGC = Tk_GCForColor(framePtr->highlightBgColorPtr,
+ Tk_WindowId(tkwin));
+ if (framePtr->flags & GOT_FOCUS) {
+ fgGC = Tk_GCForColor(framePtr->highlightColorPtr,
+ Tk_WindowId(tkwin));
+ TkpDrawHighlightBorder(tkwin, fgGC, bgGC, hlWidth,
+ Tk_WindowId(tkwin));
+ } else {
+ TkpDrawHighlightBorder(tkwin, bgGC, bgGC, hlWidth,
+ Tk_WindowId(tkwin));
+ }
+ }
+
+ /*
+ * If -background is set to "", no interior is drawn.
+ */
+
+ if (framePtr->border == NULL) {
+ return;
+ }
+
+ if (framePtr->type != TYPE_LABELFRAME) {
+ /*
+ * Pass to platform specific draw function. In general, it just draws
+ * a simple rectangle, but it may "theme" the background.
+ */
+
+ noLabel:
+ TkpDrawFrame(tkwin, framePtr->border, hlWidth,
+ framePtr->borderWidth, framePtr->relief);
+ } else {
+ Labelframe *labelframePtr = (Labelframe *) framePtr;
+
+ if ((labelframePtr->textPtr == NULL) &&
+ (labelframePtr->labelWin == NULL)) {
+ goto noLabel;
+ }
+
+#ifndef TK_NO_DOUBLE_BUFFERING
+ /*
+ * In order to avoid screen flashes, this function redraws the frame
+ * into off-screen memory, then copies it back on-screen in a single
+ * operation. This means there's no point in time where the on-screen
+ * image has been cleared.
+ */
+
+ pixmap = Tk_GetPixmap(framePtr->display, Tk_WindowId(tkwin),
+ Tk_Width(tkwin), Tk_Height(tkwin), Tk_Depth(tkwin));
+#else
+ pixmap = Tk_WindowId(tkwin);
+#endif /* TK_NO_DOUBLE_BUFFERING */
+
+ /*
+ * Clear the pixmap.
+ */
+
+ Tk_Fill3DRectangle(tkwin, pixmap, framePtr->border, 0, 0,
+ Tk_Width(tkwin), Tk_Height(tkwin), 0, TK_RELIEF_FLAT);
+
+ /*
+ * Calculate how the label affects the border's position.
+ */
+
+ bdX1 = bdY1 = hlWidth;
+ bdX2 = Tk_Width(tkwin) - hlWidth;
+ bdY2 = Tk_Height(tkwin) - hlWidth;
+
+ switch (labelframePtr->labelAnchor) {
+ case LABELANCHOR_E:
+ case LABELANCHOR_EN:
+ case LABELANCHOR_ES:
+ bdX2 -= (labelframePtr->labelBox.width-framePtr->borderWidth) / 2;
+ break;
+ case LABELANCHOR_N:
+ case LABELANCHOR_NE:
+ case LABELANCHOR_NW:
+ /*
+ * Since the glyphs of the text tend to be in the lower part we
+ * favor a lower border position by rounding up.
+ */
+
+ bdY1 += (labelframePtr->labelBox.height-framePtr->borderWidth+1)/2;
+ break;
+ case LABELANCHOR_S:
+ case LABELANCHOR_SE:
+ case LABELANCHOR_SW:
+ bdY2 -= (labelframePtr->labelBox.height-framePtr->borderWidth) / 2;
+ break;
+ default:
+ bdX1 += (labelframePtr->labelBox.width-framePtr->borderWidth) / 2;
+ break;
+ }
+
+ /*
+ * Draw border
+ */
+
+ Tk_Draw3DRectangle(tkwin, pixmap, framePtr->border, bdX1, bdY1,
+ bdX2 - bdX1, bdY2 - bdY1, framePtr->borderWidth,
+ framePtr->relief);
+
+ if (labelframePtr->labelWin == NULL) {
+ /*
+ * Clear behind the label
+ */
+
+ Tk_Fill3DRectangle(tkwin, pixmap,
+ framePtr->border, labelframePtr->labelBox.x,
+ labelframePtr->labelBox.y, labelframePtr->labelBox.width,
+ labelframePtr->labelBox.height, 0, TK_RELIEF_FLAT);
+
+ /*
+ * Draw label. If there is not room for the entire label, use
+ * clipping to get a nice appearance.
+ */
+
+ if ((labelframePtr->labelBox.width < labelframePtr->labelReqWidth)
+ || (labelframePtr->labelBox.height <
+ labelframePtr->labelReqHeight)) {
+ clipRegion = TkCreateRegion();
+ TkUnionRectWithRegion(&labelframePtr->labelBox, clipRegion,
+ clipRegion);
+ TkSetRegion(framePtr->display, labelframePtr->textGC,
+ clipRegion);
+ }
+
+ Tk_DrawTextLayout(framePtr->display, pixmap,
+ labelframePtr->textGC, labelframePtr->textLayout,
+ labelframePtr->labelTextX + LABELSPACING,
+ labelframePtr->labelTextY + LABELSPACING, 0, -1);
+
+ if (clipRegion != NULL) {
+ XSetClipMask(framePtr->display, labelframePtr->textGC, None);
+ TkDestroyRegion(clipRegion);
+ }
+ } else {
+ /*
+ * Reposition and map the window (but in different ways depending
+ * on whether the frame is the window's parent).
+ */
+
+ if (framePtr->tkwin == Tk_Parent(labelframePtr->labelWin)) {
+ if ((labelframePtr->labelBox.x != Tk_X(labelframePtr->labelWin))
+ || (labelframePtr->labelBox.y !=
+ Tk_Y(labelframePtr->labelWin))
+ || (labelframePtr->labelBox.width !=
+ Tk_Width(labelframePtr->labelWin))
+ || (labelframePtr->labelBox.height !=
+ Tk_Height(labelframePtr->labelWin))) {
+ Tk_MoveResizeWindow(labelframePtr->labelWin,
+ labelframePtr->labelBox.x,
+ labelframePtr->labelBox.y,
+ labelframePtr->labelBox.width,
+ labelframePtr->labelBox.height);
+ }
+ Tk_MapWindow(labelframePtr->labelWin);
+ } else {
+ Tk_MaintainGeometry(labelframePtr->labelWin, framePtr->tkwin,
+ labelframePtr->labelBox.x, labelframePtr->labelBox.y,
+ labelframePtr->labelBox.width,
+ labelframePtr->labelBox.height);
+ }
+ }
+
+#ifndef TK_NO_DOUBLE_BUFFERING
+ /*
+ * Everything's been redisplayed; now copy the pixmap onto the screen
+ * and free up the pixmap.
+ */
+
+ XCopyArea(framePtr->display, pixmap, Tk_WindowId(tkwin),
+ labelframePtr->textGC, hlWidth, hlWidth,
+ (unsigned) (Tk_Width(tkwin) - 2 * hlWidth),
+ (unsigned) (Tk_Height(tkwin) - 2 * hlWidth),
+ hlWidth, hlWidth);
+ Tk_FreePixmap(framePtr->display, pixmap);
+#endif /* TK_NO_DOUBLE_BUFFERING */
+ }
+
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * FrameEventProc --
+ *
+ * This function is invoked by the Tk dispatcher on structure changes to
+ * a frame. For frames with 3D borders, this function is also invoked for
+ * exposures.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * When the window gets deleted, internal structures get cleaned up.
+ * When it gets exposed, it is redisplayed.
+ *
+ *--------------------------------------------------------------
+ */
+
+static void
+FrameEventProc(
+ ClientData clientData, /* Information about window. */
+ register XEvent *eventPtr) /* Information about event. */
+{
+ register Frame *framePtr = clientData;
+
+ if ((eventPtr->type == Expose) && (eventPtr->xexpose.count == 0)) {
+ goto redraw;
+ } else if (eventPtr->type == ConfigureNotify) {
+ ComputeFrameGeometry(framePtr);
+ goto redraw;
+ } else if (eventPtr->type == DestroyNotify) {
+ if (framePtr->menuName != NULL) {
+ TkSetWindowMenuBar(framePtr->interp, framePtr->tkwin,
+ framePtr->menuName, NULL);
+ ckfree(framePtr->menuName);
+ framePtr->menuName = NULL;
+ }
+ if (framePtr->tkwin != NULL) {
+ /*
+ * If this window is a container, then this event could be coming
+ * from the embedded application, in which case Tk_DestroyWindow
+ * hasn't been called yet. When Tk_DestroyWindow is called later,
+ * then another destroy event will be generated. We need to be
+ * sure we ignore the second event, since the frame could be gone
+ * by then. To do so, delete the event handler explicitly
+ * (normally it's done implicitly by Tk_DestroyWindow).
+ */
+
+ /*
+ * Since the tkwin pointer will be gone when we reach
+ * DestroyFrame, we must free all options now.
+ */
+
+ DestroyFramePartly(framePtr);
+
+ Tk_DeleteEventHandler(framePtr->tkwin,
+ ExposureMask|StructureNotifyMask|FocusChangeMask,
+ FrameEventProc, framePtr);
+ framePtr->tkwin = NULL;
+ Tcl_DeleteCommandFromToken(framePtr->interp, framePtr->widgetCmd);
+ }
+ if (framePtr->flags & REDRAW_PENDING) {
+ Tcl_CancelIdleCall(DisplayFrame, framePtr);
+ }
+ Tcl_CancelIdleCall(MapFrame, framePtr);
+ Tcl_EventuallyFree(framePtr, (Tcl_FreeProc *) DestroyFrame);
+ } else if (eventPtr->type == FocusIn) {
+ if (eventPtr->xfocus.detail != NotifyInferior) {
+ framePtr->flags |= GOT_FOCUS;
+ if (framePtr->highlightWidth > 0) {
+ goto redraw;
+ }
+ }
+ } else if (eventPtr->type == FocusOut) {
+ if (eventPtr->xfocus.detail != NotifyInferior) {
+ framePtr->flags &= ~GOT_FOCUS;
+ if (framePtr->highlightWidth > 0) {
+ goto redraw;
+ }
+ }
+ } else if (eventPtr->type == ActivateNotify) {
+ TkpSetMainMenubar(framePtr->interp, framePtr->tkwin,
+ framePtr->menuName);
+ }
+ return;
+
+ redraw:
+ if ((framePtr->tkwin != NULL) && !(framePtr->flags & REDRAW_PENDING)) {
+ Tcl_DoWhenIdle(DisplayFrame, framePtr);
+ framePtr->flags |= REDRAW_PENDING;
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * FrameCmdDeletedProc --
+ *
+ * This function is invoked when a widget command is deleted. If the
+ * widget isn't already in the process of being destroyed, this command
+ * destroys it.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The widget is destroyed.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+FrameCmdDeletedProc(
+ ClientData clientData) /* Pointer to widget record for widget. */
+{
+ Frame *framePtr = clientData;
+ Tk_Window tkwin = framePtr->tkwin;
+
+ if (framePtr->menuName != NULL) {
+ TkSetWindowMenuBar(framePtr->interp, framePtr->tkwin,
+ framePtr->menuName, NULL);
+ ckfree(framePtr->menuName);
+ framePtr->menuName = NULL;
+ }
+
+ /*
+ * This function 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 function destroys the
+ * widget.
+ */
+
+ if (tkwin != NULL) {
+ /*
+ * Some options need tkwin to be freed, so we free them here, before
+ * setting tkwin to NULL.
+ */
+
+ DestroyFramePartly(framePtr);
+
+ framePtr->tkwin = NULL;
+ Tk_DestroyWindow(tkwin);
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * MapFrame --
+ *
+ * This function is invoked as a when-idle handler to map a newly-created
+ * top-level frame.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The frame given by the clientData argument is mapped.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+MapFrame(
+ ClientData clientData) /* Pointer to frame structure. */
+{
+ Frame *framePtr = clientData;
+
+ /*
+ * Wait for all other background events to be processed before mapping
+ * window. This ensures that the window's correct geometry will have been
+ * determined before it is first mapped, so that the window manager
+ * doesn't get a false idea of its desired geometry.
+ */
+
+ Tcl_Preserve(framePtr);
+ while (1) {
+ if (Tcl_DoOneEvent(TCL_IDLE_EVENTS) == 0) {
+ break;
+ }
+
+ /*
+ * After each event, make sure that the window still exists and quit
+ * if the window has been destroyed.
+ */
+
+ if (framePtr->tkwin == NULL) {
+ Tcl_Release(framePtr);
+ return;
+ }
+ }
+ Tk_MapWindow(framePtr->tkwin);
+ Tcl_Release(framePtr);
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * TkInstallFrameMenu --
+ *
+ * This function is needed when a Windows HWND is created and a menubar
+ * has been set to the window with a system menu. It notifies the menu
+ * package so that the system menu can be rebuilt.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The system menu (if any) is created for the menubar associated with
+ * this frame.
+ *
+ *--------------------------------------------------------------
+ */
+
+void
+TkInstallFrameMenu(
+ Tk_Window tkwin) /* The window that was just created. */
+{
+ TkWindow *winPtr = (TkWindow *) tkwin;
+
+ if (winPtr->mainPtr != NULL) {
+ Frame *framePtr = winPtr->instanceData;
+
+ if (framePtr == NULL) {
+ Tcl_Panic("TkInstallFrameMenu couldn't get frame pointer");
+ }
+ TkpMenuNotifyToplevelCreate(winPtr->mainPtr->interp,
+ framePtr->menuName);
+ }
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * FrameStructureProc --
+ *
+ * This function is invoked whenever StructureNotify events occur for a
+ * window that's managed as label for the frame. This procudure's only
+ * purpose is to clean up when windows are deleted.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The window is disassociated from the frame when it is deleted.
+ *
+ *--------------------------------------------------------------
+ */
+
+static void
+FrameStructureProc(
+ ClientData clientData, /* Pointer to record describing frame. */
+ XEvent *eventPtr) /* Describes what just happened. */
+{
+ Labelframe *labelframePtr = clientData;
+
+ if (eventPtr->type == DestroyNotify) {
+ /*
+ * This should only happen in a labelframe but it doesn't hurt to be
+ * careful.
+ */
+
+ if (labelframePtr->frame.type == TYPE_LABELFRAME) {
+ labelframePtr->labelWin = NULL;
+ FrameWorldChanged(labelframePtr);
+ }
+ }
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * FrameRequestProc --
+ *
+ * This function is invoked whenever a window that's associated with a
+ * frame changes its requested dimensions.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The size and location on the screen of the window may change depending
+ * on the options specified for the frame.
+ *
+ *--------------------------------------------------------------
+ */
+
+static void
+FrameRequestProc(
+ ClientData clientData, /* Pointer to record for frame. */
+ Tk_Window tkwin) /* Window that changed its desired size. */
+{
+ Frame *framePtr = clientData;
+
+ FrameWorldChanged(framePtr);
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * FrameLostSlaveProc --
+ *
+ * This function is invoked by Tk whenever some other geometry claims
+ * control over a slave that used to be managed by us.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Forgets all frame-related information about the slave.
+ *
+ *--------------------------------------------------------------
+ */
+
+static void
+FrameLostSlaveProc(
+ ClientData clientData, /* Frame structure for slave window that was
+ * stolen away. */
+ Tk_Window tkwin) /* Tk's handle for the slave window. */
+{
+ Frame *framePtr = clientData;
+ Labelframe *labelframePtr = clientData;
+
+ /*
+ * This should only happen in a labelframe but it doesn't hurt to be
+ * careful.
+ */
+
+ if (labelframePtr->frame.type == TYPE_LABELFRAME) {
+ Tk_DeleteEventHandler(labelframePtr->labelWin, StructureNotifyMask,
+ FrameStructureProc, labelframePtr);
+ if (framePtr->tkwin != Tk_Parent(labelframePtr->labelWin)) {
+ Tk_UnmaintainGeometry(labelframePtr->labelWin, framePtr->tkwin);
+ }
+ Tk_UnmapWindow(labelframePtr->labelWin);
+ labelframePtr->labelWin = NULL;
+ }
+ FrameWorldChanged(framePtr);
+}
+
+void
+TkMapTopFrame(
+ Tk_Window tkwin)
+{
+ Frame *framePtr = ((TkWindow *) tkwin)->instanceData;
+ Tk_OptionTable optionTable;
+
+ if (Tk_IsTopLevel(tkwin) && framePtr->type == TYPE_FRAME) {
+ framePtr->type = TYPE_TOPLEVEL;
+ Tcl_DoWhenIdle(MapFrame, framePtr);
+ if (framePtr->menuName != NULL) {
+ TkSetWindowMenuBar(framePtr->interp, framePtr->tkwin, NULL,
+ framePtr->menuName);
+ }
+ } else if (!Tk_IsTopLevel(tkwin) && framePtr->type == TYPE_TOPLEVEL) {
+ framePtr->type = TYPE_FRAME;
+ } else {
+ /*
+ * Not a frame or toplevel, skip it.
+ */
+
+ return;
+ }
+
+ /*
+ * The option table has already been created so the cached pointer will be
+ * returned.
+ */
+
+ optionTable = Tk_CreateOptionTable(framePtr->interp,
+ optionSpecs[framePtr->type]);
+ framePtr->optionTable = optionTable;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * TkToplevelWindowFromCommandToken --
+ *
+ * If the given command name to the command for a toplevel window in the
+ * given interpreter, return the tkwin for that toplevel window. Note
+ * that this lookup can't be done using the standard tkwin internal table
+ * because the command might have been renamed.
+ *
+ * Results:
+ * A Tk_Window token, or NULL if the name does not refer to a toplevel
+ * window.
+ *
+ * Side effects:
+ * None.
+ *
+ *--------------------------------------------------------------
+ */
+
+Tk_Window
+TkToplevelWindowForCommand(
+ Tcl_Interp *interp,
+ const char *cmdName)
+{
+ Tcl_CmdInfo cmdInfo;
+ Frame *framePtr;
+
+ if (Tcl_GetCommandInfo(interp, cmdName, &cmdInfo) == 0) {
+ return NULL;
+ }
+ if (cmdInfo.objProc != FrameWidgetObjCmd) {
+ return NULL;
+ }
+ framePtr = cmdInfo.objClientData;
+ if (framePtr->type != TYPE_TOPLEVEL) {
+ return NULL;
+ }
+ return framePtr->tkwin;
+}
+
+/*
+ * Local Variables:
+ * mode: c
+ * c-basic-offset: 4
+ * fill-column: 78
+ * End:
+ */
diff --git a/tk8.6/generic/tkGC.c b/tk8.6/generic/tkGC.c
new file mode 100644
index 0000000..5663ede
--- /dev/null
+++ b/tk8.6/generic/tkGC.c
@@ -0,0 +1,404 @@
+/*
+ * tkGC.c --
+ *
+ * This file maintains a database of read-only graphics contexts for the
+ * Tk toolkit, in order to allow GC's to be shared.
+ *
+ * Copyright (c) 1990-1994 The Regents of the University of California.
+ * Copyright (c) 1994 Sun Microsystems, Inc.
+ *
+ * See the file "license.terms" for information on usage and redistribution of
+ * this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ */
+
+#include "tkInt.h"
+
+/*
+ * One of the following data structures exists for each GC that is currently
+ * active. The structure is indexed with two hash tables, one based on the
+ * values in the graphics context and the other based on the display and GC
+ * identifier.
+ */
+
+typedef struct {
+ GC gc; /* Graphics context. */
+ Display *display; /* Display to which gc belongs. */
+ int refCount; /* Number of active uses of gc. */
+ Tcl_HashEntry *valueHashPtr;/* Entry in valueTable (needed when deleting
+ * this structure). */
+} TkGC;
+
+typedef struct {
+ XGCValues values; /* Desired values for GC. */
+ Display *display; /* Display for which GC is valid. */
+ int screenNum; /* screen number of display */
+ int depth; /* and depth for which GC is valid. */
+} ValueKey;
+
+/*
+ * Forward declarations for functions defined in this file:
+ */
+
+static void GCInit(TkDisplay *dispPtr);
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_GetGC --
+ *
+ * Given a desired set of values for a graphics context, find a read-only
+ * graphics context with the desired values.
+ *
+ * Results:
+ * The return value is the X identifer for the desired graphics context.
+ * The caller should never modify this GC, and should call Tk_FreeGC when
+ * the GC is no longer needed.
+ *
+ * Side effects:
+ * The GC is added to an internal database with a reference count. For
+ * each call to this function, there should eventually be a call to
+ * Tk_FreeGC, so that the database can be cleaned up when GC's aren't
+ * needed anymore.
+ *
+ *----------------------------------------------------------------------
+ */
+
+GC
+Tk_GetGC(
+ Tk_Window tkwin, /* Window in which GC will be used. */
+ register unsigned long valueMask,
+ /* 1 bits correspond to values specified in
+ * *valuesPtr; other values are set from
+ * defaults. */
+ register XGCValues *valuePtr)
+ /* Values are specified here for bits set in
+ * valueMask. */
+{
+ ValueKey valueKey;
+ Tcl_HashEntry *valueHashPtr, *idHashPtr;
+ register TkGC *gcPtr;
+ int isNew;
+ Drawable d, freeDrawable;
+ TkDisplay *dispPtr = ((TkWindow *) tkwin)->dispPtr;
+
+ if (dispPtr->gcInit <= 0) {
+ GCInit(dispPtr);
+ }
+
+ /*
+ * Must zero valueKey at start to clear out pad bytes that may be part of
+ * structure on some systems.
+ */
+
+ memset(&valueKey, 0, sizeof(valueKey));
+
+ /*
+ * First, check to see if there's already a GC that will work for this
+ * request (exact matches only, sorry).
+ */
+
+ if (valueMask & GCFunction) {
+ valueKey.values.function = valuePtr->function;
+ } else {
+ valueKey.values.function = GXcopy;
+ }
+ if (valueMask & GCPlaneMask) {
+ valueKey.values.plane_mask = valuePtr->plane_mask;
+ } else {
+ valueKey.values.plane_mask = (unsigned) ~0;
+ }
+ if (valueMask & GCForeground) {
+ valueKey.values.foreground = valuePtr->foreground;
+ } else {
+ valueKey.values.foreground = 0;
+ }
+ if (valueMask & GCBackground) {
+ valueKey.values.background = valuePtr->background;
+ } else {
+ valueKey.values.background = 1;
+ }
+ if (valueMask & GCLineWidth) {
+ valueKey.values.line_width = valuePtr->line_width;
+ } else {
+ valueKey.values.line_width = 0;
+ }
+ if (valueMask & GCLineStyle) {
+ valueKey.values.line_style = valuePtr->line_style;
+ } else {
+ valueKey.values.line_style = LineSolid;
+ }
+ if (valueMask & GCCapStyle) {
+ valueKey.values.cap_style = valuePtr->cap_style;
+ } else {
+ valueKey.values.cap_style = CapButt;
+ }
+ if (valueMask & GCJoinStyle) {
+ valueKey.values.join_style = valuePtr->join_style;
+ } else {
+ valueKey.values.join_style = JoinMiter;
+ }
+ if (valueMask & GCFillStyle) {
+ valueKey.values.fill_style = valuePtr->fill_style;
+ } else {
+ valueKey.values.fill_style = FillSolid;
+ }
+ if (valueMask & GCFillRule) {
+ valueKey.values.fill_rule = valuePtr->fill_rule;
+ } else {
+ valueKey.values.fill_rule = EvenOddRule;
+ }
+ if (valueMask & GCArcMode) {
+ valueKey.values.arc_mode = valuePtr->arc_mode;
+ } else {
+ valueKey.values.arc_mode = ArcPieSlice;
+ }
+ if (valueMask & GCTile) {
+ valueKey.values.tile = valuePtr->tile;
+ } else {
+ valueKey.values.tile = None;
+ }
+ if (valueMask & GCStipple) {
+ valueKey.values.stipple = valuePtr->stipple;
+ } else {
+ valueKey.values.stipple = None;
+ }
+ if (valueMask & GCTileStipXOrigin) {
+ valueKey.values.ts_x_origin = valuePtr->ts_x_origin;
+ } else {
+ valueKey.values.ts_x_origin = 0;
+ }
+ if (valueMask & GCTileStipYOrigin) {
+ valueKey.values.ts_y_origin = valuePtr->ts_y_origin;
+ } else {
+ valueKey.values.ts_y_origin = 0;
+ }
+ if (valueMask & GCFont) {
+ valueKey.values.font = valuePtr->font;
+ } else {
+ valueKey.values.font = None;
+ }
+ if (valueMask & GCSubwindowMode) {
+ valueKey.values.subwindow_mode = valuePtr->subwindow_mode;
+ } else {
+ valueKey.values.subwindow_mode = ClipByChildren;
+ }
+ if (valueMask & GCGraphicsExposures) {
+ valueKey.values.graphics_exposures = valuePtr->graphics_exposures;
+ } else {
+ valueKey.values.graphics_exposures = True;
+ }
+ if (valueMask & GCClipXOrigin) {
+ valueKey.values.clip_x_origin = valuePtr->clip_x_origin;
+ } else {
+ valueKey.values.clip_x_origin = 0;
+ }
+ if (valueMask & GCClipYOrigin) {
+ valueKey.values.clip_y_origin = valuePtr->clip_y_origin;
+ } else {
+ valueKey.values.clip_y_origin = 0;
+ }
+ if (valueMask & GCClipMask) {
+ valueKey.values.clip_mask = valuePtr->clip_mask;
+ } else {
+ valueKey.values.clip_mask = None;
+ }
+ if (valueMask & GCDashOffset) {
+ valueKey.values.dash_offset = valuePtr->dash_offset;
+ } else {
+ valueKey.values.dash_offset = 0;
+ }
+ if (valueMask & GCDashList) {
+ valueKey.values.dashes = valuePtr->dashes;
+ } else {
+ valueKey.values.dashes = 4;
+ }
+ valueKey.display = Tk_Display(tkwin);
+ valueKey.screenNum = Tk_ScreenNumber(tkwin);
+ valueKey.depth = Tk_Depth(tkwin);
+ valueHashPtr = Tcl_CreateHashEntry(&dispPtr->gcValueTable,
+ (char *) &valueKey, &isNew);
+ if (!isNew) {
+ gcPtr = Tcl_GetHashValue(valueHashPtr);
+ gcPtr->refCount++;
+ return gcPtr->gc;
+ }
+
+ /*
+ * No GC is currently available for this set of values. Allocate a new GC
+ * and add a new structure to the database.
+ */
+
+ gcPtr = ckalloc(sizeof(TkGC));
+
+ /*
+ * Find or make a drawable to use to specify the screen and depth of the
+ * GC. We may have to make a small pixmap, to avoid doing
+ * Tk_MakeWindowExist on the window.
+ */
+
+ freeDrawable = None;
+ if (Tk_WindowId(tkwin) != None) {
+ d = Tk_WindowId(tkwin);
+ } else if (valueKey.depth ==
+ DefaultDepth(valueKey.display, valueKey.screenNum)) {
+ d = RootWindow(valueKey.display, valueKey.screenNum);
+ } else {
+ d = Tk_GetPixmap(valueKey.display,
+ RootWindow(valueKey.display, valueKey.screenNum),
+ 1, 1, valueKey.depth);
+ freeDrawable = d;
+ }
+
+ gcPtr->gc = XCreateGC(valueKey.display, d, valueMask, &valueKey.values);
+ gcPtr->display = valueKey.display;
+ gcPtr->refCount = 1;
+ gcPtr->valueHashPtr = valueHashPtr;
+ idHashPtr = Tcl_CreateHashEntry(&dispPtr->gcIdTable,
+ (char *) gcPtr->gc, &isNew);
+ if (!isNew) {
+ Tcl_Panic("GC already registered in Tk_GetGC");
+ }
+ Tcl_SetHashValue(valueHashPtr, gcPtr);
+ Tcl_SetHashValue(idHashPtr, gcPtr);
+ if (freeDrawable != None) {
+ Tk_FreePixmap(valueKey.display, freeDrawable);
+ }
+
+ return gcPtr->gc;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_FreeGC --
+ *
+ * This function is called to release a graphics context allocated by
+ * Tk_GetGC.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The reference count associated with gc is decremented, and gc is
+ * officially deallocated if no-one is using it anymore.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tk_FreeGC(
+ Display *display, /* Display for which gc was allocated. */
+ GC gc) /* Graphics context to be released. */
+{
+ Tcl_HashEntry *idHashPtr;
+ register TkGC *gcPtr;
+ TkDisplay *dispPtr = TkGetDisplay(display);
+
+ if (!dispPtr->gcInit) {
+ Tcl_Panic("Tk_FreeGC called before Tk_GetGC");
+ }
+ if (dispPtr->gcInit < 0) {
+ /*
+ * The GCCleanup has been called, and remaining GCs have been freed.
+ * This may still get called by other things shutting down, but the
+ * GCs should no longer be in use.
+ */
+
+ return;
+ }
+
+ idHashPtr = Tcl_FindHashEntry(&dispPtr->gcIdTable, (char *) gc);
+ if (idHashPtr == NULL) {
+ Tcl_Panic("Tk_FreeGC received unknown gc argument");
+ }
+ gcPtr = Tcl_GetHashValue(idHashPtr);
+ gcPtr->refCount--;
+ if (gcPtr->refCount == 0) {
+ Tk_FreeXId(gcPtr->display, (XID) XGContextFromGC(gcPtr->gc));
+ XFreeGC(gcPtr->display, gcPtr->gc);
+ Tcl_DeleteHashEntry(gcPtr->valueHashPtr);
+ Tcl_DeleteHashEntry(idHashPtr);
+ ckfree(gcPtr);
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkGCCleanup --
+ *
+ * Frees the structures used for GC management. We need to have it called
+ * near the end, when other cleanup that calls Tk_FreeGC is all done.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * GC resources are freed.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TkGCCleanup(
+ TkDisplay *dispPtr) /* display to clean up resources in */
+{
+ Tcl_HashEntry *entryPtr;
+ Tcl_HashSearch search;
+ TkGC *gcPtr;
+
+ for (entryPtr = Tcl_FirstHashEntry(&dispPtr->gcIdTable, &search);
+ entryPtr != NULL; entryPtr = Tcl_NextHashEntry(&search)) {
+ gcPtr = Tcl_GetHashValue(entryPtr);
+
+ /*
+ * This call is not needed, as it is only used on Unix to restore the
+ * Id to the stack pool, and we don't want to use them anymore.
+ * Tk_FreeXId(gcPtr->display, (XID) XGContextFromGC(gcPtr->gc));
+ */
+
+ XFreeGC(gcPtr->display, gcPtr->gc);
+ Tcl_DeleteHashEntry(gcPtr->valueHashPtr);
+ Tcl_DeleteHashEntry(entryPtr);
+ ckfree(gcPtr);
+ }
+ Tcl_DeleteHashTable(&dispPtr->gcValueTable);
+ Tcl_DeleteHashTable(&dispPtr->gcIdTable);
+ dispPtr->gcInit = -1;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * GCInit --
+ *
+ * Initialize the structures used for GC management.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Read the code.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+GCInit(
+ TkDisplay *dispPtr)
+{
+ if (dispPtr->gcInit < 0) {
+ Tcl_Panic("called GCInit after GCCleanup");
+ }
+ dispPtr->gcInit = 1;
+ Tcl_InitHashTable(&dispPtr->gcValueTable, sizeof(ValueKey)/sizeof(int));
+ Tcl_InitHashTable(&dispPtr->gcIdTable, TCL_ONE_WORD_KEYS);
+}
+
+/*
+ * Local Variables:
+ * mode: c
+ * c-basic-offset: 4
+ * fill-column: 78
+ * End:
+ */
diff --git a/tk8.6/generic/tkGeometry.c b/tk8.6/generic/tkGeometry.c
new file mode 100644
index 0000000..2e0009a
--- /dev/null
+++ b/tk8.6/generic/tkGeometry.c
@@ -0,0 +1,784 @@
+/*
+ * tkGeometry.c --
+ *
+ * This file contains generic Tk code for geometry management (stuff
+ * that's used by all geometry managers).
+ *
+ * Copyright (c) 1990-1994 The Regents of the University of California.
+ * Copyright (c) 1994-1995 Sun Microsystems, Inc.
+ *
+ * See the file "license.terms" for information on usage and redistribution of
+ * this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ */
+
+#include "tkInt.h"
+
+/*
+ * Data structures of the following type are used by Tk_MaintainGeometry. For
+ * each slave managed by Tk_MaintainGeometry, there is one of these structures
+ * associated with its master.
+ */
+
+typedef struct MaintainSlave {
+ Tk_Window slave; /* The slave window being positioned. */
+ Tk_Window master; /* The master that determines slave's
+ * position; it must be a descendant of
+ * slave's parent. */
+ int x, y; /* Desired position of slave relative to
+ * master. */
+ int width, height; /* Desired dimensions of slave. */
+ struct MaintainSlave *nextPtr;
+ /* Next in list of Maintains associated with
+ * master. */
+} MaintainSlave;
+
+/*
+ * For each window that has been specified as a master to Tk_MaintainGeometry,
+ * there is a structure of the following type:
+ */
+
+typedef struct MaintainMaster {
+ Tk_Window ancestor; /* The lowest ancestor of this window for
+ * which we have *not* created a
+ * StructureNotify handler. May be the same as
+ * the window itself. */
+ int checkScheduled; /* Non-zero means that there is already a call
+ * to MaintainCheckProc scheduled as an idle
+ * handler. */
+ MaintainSlave *slavePtr; /* First in list of all slaves associated with
+ * this master. */
+} MaintainMaster;
+
+/*
+ * Prototypes for static procedures in this file:
+ */
+
+static void MaintainCheckProc(ClientData clientData);
+static void MaintainMasterProc(ClientData clientData,
+ XEvent *eventPtr);
+static void MaintainSlaveProc(ClientData clientData,
+ XEvent *eventPtr);
+
+/*
+ *--------------------------------------------------------------
+ *
+ * Tk_ManageGeometry --
+ *
+ * Arrange for a particular procedure to manage the geometry of a given
+ * slave window.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Proc becomes the new geometry manager for tkwin, replacing any
+ * previous geometry manager. The geometry manager will be notified (by
+ * calling procedures in *mgrPtr) when interesting things happen in the
+ * future. If there was an existing geometry manager for tkwin different
+ * from the new one, it is notified by calling its lostSlaveProc.
+ *
+ *--------------------------------------------------------------
+ */
+
+void
+Tk_ManageGeometry(
+ Tk_Window tkwin, /* Window whose geometry is to be managed by
+ * proc. */
+ const Tk_GeomMgr *mgrPtr, /* Static structure describing the geometry
+ * manager. This structure must never go
+ * away. */
+ ClientData clientData) /* Arbitrary one-word argument to pass to
+ * geometry manager procedures. */
+{
+ register TkWindow *winPtr = (TkWindow *) tkwin;
+
+ if ((winPtr->geomMgrPtr != NULL) && (mgrPtr != NULL)
+ && ((winPtr->geomMgrPtr != mgrPtr)
+ || (winPtr->geomData != clientData))
+ && (winPtr->geomMgrPtr->lostSlaveProc != NULL)) {
+ winPtr->geomMgrPtr->lostSlaveProc(winPtr->geomData, tkwin);
+ }
+
+ winPtr->geomMgrPtr = mgrPtr;
+ winPtr->geomData = clientData;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * Tk_GeometryRequest --
+ *
+ * This procedure is invoked by widget code to indicate its preferences
+ * about the size of a window it manages. In general, widget code should
+ * call this procedure rather than Tk_ResizeWindow.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The geometry manager for tkwin (if any) is invoked to handle the
+ * request. If possible, it will reconfigure tkwin and/or other windows
+ * to satisfy the request. The caller gets no indication of success or
+ * failure, but it will get X events if the window size was actually
+ * changed.
+ *
+ *--------------------------------------------------------------
+ */
+
+void
+Tk_GeometryRequest(
+ Tk_Window tkwin, /* Window that geometry information pertains
+ * to. */
+ int reqWidth, int reqHeight)/* Minimum desired dimensions for window, in
+ * pixels. */
+{
+ register TkWindow *winPtr = (TkWindow *) tkwin;
+
+ /*
+ * X gets very upset if a window requests a width or height of zero, so
+ * rounds requested sizes up to at least 1.
+ */
+
+ if (reqWidth <= 0) {
+ reqWidth = 1;
+ }
+ if (reqHeight <= 0) {
+ reqHeight = 1;
+ }
+ if ((reqWidth == winPtr->reqWidth) && (reqHeight == winPtr->reqHeight)) {
+ return;
+ }
+ winPtr->reqWidth = reqWidth;
+ winPtr->reqHeight = reqHeight;
+ if ((winPtr->geomMgrPtr != NULL)
+ && (winPtr->geomMgrPtr->requestProc != NULL)) {
+ winPtr->geomMgrPtr->requestProc(winPtr->geomData, tkwin);
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_SetInternalBorderEx --
+ *
+ * Notify relevant geometry managers that a window has an internal border
+ * of a given width and that child windows should not be placed on that
+ * border.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The border widths are recorded for the window, and all geometry
+ * managers of all children are notified so that can re-layout, if
+ * necessary.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tk_SetInternalBorderEx(
+ Tk_Window tkwin, /* Window that will have internal border. */
+ int left, int right, /* Width of internal border, in pixels. */
+ int top, int bottom)
+{
+ register TkWindow *winPtr = (TkWindow *) tkwin;
+ register int changed = 0;
+
+ if (left < 0) {
+ left = 0;
+ }
+ if (left != winPtr->internalBorderLeft) {
+ winPtr->internalBorderLeft = left;
+ changed = 1;
+ }
+
+ if (right < 0) {
+ right = 0;
+ }
+ if (right != winPtr->internalBorderRight) {
+ winPtr->internalBorderRight = right;
+ changed = 1;
+ }
+
+ if (top < 0) {
+ top = 0;
+ }
+ if (top != winPtr->internalBorderTop) {
+ winPtr->internalBorderTop = top;
+ changed = 1;
+ }
+
+ if (bottom < 0) {
+ bottom = 0;
+ }
+ if (bottom != winPtr->internalBorderBottom) {
+ winPtr->internalBorderBottom = bottom;
+ changed = 1;
+ }
+
+ /*
+ * All the slaves for which this is the master window must now be
+ * repositioned to take account of the new internal border width. To
+ * signal all the geometry managers to do this, just resize the window to
+ * its current size. The ConfigureNotify event will cause geometry
+ * managers to recompute everything.
+ */
+
+ if (changed) {
+ Tk_ResizeWindow(tkwin, Tk_Width(tkwin), Tk_Height(tkwin));
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_SetInternalBorder --
+ *
+ * Notify relevant geometry managers that a window has an internal border
+ * of a given width and that child windows should not be placed on that
+ * border.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The border width is recorded for the window, and all geometry managers
+ * of all children are notified so that can re-layout, if necessary.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tk_SetInternalBorder(
+ Tk_Window tkwin, /* Window that will have internal border. */
+ int width) /* Width of internal border, in pixels. */
+{
+ Tk_SetInternalBorderEx(tkwin, width, width, width, width);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_SetMinimumRequestSize --
+ *
+ * Notify relevant geometry managers that a window has a minimum request
+ * size.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The minimum request size is recorded for the window, and a new size is
+ * requested for the window, if necessary.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tk_SetMinimumRequestSize(
+ Tk_Window tkwin, /* Window that will have internal border. */
+ int minWidth, int minHeight)/* Minimum requested size, in pixels. */
+{
+ register TkWindow *winPtr = (TkWindow *) tkwin;
+
+ if ((winPtr->minReqWidth == minWidth) &&
+ (winPtr->minReqHeight == minHeight)) {
+ return;
+ }
+
+ winPtr->minReqWidth = minWidth;
+ winPtr->minReqHeight = minHeight;
+
+ /*
+ * The changed min size may cause geometry managers to get a different
+ * result, so make them recompute. To signal all the geometry managers to
+ * do this, just resize the window to its current size. The
+ * ConfigureNotify event will cause geometry managers to recompute
+ * everything.
+ */
+
+ Tk_ResizeWindow(tkwin, Tk_Width(tkwin), Tk_Height(tkwin));
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkSetGeometryMaster --
+ *
+ * Set a geometry master for this window. Only one master may own
+ * a window at any time.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * The geometry master is recorded for the window.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TkSetGeometryMaster(
+ Tcl_Interp *interp, /* Current interpreter, for error. */
+ Tk_Window tkwin, /* Window that will have geometry master
+ * set. */
+ const char *master) /* The master identity. */
+{
+ register TkWindow *winPtr = (TkWindow *) tkwin;
+
+ if (winPtr->geometryMaster != NULL &&
+ strcmp(winPtr->geometryMaster, master) == 0) {
+ return TCL_OK;
+ }
+ if (winPtr->geometryMaster != NULL) {
+ if (interp != NULL) {
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "cannot use geometry manager %s inside %s which already"
+ " has slaves managed by %s",
+ master, Tk_PathName(tkwin), winPtr->geometryMaster));
+ Tcl_SetErrorCode(interp, "TK", "GEOMETRY", "FIGHT", NULL);
+ }
+ return TCL_ERROR;
+ }
+
+ winPtr->geometryMaster = ckalloc(strlen(master) + 1);
+ strcpy(winPtr->geometryMaster, master);
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkFreeGeometryMaster --
+ *
+ * Remove a geometry master for this window. Only one master may own
+ * a window at any time.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The geometry master is cleared for the window.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TkFreeGeometryMaster(
+ Tk_Window tkwin, /* Window that will have geometry master
+ * cleared. */
+ const char *master) /* The master identity. */
+{
+ register TkWindow *winPtr = (TkWindow *) tkwin;
+
+ if (winPtr->geometryMaster != NULL &&
+ strcmp(winPtr->geometryMaster, master) != 0) {
+ Tcl_Panic("Trying to free %s from geometry manager %s",
+ winPtr->geometryMaster, master);
+ }
+ if (winPtr->geometryMaster != NULL) {
+ ckfree(winPtr->geometryMaster);
+ winPtr->geometryMaster = NULL;
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_MaintainGeometry --
+ *
+ * This procedure is invoked by geometry managers to handle slaves whose
+ * master's are not their parents. It translates the desired geometry for
+ * the slave into the coordinate system of the parent and respositions
+ * the slave if it isn't already at the right place. Furthermore, it sets
+ * up event handlers so that if the master (or any of its ancestors up to
+ * the slave's parent) is mapped, unmapped, or moved, then the slave will
+ * be adjusted to match.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Event handlers are created and state is allocated to keep track of
+ * slave. Note: if slave was already managed for master by
+ * Tk_MaintainGeometry, then the previous information is replaced with
+ * the new information. The caller must eventually call
+ * Tk_UnmaintainGeometry to eliminate the correspondence (or, the state
+ * is automatically freed when either window is destroyed).
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tk_MaintainGeometry(
+ Tk_Window slave, /* Slave for geometry management. */
+ Tk_Window master, /* Master for slave; must be a descendant of
+ * slave's parent. */
+ int x, int y, /* Desired position of slave within master. */
+ int width, int height) /* Desired dimensions for slave. */
+{
+ Tcl_HashEntry *hPtr;
+ MaintainMaster *masterPtr;
+ register MaintainSlave *slavePtr;
+ int isNew, map;
+ Tk_Window ancestor, parent;
+ TkDisplay *dispPtr = ((TkWindow *) master)->dispPtr;
+
+ if (master == Tk_Parent(slave)) {
+ /*
+ * If the slave is a direct descendant of the master, don't bother
+ * setting up the extra infrastructure for management, just make a
+ * call to Tk_MoveResizeWindow; the parent/child relationship will
+ * take care of the rest.
+ */
+
+ Tk_MoveResizeWindow(slave, x, y, width, height);
+
+ /*
+ * Map the slave if the master is already mapped; otherwise, wait
+ * until the master is mapped later (in which case mapping the slave
+ * is taken care of elsewhere).
+ */
+
+ if (Tk_IsMapped(master)) {
+ Tk_MapWindow(slave);
+ }
+ return;
+ }
+
+ if (!dispPtr->geomInit) {
+ dispPtr->geomInit = 1;
+ Tcl_InitHashTable(&dispPtr->maintainHashTable, TCL_ONE_WORD_KEYS);
+ }
+
+ /*
+ * See if there is already a MaintainMaster structure for the master; if
+ * not, then create one.
+ */
+
+ parent = Tk_Parent(slave);
+ hPtr = Tcl_CreateHashEntry(&dispPtr->maintainHashTable,
+ (char *) master, &isNew);
+ if (!isNew) {
+ masterPtr = Tcl_GetHashValue(hPtr);
+ } else {
+ masterPtr = ckalloc(sizeof(MaintainMaster));
+ masterPtr->ancestor = master;
+ masterPtr->checkScheduled = 0;
+ masterPtr->slavePtr = NULL;
+ Tcl_SetHashValue(hPtr, masterPtr);
+ }
+
+ /*
+ * Create a MaintainSlave structure for the slave if there isn't already
+ * one.
+ */
+
+ for (slavePtr = masterPtr->slavePtr; slavePtr != NULL;
+ slavePtr = slavePtr->nextPtr) {
+ if (slavePtr->slave == slave) {
+ goto gotSlave;
+ }
+ }
+ slavePtr = ckalloc(sizeof(MaintainSlave));
+ slavePtr->slave = slave;
+ slavePtr->master = master;
+ slavePtr->nextPtr = masterPtr->slavePtr;
+ masterPtr->slavePtr = slavePtr;
+ Tk_CreateEventHandler(slave, StructureNotifyMask, MaintainSlaveProc,
+ slavePtr);
+
+ /*
+ * Make sure that there are event handlers registered for all the windows
+ * between master and slave's parent (including master but not slave's
+ * parent). There may already be handlers for master and some of its
+ * ancestors (masterPtr->ancestor tells how many).
+ */
+
+ for (ancestor = master; ancestor != parent;
+ ancestor = Tk_Parent(ancestor)) {
+ if (ancestor == masterPtr->ancestor) {
+ Tk_CreateEventHandler(ancestor, StructureNotifyMask,
+ MaintainMasterProc, masterPtr);
+ masterPtr->ancestor = Tk_Parent(ancestor);
+ }
+ }
+
+ /*
+ * Fill in up-to-date information in the structure, then update the window
+ * if it's not currently in the right place or state.
+ */
+
+ gotSlave:
+ slavePtr->x = x;
+ slavePtr->y = y;
+ slavePtr->width = width;
+ slavePtr->height = height;
+ map = 1;
+ for (ancestor = slavePtr->master; ; ancestor = Tk_Parent(ancestor)) {
+ if (!Tk_IsMapped(ancestor) && (ancestor != parent)) {
+ map = 0;
+ }
+ if (ancestor == parent) {
+ if ((x != Tk_X(slavePtr->slave))
+ || (y != Tk_Y(slavePtr->slave))
+ || (width != Tk_Width(slavePtr->slave))
+ || (height != Tk_Height(slavePtr->slave))) {
+ Tk_MoveResizeWindow(slavePtr->slave, x, y, width, height);
+ }
+ if (map) {
+ Tk_MapWindow(slavePtr->slave);
+ } else {
+ Tk_UnmapWindow(slavePtr->slave);
+ }
+ break;
+ }
+ x += Tk_X(ancestor) + Tk_Changes(ancestor)->border_width;
+ y += Tk_Y(ancestor) + Tk_Changes(ancestor)->border_width;
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_UnmaintainGeometry --
+ *
+ * This procedure cancels a previous Tk_MaintainGeometry call, so that
+ * the relationship between slave and master is no longer maintained.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The slave is unmapped and state is released, so that slave won't track
+ * master any more. If we weren't previously managing slave relative to
+ * master, then this procedure has no effect.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tk_UnmaintainGeometry(
+ Tk_Window slave, /* Slave for geometry management. */
+ Tk_Window master) /* Master for slave; must be a descendant of
+ * slave's parent. */
+{
+ Tcl_HashEntry *hPtr;
+ MaintainMaster *masterPtr;
+ register MaintainSlave *slavePtr, *prevPtr;
+ Tk_Window ancestor;
+ TkDisplay *dispPtr = ((TkWindow *) slave)->dispPtr;
+
+ if (master == Tk_Parent(slave)) {
+ /*
+ * If the slave is a direct descendant of the master,
+ * Tk_MaintainGeometry will not have set up any of the extra
+ * infrastructure. Don't even bother to look for it, just return.
+ */
+ return;
+ }
+
+ if (!dispPtr->geomInit) {
+ dispPtr->geomInit = 1;
+ Tcl_InitHashTable(&dispPtr->maintainHashTable, TCL_ONE_WORD_KEYS);
+ }
+
+ if (!(((TkWindow *) slave)->flags & TK_ALREADY_DEAD)) {
+ Tk_UnmapWindow(slave);
+ }
+ hPtr = Tcl_FindHashEntry(&dispPtr->maintainHashTable, (char *) master);
+ if (hPtr == NULL) {
+ return;
+ }
+ masterPtr = Tcl_GetHashValue(hPtr);
+ slavePtr = masterPtr->slavePtr;
+ if (slavePtr->slave == slave) {
+ masterPtr->slavePtr = slavePtr->nextPtr;
+ } else {
+ for (prevPtr = slavePtr, slavePtr = slavePtr->nextPtr; ;
+ prevPtr = slavePtr, slavePtr = slavePtr->nextPtr) {
+ if (slavePtr == NULL) {
+ return;
+ }
+ if (slavePtr->slave == slave) {
+ prevPtr->nextPtr = slavePtr->nextPtr;
+ break;
+ }
+ }
+ }
+ Tk_DeleteEventHandler(slavePtr->slave, StructureNotifyMask,
+ MaintainSlaveProc, slavePtr);
+ ckfree(slavePtr);
+ if (masterPtr->slavePtr == NULL) {
+ if (masterPtr->ancestor != NULL) {
+ for (ancestor = master; ; ancestor = Tk_Parent(ancestor)) {
+ Tk_DeleteEventHandler(ancestor, StructureNotifyMask,
+ MaintainMasterProc, masterPtr);
+ if (ancestor == masterPtr->ancestor) {
+ break;
+ }
+ }
+ }
+ if (masterPtr->checkScheduled) {
+ Tcl_CancelIdleCall(MaintainCheckProc, masterPtr);
+ }
+ Tcl_DeleteHashEntry(hPtr);
+ ckfree(masterPtr);
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * MaintainMasterProc --
+ *
+ * This procedure is invoked by the Tk event dispatcher in response to
+ * StructureNotify events on the master or one of its ancestors, on
+ * behalf of Tk_MaintainGeometry.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * It schedules a call to MaintainCheckProc, which will eventually caused
+ * the postions and mapped states to be recalculated for all the
+ * maintained slaves of the master. Or, if the master window is being
+ * deleted then state is cleaned up.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+MaintainMasterProc(
+ ClientData clientData, /* Pointer to MaintainMaster structure for the
+ * master window. */
+ XEvent *eventPtr) /* Describes what just happened. */
+{
+ MaintainMaster *masterPtr = clientData;
+ MaintainSlave *slavePtr;
+ int done;
+
+ if ((eventPtr->type == ConfigureNotify)
+ || (eventPtr->type == MapNotify)
+ || (eventPtr->type == UnmapNotify)) {
+ if (!masterPtr->checkScheduled) {
+ masterPtr->checkScheduled = 1;
+ Tcl_DoWhenIdle(MaintainCheckProc, masterPtr);
+ }
+ } else if (eventPtr->type == DestroyNotify) {
+ /*
+ * Delete all of the state associated with this master, but be careful
+ * not to use masterPtr after the last slave is deleted, since its
+ * memory will have been freed.
+ */
+
+ done = 0;
+ do {
+ slavePtr = masterPtr->slavePtr;
+ if (slavePtr->nextPtr == NULL) {
+ done = 1;
+ }
+ Tk_UnmaintainGeometry(slavePtr->slave, slavePtr->master);
+ } while (!done);
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * MaintainSlaveProc --
+ *
+ * This procedure is invoked by the Tk event dispatcher in response to
+ * StructureNotify events on a slave being managed by
+ * Tk_MaintainGeometry.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * If the event is a DestroyNotify event then the Maintain state and
+ * event handlers for this slave are deleted.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+MaintainSlaveProc(
+ ClientData clientData, /* Pointer to MaintainSlave structure for
+ * master-slave pair. */
+ XEvent *eventPtr) /* Describes what just happened. */
+{
+ MaintainSlave *slavePtr = clientData;
+
+ if (eventPtr->type == DestroyNotify) {
+ Tk_UnmaintainGeometry(slavePtr->slave, slavePtr->master);
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * MaintainCheckProc --
+ *
+ * This procedure is invoked by the Tk event dispatcher as an idle
+ * handler, when a master or one of its ancestors has been reconfigured,
+ * mapped, or unmapped. Its job is to scan all of the slaves for the
+ * master and reposition them, map them, or unmap them as needed to
+ * maintain their geometry relative to the master.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Slaves can get repositioned, mapped, or unmapped.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+MaintainCheckProc(
+ ClientData clientData) /* Pointer to MaintainMaster structure for the
+ * master window. */
+{
+ MaintainMaster *masterPtr = clientData;
+ MaintainSlave *slavePtr;
+ Tk_Window ancestor, parent;
+ int x, y, map;
+
+ masterPtr->checkScheduled = 0;
+ for (slavePtr = masterPtr->slavePtr; slavePtr != NULL;
+ slavePtr = slavePtr->nextPtr) {
+ parent = Tk_Parent(slavePtr->slave);
+ x = slavePtr->x;
+ y = slavePtr->y;
+ map = 1;
+ for (ancestor = slavePtr->master; ; ancestor = Tk_Parent(ancestor)) {
+ if (!Tk_IsMapped(ancestor) && (ancestor != parent)) {
+ map = 0;
+ }
+ if (ancestor == parent) {
+ if ((x != Tk_X(slavePtr->slave))
+ || (y != Tk_Y(slavePtr->slave))) {
+ Tk_MoveWindow(slavePtr->slave, x, y);
+ }
+ if (map) {
+ Tk_MapWindow(slavePtr->slave);
+ } else {
+ Tk_UnmapWindow(slavePtr->slave);
+ }
+ break;
+ }
+ x += Tk_X(ancestor) + Tk_Changes(ancestor)->border_width;
+ y += Tk_Y(ancestor) + Tk_Changes(ancestor)->border_width;
+ }
+ }
+}
+
+/*
+ * Local Variables:
+ * mode: c
+ * c-basic-offset: 4
+ * fill-column: 78
+ * End:
+ */
diff --git a/tk8.6/generic/tkGet.c b/tk8.6/generic/tkGet.c
new file mode 100644
index 0000000..d58b4a5
--- /dev/null
+++ b/tk8.6/generic/tkGet.c
@@ -0,0 +1,752 @@
+/*
+ * tkGet.c --
+ *
+ * This file contains a number of "Tk_GetXXX" procedures, which parse
+ * text strings into useful forms for Tk. This file has the simpler
+ * functions, like Tk_GetDirection and Tk_GetUid. The more complex
+ * functions like Tk_GetColor are in separate files.
+ *
+ * Copyright (c) 1991-1994 The Regents of the University of California.
+ * Copyright (c) 1994-1997 Sun Microsystems, Inc.
+ *
+ * See the file "license.terms" for information on usage and redistribution of
+ * this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ */
+
+#include "tkInt.h"
+
+/*
+ * One of these structures is created per thread to store thread-specific
+ * data. In this case, it is used to house the Tk_Uid structs used by each
+ * thread. The "dataKey" below is used to locate the ThreadSpecificData for
+ * the current thread.
+ */
+
+typedef struct ThreadSpecificData {
+ int initialized;
+ Tcl_HashTable uidTable;
+} ThreadSpecificData;
+static Tcl_ThreadDataKey dataKey;
+
+static void FreeUidThreadExitProc(ClientData clientData);
+
+/*
+ * The following tables defines the string values for reliefs, which are
+ * used by Tk_GetAnchorFromObj and Tk_GetJustifyFromObj.
+ */
+
+static const char *const anchorStrings[] = {
+ "n", "ne", "e", "se", "s", "sw", "w", "nw", "center", NULL
+};
+static const char *const justifyStrings[] = {
+ "left", "right", "center", 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(
+ Tcl_Interp *interp, /* Used for error reporting. */
+ Tcl_Obj *objPtr, /* The object we are trying to get the value
+ * from. */
+ Tk_Anchor *anchorPtr) /* Where to place the Tk_Anchor that
+ * corresponds to the string value of
+ * objPtr. */
+{
+ int index, code;
+
+ code = Tcl_GetIndexFromObj(interp, objPtr, anchorStrings, "anchor", 0,
+ &index);
+ if (code == TCL_OK) {
+ *anchorPtr = (Tk_Anchor) index;
+ }
+ return code;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * Tk_GetAnchor --
+ *
+ * Given a string, return the corresponding Tk_Anchor.
+ *
+ * Results:
+ * The return value is a standard Tcl return result. If TCL_OK is
+ * returned, then everything went well and the position is stored at
+ * *anchorPtr; otherwise TCL_ERROR is returned and an error message is
+ * left in the interp's result.
+ *
+ * Side effects:
+ * None.
+ *
+ *--------------------------------------------------------------
+ */
+
+int
+Tk_GetAnchor(
+ Tcl_Interp *interp, /* Use this for error reporting. */
+ const char *string, /* String describing a direction. */
+ Tk_Anchor *anchorPtr) /* Where to store Tk_Anchor corresponding to
+ * string. */
+{
+ switch (string[0]) {
+ case 'n':
+ if (string[1] == 0) {
+ *anchorPtr = TK_ANCHOR_N;
+ return TCL_OK;
+ } else if ((string[1] == 'e') && (string[2] == 0)) {
+ *anchorPtr = TK_ANCHOR_NE;
+ return TCL_OK;
+ } else if ((string[1] == 'w') && (string[2] == 0)) {
+ *anchorPtr = TK_ANCHOR_NW;
+ return TCL_OK;
+ }
+ goto error;
+ case 's':
+ if (string[1] == 0) {
+ *anchorPtr = TK_ANCHOR_S;
+ return TCL_OK;
+ } else if ((string[1] == 'e') && (string[2] == 0)) {
+ *anchorPtr = TK_ANCHOR_SE;
+ return TCL_OK;
+ } else if ((string[1] == 'w') && (string[2] == 0)) {
+ *anchorPtr = TK_ANCHOR_SW;
+ return TCL_OK;
+ } else {
+ goto error;
+ }
+ case 'e':
+ if (string[1] == 0) {
+ *anchorPtr = TK_ANCHOR_E;
+ return TCL_OK;
+ }
+ goto error;
+ case 'w':
+ if (string[1] == 0) {
+ *anchorPtr = TK_ANCHOR_W;
+ return TCL_OK;
+ }
+ goto error;
+ case 'c':
+ if (strncmp(string, "center", strlen(string)) == 0) {
+ *anchorPtr = TK_ANCHOR_CENTER;
+ return TCL_OK;
+ }
+ goto error;
+ }
+
+ error:
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "bad anchor position \"%s\": must be"
+ " n, ne, e, se, s, sw, w, nw, or center", string));
+ Tcl_SetErrorCode(interp, "TK", "VALUE", "ANCHOR", NULL);
+ return TCL_ERROR;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * Tk_NameOfAnchor --
+ *
+ * Given a Tk_Anchor, return the string that corresponds to it.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * None.
+ *
+ *--------------------------------------------------------------
+ */
+
+const char *
+Tk_NameOfAnchor(
+ Tk_Anchor anchor) /* Anchor for which identifying string is
+ * desired. */
+{
+ switch (anchor) {
+ case TK_ANCHOR_N: return "n";
+ case TK_ANCHOR_NE: return "ne";
+ case TK_ANCHOR_E: return "e";
+ case TK_ANCHOR_SE: return "se";
+ case TK_ANCHOR_S: return "s";
+ case TK_ANCHOR_SW: return "sw";
+ case TK_ANCHOR_W: return "w";
+ case TK_ANCHOR_NW: return "nw";
+ case TK_ANCHOR_CENTER: return "center";
+ }
+ return "unknown anchor position";
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * Tk_GetJoinStyle --
+ *
+ * Given a string, return the corresponding Tk JoinStyle.
+ *
+ * Results:
+ * The return value is a standard Tcl return result. If TCL_OK is
+ * returned, then everything went well and the justification is stored at
+ * *joinPtr; otherwise TCL_ERROR is returned and an error message is left
+ * in the interp's result.
+ *
+ * Side effects:
+ * None.
+ *
+ *--------------------------------------------------------------
+ */
+
+int
+Tk_GetJoinStyle(
+ Tcl_Interp *interp, /* Use this for error reporting. */
+ const char *string, /* String describing a justification style. */
+ int *joinPtr) /* Where to store join style corresponding to
+ * string. */
+{
+ int c;
+ size_t length;
+
+ c = string[0];
+ length = strlen(string);
+
+ if ((c == 'b') && (strncmp(string, "bevel", length) == 0)) {
+ *joinPtr = JoinBevel;
+ return TCL_OK;
+ }
+ if ((c == 'm') && (strncmp(string, "miter", length) == 0)) {
+ *joinPtr = JoinMiter;
+ return TCL_OK;
+ }
+ if ((c == 'r') && (strncmp(string, "round", length) == 0)) {
+ *joinPtr = JoinRound;
+ return TCL_OK;
+ }
+
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "bad join style \"%s\": must be bevel, miter, or round",
+ string));
+ Tcl_SetErrorCode(interp, "TK", "VALUE", "JOIN", NULL);
+ return TCL_ERROR;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * Tk_NameOfJoinStyle --
+ *
+ * Given a Tk JoinStyle, return the string that corresponds to it.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * None.
+ *
+ *--------------------------------------------------------------
+ */
+
+const char *
+Tk_NameOfJoinStyle(
+ int join) /* Join style for which identifying string is
+ * desired. */
+{
+ switch (join) {
+ case JoinBevel: return "bevel";
+ case JoinMiter: return "miter";
+ case JoinRound: return "round";
+ }
+ return "unknown join style";
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * Tk_GetCapStyle --
+ *
+ * Given a string, return the corresponding Tk CapStyle.
+ *
+ * Results:
+ * The return value is a standard Tcl return result. If TCL_OK is
+ * returned, then everything went well and the justification is stored at
+ * *capPtr; otherwise TCL_ERROR is returned and an error message is left
+ * in the interp's result.
+ *
+ * Side effects:
+ * None.
+ *
+ *--------------------------------------------------------------
+ */
+
+int
+Tk_GetCapStyle(
+ Tcl_Interp *interp, /* Use this for error reporting. */
+ const char *string, /* String describing a justification style. */
+ int *capPtr) /* Where to store cap style corresponding to
+ * string. */
+{
+ int c;
+ size_t length;
+
+ c = string[0];
+ length = strlen(string);
+
+ if ((c == 'b') && (strncmp(string, "butt", length) == 0)) {
+ *capPtr = CapButt;
+ return TCL_OK;
+ }
+ if ((c == 'p') && (strncmp(string, "projecting", length) == 0)) {
+ *capPtr = CapProjecting;
+ return TCL_OK;
+ }
+ if ((c == 'r') && (strncmp(string, "round", length) == 0)) {
+ *capPtr = CapRound;
+ return TCL_OK;
+ }
+
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "bad cap style \"%s\": must be butt, projecting, or round",
+ string));
+ Tcl_SetErrorCode(interp, "TK", "VALUE", "CAP", NULL);
+ return TCL_ERROR;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * Tk_NameOfCapStyle --
+ *
+ * Given a Tk CapStyle, return the string that corresponds to it.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * None.
+ *
+ *--------------------------------------------------------------
+ */
+
+const char *
+Tk_NameOfCapStyle(
+ int cap) /* Cap style for which identifying string is
+ * desired. */
+{
+ switch (cap) {
+ case CapButt: return "butt";
+ case CapProjecting: return "projecting";
+ case CapRound: return "round";
+ }
+ return "unknown cap style";
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_GetJustifyFromObj --
+ *
+ * Return a Tk_Justify value based on the value of the objPtr.
+ *
+ * Results:
+ * The return value is a standard Tcl result. If an error occurs during
+ * conversion, an error message is left in the interpreter's result
+ * unless "interp" is NULL.
+ *
+ * Side effects:
+ * The object gets converted by Tcl_GetIndexFromObj.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tk_GetJustifyFromObj(
+ Tcl_Interp *interp, /* Used for error reporting. */
+ Tcl_Obj *objPtr, /* The object we are trying to get the value
+ * from. */
+ Tk_Justify *justifyPtr) /* Where to place the Tk_Justify that
+ * corresponds to the string value of
+ * objPtr. */
+{
+ int index, code;
+
+ code = Tcl_GetIndexFromObj(interp, objPtr, justifyStrings,
+ "justification", 0, &index);
+ if (code == TCL_OK) {
+ *justifyPtr = (Tk_Justify) index;
+ }
+ return code;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * Tk_GetJustify --
+ *
+ * Given a string, return the corresponding Tk_Justify.
+ *
+ * Results:
+ * The return value is a standard Tcl return result. If TCL_OK is
+ * returned, then everything went well and the justification is stored at
+ * *justifyPtr; otherwise TCL_ERROR is returned and an error message is
+ * left in the interp's result.
+ *
+ * Side effects:
+ * None.
+ *
+ *--------------------------------------------------------------
+ */
+
+int
+Tk_GetJustify(
+ Tcl_Interp *interp, /* Use this for error reporting. */
+ const char *string, /* String describing a justification style. */
+ Tk_Justify *justifyPtr) /* Where to store Tk_Justify corresponding to
+ * string. */
+{
+ int c;
+ size_t length;
+
+ c = string[0];
+ length = strlen(string);
+
+ if ((c == 'l') && (strncmp(string, "left", length) == 0)) {
+ *justifyPtr = TK_JUSTIFY_LEFT;
+ return TCL_OK;
+ }
+ if ((c == 'r') && (strncmp(string, "right", length) == 0)) {
+ *justifyPtr = TK_JUSTIFY_RIGHT;
+ return TCL_OK;
+ }
+ if ((c == 'c') && (strncmp(string, "center", length) == 0)) {
+ *justifyPtr = TK_JUSTIFY_CENTER;
+ return TCL_OK;
+ }
+
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "bad justification \"%s\": must be left, right, or center",
+ string));
+ Tcl_SetErrorCode(interp, "TK", "VALUE", "JUSTIFY", NULL);
+ return TCL_ERROR;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * Tk_NameOfJustify --
+ *
+ * Given a Tk_Justify, return the string that corresponds
+ * to it.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * None.
+ *
+ *--------------------------------------------------------------
+ */
+
+const char *
+Tk_NameOfJustify(
+ Tk_Justify justify) /* Justification style for which identifying
+ * string is desired. */
+{
+ switch (justify) {
+ case TK_JUSTIFY_LEFT: return "left";
+ case TK_JUSTIFY_RIGHT: return "right";
+ case TK_JUSTIFY_CENTER: return "center";
+ }
+ return "unknown justification style";
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * FreeUidThreadExitProc --
+ *
+ * Cleans up memory used for Tk_Uids in the thread.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * All information in the identifier table is deleted.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+FreeUidThreadExitProc(
+ ClientData clientData) /* Not used. */
+{
+ ThreadSpecificData *tsdPtr =
+ Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
+
+ Tcl_DeleteHashTable(&tsdPtr->uidTable);
+ tsdPtr->initialized = 0;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_GetUid --
+ *
+ * Given a string, this function returns a unique identifier for the
+ * string.
+ *
+ * Results:
+ * This function returns a Tk_Uid corresponding to the "string" argument.
+ * The Tk_Uid has a string value identical to string (strcmp will return
+ * 0), but it's guaranteed that any other calls to this function with a
+ * string equal to "string" will return exactly the same result (i.e. can
+ * compare Tk_Uid *values* directly, without having to call strcmp on
+ * what they point to).
+ *
+ * Side effects:
+ * New information may be entered into the identifier table.
+ *
+ *----------------------------------------------------------------------
+ */
+
+Tk_Uid
+Tk_GetUid(
+ const char *string) /* String to convert. */
+{
+ int dummy;
+ ThreadSpecificData *tsdPtr =
+ Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
+ Tcl_HashTable *tablePtr = &tsdPtr->uidTable;
+
+ if (!tsdPtr->initialized) {
+ Tcl_InitHashTable(tablePtr, TCL_STRING_KEYS);
+ Tcl_CreateThreadExitHandler(FreeUidThreadExitProc, NULL);
+ tsdPtr->initialized = 1;
+ }
+ return (Tk_Uid) Tcl_GetHashKey(tablePtr,
+ Tcl_CreateHashEntry(tablePtr, string, &dummy));
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * Tk_GetScreenMM --
+ *
+ * Given a string, returns the number of screen millimeters corresponding
+ * to that string.
+ *
+ * Results:
+ * The return value is a standard Tcl return result. If TCL_OK is
+ * returned, then everything went well and the screen distance is stored
+ * at *doublePtr; otherwise TCL_ERROR is returned and an error message is
+ * left in the interp's result.
+ *
+ * Side effects:
+ * None.
+ *
+ *--------------------------------------------------------------
+ */
+
+int
+Tk_GetScreenMM(
+ Tcl_Interp *interp, /* Use this for error reporting. */
+ Tk_Window tkwin, /* Window whose screen determines conversion
+ * from centimeters and other absolute
+ * units. */
+ const char *string, /* String describing a screen distance. */
+ double *doublePtr) /* Place to store converted result. */
+{
+ char *end;
+ double d;
+
+ d = strtod(string, &end);
+ if (end == string) {
+ goto error;
+ }
+ while ((*end != '\0') && isspace(UCHAR(*end))) {
+ end++;
+ }
+ switch (*end) {
+ case 0:
+ d /= WidthOfScreen(Tk_Screen(tkwin));
+ d *= WidthMMOfScreen(Tk_Screen(tkwin));
+ break;
+ case 'c':
+ d *= 10;
+ end++;
+ break;
+ case 'i':
+ d *= 25.4;
+ end++;
+ break;
+ case 'm':
+ end++;
+ break;
+ case 'p':
+ d *= 25.4/72.0;
+ end++;
+ break;
+ default:
+ goto error;
+ }
+ while ((*end != '\0') && isspace(UCHAR(*end))) {
+ end++;
+ }
+ if (*end != 0) {
+ goto error;
+ }
+ *doublePtr = d;
+ return TCL_OK;
+
+ error:
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "bad screen distance \"%s\"", string));
+ Tcl_SetErrorCode(interp, "TK", "VALUE", "SCREEN_DISTANCE", NULL);
+ return TCL_ERROR;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * Tk_GetPixels --
+ *
+ * Given a string, returns the number of pixels corresponding to that
+ * string.
+ *
+ * Results:
+ * The return value is a standard Tcl return result. If TCL_OK is
+ * returned, then everything went well and the rounded pixel distance is
+ * stored at *intPtr; otherwise TCL_ERROR is returned and an error
+ * message is left in the interp's result.
+ *
+ * Side effects:
+ * None.
+ *
+ *--------------------------------------------------------------
+ */
+
+int
+Tk_GetPixels(
+ Tcl_Interp *interp, /* Use this for error reporting. */
+ Tk_Window tkwin, /* Window whose screen determines conversion
+ * from centimeters and other absolute
+ * units. */
+ const char *string, /* String describing a number of pixels. */
+ int *intPtr) /* Place to store converted result. */
+{
+ double d;
+
+ if (TkGetDoublePixels(interp, tkwin, string, &d) != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ if (d < 0) {
+ *intPtr = (int) (d - 0.5);
+ } else {
+ *intPtr = (int) (d + 0.5);
+ }
+ return TCL_OK;
+}
+/*
+ *--------------------------------------------------------------
+ *
+ * TkGetDoublePixels --
+ *
+ * Given a string, returns the number of pixels corresponding to that
+ * string.
+ *
+ * Results:
+ * The return value is a standard Tcl return result. If TCL_OK is
+ * returned, then everything went well and the pixel distance is stored
+ * at *doublePtr; otherwise TCL_ERROR is returned and an error message is
+ * left in interp->result.
+ *
+ * Side effects:
+ * None.
+ *
+ *--------------------------------------------------------------
+ */
+
+int
+TkGetDoublePixels(
+ Tcl_Interp *interp, /* Use this for error reporting. */
+ Tk_Window tkwin, /* Window whose screen determines conversion
+ * from centimeters and other absolute
+ * units. */
+ const char *string, /* String describing a number of pixels. */
+ double *doublePtr) /* Place to store converted result. */
+{
+ char *end;
+ double d;
+
+ d = strtod((char *) string, &end);
+ if (end == string) {
+ goto error;
+ }
+ while ((*end != '\0') && isspace(UCHAR(*end))) {
+ end++;
+ }
+ switch (*end) {
+ case 0:
+ break;
+ case 'c':
+ d *= 10*WidthOfScreen(Tk_Screen(tkwin));
+ d /= WidthMMOfScreen(Tk_Screen(tkwin));
+ end++;
+ break;
+ case 'i':
+ d *= 25.4*WidthOfScreen(Tk_Screen(tkwin));
+ d /= WidthMMOfScreen(Tk_Screen(tkwin));
+ end++;
+ break;
+ case 'm':
+ d *= WidthOfScreen(Tk_Screen(tkwin));
+ d /= WidthMMOfScreen(Tk_Screen(tkwin));
+ end++;
+ break;
+ case 'p':
+ d *= (25.4/72.0)*WidthOfScreen(Tk_Screen(tkwin));
+ d /= WidthMMOfScreen(Tk_Screen(tkwin));
+ end++;
+ break;
+ default:
+ goto error;
+ }
+ while ((*end != '\0') && isspace(UCHAR(*end))) {
+ end++;
+ }
+ if (*end != 0) {
+ goto error;
+ }
+ *doublePtr = d;
+ return TCL_OK;
+
+ error:
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "bad screen distance \"%s\"", string));
+ Tcl_SetErrorCode(interp, "TK", "VALUE", "FRACTIONAL_PIXELS", NULL);
+ return TCL_ERROR;
+}
+
+/*
+ * Local Variables:
+ * mode: c
+ * c-basic-offset: 4
+ * fill-column: 78
+ * End:
+ */
diff --git a/tk8.6/generic/tkGrab.c b/tk8.6/generic/tkGrab.c
new file mode 100644
index 0000000..00d4511
--- /dev/null
+++ b/tk8.6/generic/tkGrab.c
@@ -0,0 +1,1595 @@
+/*
+ * tkGrab.c --
+ *
+ * This file provides functions that implement grabs for Tk.
+ *
+ * Copyright (c) 1992-1994 The Regents of the University of California.
+ * Copyright (c) 1994-1997 Sun Microsystems, Inc.
+ *
+ * See the file "license.terms" for information on usage and redistribution of
+ * this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ */
+
+#include "tkInt.h"
+
+#ifdef _WIN32
+#include "tkWinInt.h"
+#elif !defined(MAC_OSX_TK)
+#include "tkUnixInt.h"
+#endif
+
+/*
+ * The grab state machine has four states: ungrabbed, button pressed, grabbed,
+ * and button pressed while grabbed. In addition, there are three pieces of
+ * grab state information: the current grab window, the current restrict
+ * window, and whether the mouse is captured.
+ *
+ * The current grab window specifies the point in the Tk window heirarchy
+ * above which pointer events will not be reported. Any window within the
+ * subtree below the grab window will continue to receive events as normal.
+ * Events outside of the grab tree will be reported to the grab window.
+ *
+ * If the current restrict window is set, then all pointer events will be
+ * reported only to the restrict window. The restrict window is normally set
+ * during an automatic button grab.
+ *
+ * The mouse capture state specifies whether the window system will report
+ * mouse events outside of any Tk toplevels. This is set during a global grab
+ * or an automatic button grab.
+ *
+ * The transitions between different states is given in the following table:
+ *
+ * Event\State U B G GB
+ * ----------- -- -- -- --
+ * FirstPress B B GB GB
+ * Press B B G GB
+ * Release U B G GB
+ * LastRelease U U G G
+ * Grab G G G G
+ * Ungrab U B U U
+ *
+ * Note: U=Ungrabbed, B=Button, G=Grabbed, GB=Grab and Button
+ *
+ * In addition, the following conditions are always true:
+ *
+ * State\Variable Grab Restrict Capture
+ * -------------- ---- -------- -------
+ * Ungrabbed 0 0 0
+ * Button 0 1 1
+ * Grabbed 1 0 b/g
+ * Grab and Button 1 1 1
+ *
+ * Note: 0 means variable is set to NULL, 1 means variable is set to some
+ * window, b/g means the variable is set to a window if a button is currently
+ * down or a global grab is in effect.
+ *
+ * The final complication to all of this is enter and leave events. In order
+ * to correctly handle all of the various cases, Tk cannot rely on X
+ * enter/leave events in all situations. The following describes the correct
+ * sequence of enter and leave events that should be observed by Tk scripts:
+ *
+ * Event(state) Enter/Leave From -> To
+ * ------------ ----------------------
+ * LastRelease(B | GB): restrict window -> anc(grab window, event window)
+ * Grab(U | B): event window -> anc(grab window, event window)
+ * Grab(G): anc(old grab window, event window) ->
+ * anc(new grab window, event window)
+ * Grab(GB): restrict window -> anc(new grab window, event window)
+ * Ungrab(G): anc(grab window, event window) -> event window
+ * Ungrab(GB): restrict window -> event window
+ *
+ * Note: anc(x,y) returns the least ancestor of y that is in the tree of x,
+ * terminating at toplevels.
+ */
+
+/*
+ * The following structure is used to pass information to GrabRestrictProc
+ * from EatGrabEvents.
+ */
+
+typedef struct {
+ Display *display; /* Display from which to discard events. */
+ unsigned int serial; /* Serial number with which to compare. */
+} GrabInfo;
+
+/*
+ * Bit definitions for grabFlags field of TkDisplay structures:
+ *
+ * GRAB_GLOBAL 1 means this is a global grab (we grabbed via
+ * the server so all applications are locked out).
+ * 0 means this is a local grab that affects only
+ * this application.
+ * GRAB_TEMP_GLOBAL 1 means we've temporarily grabbed via the
+ * server because a button is down and we want to
+ * make sure that we get the button-up event. The
+ * grab will be released when the last mouse
+ * button goes up.
+ */
+
+#define GRAB_GLOBAL 1
+#define GRAB_TEMP_GLOBAL 4
+
+/*
+ * The following structure is a Tcl_Event that triggers a change in the
+ * grabWinPtr field of a display. This event guarantees that the change occurs
+ * in the proper order relative to enter and leave events.
+ */
+
+typedef struct NewGrabWinEvent {
+ Tcl_Event header; /* Standard information for all Tcl events. */
+ TkDisplay *dispPtr; /* Display whose grab window is to change. */
+ Window grabWindow; /* New grab window for display. This is
+ * recorded instead of a (TkWindow *) because
+ * it will allow us to detect cases where the
+ * window is destroyed before this event is
+ * processed. */
+} NewGrabWinEvent;
+
+/*
+ * The following magic value is stored in the "send_event" field of
+ * EnterNotify and LeaveNotify events that are generated in this file. This
+ * allows us to separate "real" events coming from the server from those that
+ * we generated.
+ */
+
+#define GENERATED_GRAB_EVENT_MAGIC ((Bool) 0x147321ac)
+
+/*
+ * Mask that selects any of the state bits corresponding to buttons, plus
+ * masks that select individual buttons' bits:
+ */
+
+#define ALL_BUTTONS \
+ (Button1Mask|Button2Mask|Button3Mask|Button4Mask|Button5Mask)
+static const unsigned int buttonStates[] = {
+ Button1Mask, Button2Mask, Button3Mask, Button4Mask, Button5Mask
+};
+
+/*
+ * Forward declarations for functions declared later in this file:
+ */
+
+static void EatGrabEvents(TkDisplay *dispPtr, unsigned int serial);
+static TkWindow * FindCommonAncestor(TkWindow *winPtr1,
+ TkWindow *winPtr2, int *countPtr1, int *countPtr2);
+static Tk_RestrictProc GrabRestrictProc;
+static int GrabWinEventProc(Tcl_Event *evPtr, int flags);
+static void MovePointer2(TkWindow *sourcePtr, TkWindow *destPtr,
+ int mode, int leaveEvents, int EnterEvents);
+static void QueueGrabWindowChange(TkDisplay *dispPtr,
+ TkWindow *grabWinPtr);
+static void ReleaseButtonGrab(TkDisplay *dispPtr);
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_GrabObjCmd --
+ *
+ * This function is invoked to process the "grab" Tcl command. See the
+ * user documentation for details on what it does.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * See the user documentation.
+ *
+ *----------------------------------------------------------------------
+ */
+
+ /* ARGSUSED */
+int
+Tk_GrabObjCmd(
+ ClientData clientData, /* Main window associated with interpreter. */
+ Tcl_Interp *interp, /* Current interpreter. */
+ int objc, /* Number of arguments. */
+ Tcl_Obj *const objv[]) /* Argument objects. */
+{
+ int globalGrab;
+ Tk_Window tkwin;
+ TkDisplay *dispPtr;
+ const char *arg;
+ int index;
+ int len;
+ static const char *const optionStrings[] = {
+ "current", "release", "set", "status", NULL
+ };
+ static const char *const flagStrings[] = {
+ "-global", NULL
+ };
+ enum options {
+ GRABCMD_CURRENT, GRABCMD_RELEASE, GRABCMD_SET, GRABCMD_STATUS
+ };
+
+ if (objc < 2) {
+ /*
+ * Can't use Tcl_WrongNumArgs here because we want the message to
+ * read:
+ * wrong # args: should be "cmd ?-global? window" or "cmd option
+ * ?arg ...?"
+ * We can fake it with Tcl_WrongNumArgs if we assume the command name
+ * is "grab", but if it has been aliased, the message will be
+ * incorrect.
+ */
+
+ Tcl_WrongNumArgs(interp, 1, objv, "?-global? window");
+ Tcl_AppendResult(interp, " or \"", Tcl_GetString(objv[0]),
+ " option ?arg ...?\"", NULL);
+ /* This API not exposed:
+ *
+ ((Interp *) interp)->flags |= INTERP_ALTERNATE_WRONG_ARGS;
+ Tcl_WrongNumArgs(interp, 1, objv, "option ?arg ...?");
+ */
+ return TCL_ERROR;
+ }
+
+ /*
+ * First check for a window name or "-global" as the first argument.
+ */
+
+ arg = Tcl_GetStringFromObj(objv[1], &len);
+ if (arg[0] == '.') {
+ /* [grab window] */
+ if (objc != 2) {
+ Tcl_WrongNumArgs(interp, 1, objv, "?-global? window");
+ return TCL_ERROR;
+ }
+ tkwin = Tk_NameToWindow(interp, arg, clientData);
+ if (tkwin == NULL) {
+ return TCL_ERROR;
+ }
+ return Tk_Grab(interp, tkwin, 0);
+ } else if (arg[0] == '-' && len > 1) {
+ if (Tcl_GetIndexFromObj(interp, objv[1], flagStrings, "option", 0,
+ &index) != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ /* [grab -global window] */
+ if (objc != 3) {
+ Tcl_WrongNumArgs(interp, 1, objv, "?-global? window");
+ return TCL_ERROR;
+ }
+ tkwin = Tk_NameToWindow(interp, Tcl_GetString(objv[2]), clientData);
+ if (tkwin == NULL) {
+ return TCL_ERROR;
+ }
+ return Tk_Grab(interp, tkwin, 1);
+ }
+
+ /*
+ * First argument is not a window name and not "-global", find out which
+ * option it is.
+ */
+
+ if (Tcl_GetIndexFromObj(interp, objv[1], optionStrings, "option", 0,
+ &index) != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ switch ((enum options) index) {
+ case GRABCMD_CURRENT:
+ /* [grab current ?window?] */
+ if (objc > 3) {
+ Tcl_WrongNumArgs(interp, 1, objv, "current ?window?");
+ return TCL_ERROR;
+ }
+ if (objc == 3) {
+ tkwin = Tk_NameToWindow(interp, Tcl_GetString(objv[2]),
+ clientData);
+ if (tkwin == NULL) {
+ return TCL_ERROR;
+ }
+ dispPtr = ((TkWindow *) tkwin)->dispPtr;
+ if (dispPtr->eventualGrabWinPtr != NULL) {
+ Tcl_SetObjResult(interp, TkNewWindowObj((Tk_Window)
+ dispPtr->eventualGrabWinPtr));
+ }
+ } else {
+ Tcl_Obj *resultObj = Tcl_NewObj();
+
+ for (dispPtr = TkGetDisplayList(); dispPtr != NULL;
+ dispPtr = dispPtr->nextPtr) {
+ if (dispPtr->eventualGrabWinPtr != NULL) {
+ Tcl_ListObjAppendElement(NULL, resultObj, TkNewWindowObj(
+ (Tk_Window) dispPtr->eventualGrabWinPtr));
+ }
+ }
+ Tcl_SetObjResult(interp, resultObj);
+ }
+ return TCL_OK;
+
+ case GRABCMD_RELEASE:
+ /* [grab release window] */
+ if (objc != 3) {
+ Tcl_WrongNumArgs(interp, 1, objv, "release window");
+ return TCL_ERROR;
+ }
+ tkwin = Tk_NameToWindow(interp, Tcl_GetString(objv[2]), clientData);
+ if (tkwin == NULL) {
+ Tcl_ResetResult(interp);
+ } else {
+ Tk_Ungrab(tkwin);
+ }
+ break;
+
+ case GRABCMD_SET:
+ /* [grab set ?-global? window] */
+ if ((objc != 3) && (objc != 4)) {
+ Tcl_WrongNumArgs(interp, 1, objv, "set ?-global? window");
+ return TCL_ERROR;
+ }
+ if (objc == 3) {
+ globalGrab = 0;
+ tkwin = Tk_NameToWindow(interp, Tcl_GetString(objv[2]),
+ clientData);
+ } else {
+ globalGrab = 1;
+
+ /*
+ * We could just test the argument by hand instead of using
+ * Tcl_GetIndexFromObj; the benefit of using the function is that
+ * it sets up the error message for us, so we are certain to be
+ * consistant with the rest of Tcl.
+ */
+
+ if (Tcl_GetIndexFromObj(interp, objv[2], flagStrings, "option",
+ 0, &index) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ tkwin = Tk_NameToWindow(interp, Tcl_GetString(objv[3]),
+ clientData);
+ }
+ if (tkwin == NULL) {
+ return TCL_ERROR;
+ }
+ return Tk_Grab(interp, tkwin, globalGrab);
+
+ case GRABCMD_STATUS: {
+ /* [grab status window] */
+ TkWindow *winPtr;
+ const char *statusString;
+
+ if (objc != 3) {
+ Tcl_WrongNumArgs(interp, 1, objv, "status window");
+ return TCL_ERROR;
+ }
+ winPtr = (TkWindow *) Tk_NameToWindow(interp, Tcl_GetString(objv[2]),
+ clientData);
+ if (winPtr == NULL) {
+ return TCL_ERROR;
+ }
+ dispPtr = winPtr->dispPtr;
+ if (dispPtr->eventualGrabWinPtr != winPtr) {
+ statusString = "none";
+ } else if (dispPtr->grabFlags & GRAB_GLOBAL) {
+ statusString = "global";
+ } else {
+ statusString = "local";
+ }
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(statusString, -1));
+ break;
+ }
+ }
+
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_Grab --
+ *
+ * Grabs the pointer and keyboard, so that mouse-related events are only
+ * reported relative to a given window and its descendants.
+ *
+ * Results:
+ * A standard Tcl result is returned. TCL_OK is the normal return value;
+ * if the grab could not be set then TCL_ERROR is returned and the
+ * interp's result will hold an error message.
+ *
+ * Side effects:
+ * Once this call completes successfully, no window outside the tree
+ * rooted at tkwin will receive pointer- or keyboard-related events until
+ * the next call to Tk_Ungrab. If a previous grab was in effect within
+ * this application, then it is replaced with a new one.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tk_Grab(
+ Tcl_Interp *interp, /* Used for error reporting. */
+ Tk_Window tkwin, /* Window on whose behalf the pointer is to be
+ * grabbed. */
+ int grabGlobal) /* Non-zero means issue a grab to the server
+ * so that no other application gets mouse or
+ * keyboard events. Zero means the grab only
+ * applies within this application. */
+{
+ int grabResult, numTries;
+ TkWindow *winPtr = (TkWindow *) tkwin;
+ TkDisplay *dispPtr = winPtr->dispPtr;
+ TkWindow *winPtr2;
+ unsigned int serial;
+
+ ReleaseButtonGrab(dispPtr);
+ if (dispPtr->eventualGrabWinPtr != NULL) {
+ if ((dispPtr->eventualGrabWinPtr == winPtr)
+ && (grabGlobal == ((dispPtr->grabFlags & GRAB_GLOBAL) != 0))) {
+ return TCL_OK;
+ }
+ if (dispPtr->eventualGrabWinPtr->mainPtr != winPtr->mainPtr) {
+ goto alreadyGrabbed;
+ }
+ Tk_Ungrab((Tk_Window) dispPtr->eventualGrabWinPtr);
+ }
+
+ Tk_MakeWindowExist(tkwin);
+#ifndef MAC_OSX_TK
+ if (!grabGlobal)
+#else
+ if (0)
+#endif /* MAC_OSX_TK */
+ {
+ Window dummy1, dummy2;
+ int dummy3, dummy4, dummy5, dummy6;
+ unsigned int state;
+
+ /*
+ * Local grab. However, if any mouse buttons are down, turn it into a
+ * global grab temporarily, until the last button goes up. This does
+ * two things: (a) it makes sure that we see the button-up event; and
+ * (b) it allows us to track mouse motion among all of the windows of
+ * this application.
+ */
+
+ dispPtr->grabFlags &= ~(GRAB_GLOBAL|GRAB_TEMP_GLOBAL);
+ XQueryPointer(dispPtr->display, winPtr->window, &dummy1,
+ &dummy2, &dummy3, &dummy4, &dummy5, &dummy6, &state);
+ if (state & ALL_BUTTONS) {
+ dispPtr->grabFlags |= GRAB_TEMP_GLOBAL;
+ goto setGlobalGrab;
+ }
+ } else {
+ dispPtr->grabFlags |= GRAB_GLOBAL;
+ setGlobalGrab:
+
+ /*
+ * Tricky point: must ungrab before grabbing. This is needed in case
+ * there is a button auto-grab already in effect. If there is, and the
+ * mouse has moved to a different window, X won't generate enter and
+ * leave events to move the mouse if we grab without ungrabbing.
+ */
+
+ XUngrabPointer(dispPtr->display, CurrentTime);
+ serial = NextRequest(dispPtr->display);
+
+ /*
+ * Another tricky point: there are races with some window managers
+ * that can cause grabs to fail because the window manager hasn't
+ * released its grab quickly enough. To work around this problem,
+ * retry a few times after AlreadyGrabbed errors to give the grab
+ * release enough time to register with the server.
+ */
+
+ grabResult = 0; /* Needed only to prevent gcc compiler
+ * warnings. */
+ for (numTries = 0; numTries < 10; numTries++) {
+ grabResult = XGrabPointer(dispPtr->display, winPtr->window,
+ True, ButtonPressMask|ButtonReleaseMask|ButtonMotionMask
+ |PointerMotionMask, GrabModeAsync, GrabModeAsync, None,
+ None, CurrentTime);
+ if (grabResult != AlreadyGrabbed) {
+ break;
+ }
+ Tcl_Sleep(100);
+ }
+ if (grabResult != 0) {
+ goto grabError;
+ }
+ grabResult = XGrabKeyboard(dispPtr->display, Tk_WindowId(tkwin),
+ False, GrabModeAsync, GrabModeAsync, CurrentTime);
+ if (grabResult != 0) {
+ XUngrabPointer(dispPtr->display, CurrentTime);
+ goto grabError;
+ }
+
+ /*
+ * Eat up any grab-related events generated by the server for the
+ * grab. There are several reasons for doing this:
+ *
+ * 1. We have to synthesize the events for local grabs anyway, since
+ * the server doesn't participate in them.
+ * 2. The server doesn't always generate the right events for global
+ * grabs (e.g. it generates events even if the current window is in
+ * the grab tree, which we don't want).
+ * 3. We want all the grab-related events to be processed immediately
+ * (before other events that are already queued); events coming
+ * from the server will be in the wrong place, but events we
+ * synthesize here will go to the front of the queue.
+ */
+
+ EatGrabEvents(dispPtr, serial);
+ }
+
+ /*
+ * Synthesize leave events to move the pointer from its current window up
+ * to the lowest ancestor that it has in common with the grab window.
+ * However, only do this if the pointer is outside the grab window's
+ * subtree but inside the grab window's application.
+ */
+
+ if ((dispPtr->serverWinPtr != NULL)
+ && (dispPtr->serverWinPtr->mainPtr == winPtr->mainPtr)) {
+ for (winPtr2 = dispPtr->serverWinPtr; ; winPtr2 = winPtr2->parentPtr) {
+ if (winPtr2 == winPtr) {
+ break;
+ }
+ if (winPtr2 == NULL) {
+ MovePointer2(dispPtr->serverWinPtr, winPtr, NotifyGrab, 1, 0);
+ break;
+ }
+ }
+ }
+ QueueGrabWindowChange(dispPtr, winPtr);
+ return TCL_OK;
+
+ grabError:
+ if (grabResult == GrabNotViewable) {
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "grab failed: window not viewable", -1));
+ Tcl_SetErrorCode(interp, "TK", "GRAB", "UNVIEWABLE", NULL);
+ } else if (grabResult == AlreadyGrabbed) {
+ alreadyGrabbed:
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "grab failed: another application has grab", -1));
+ Tcl_SetErrorCode(interp, "TK", "GRAB", "GRABBED", NULL);
+ } else if (grabResult == GrabFrozen) {
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "grab failed: keyboard or pointer frozen", -1));
+ Tcl_SetErrorCode(interp, "TK", "GRAB", "FROZEN", NULL);
+ } else if (grabResult == GrabInvalidTime) {
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "grab failed: invalid time", -1));
+ Tcl_SetErrorCode(interp, "TK", "GRAB", "BAD_TIME", NULL);
+ } else {
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "grab failed for unknown reason (code %d)", grabResult));
+ Tcl_SetErrorCode(interp, "TK", "GRAB", "UNKNOWN", NULL);
+ }
+ return TCL_ERROR;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_Ungrab --
+ *
+ * Releases a grab on the mouse pointer and keyboard, if there is one set
+ * on the specified window.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Pointer and keyboard events will start being delivered to other
+ * windows again.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tk_Ungrab(
+ Tk_Window tkwin) /* Window whose grab should be released. */
+{
+ TkDisplay *dispPtr;
+ TkWindow *grabWinPtr, *winPtr;
+ unsigned int serial;
+
+ grabWinPtr = (TkWindow *) tkwin;
+ dispPtr = grabWinPtr->dispPtr;
+ if (grabWinPtr != dispPtr->eventualGrabWinPtr) {
+ return;
+ }
+ ReleaseButtonGrab(dispPtr);
+ QueueGrabWindowChange(dispPtr, NULL);
+ if (dispPtr->grabFlags & (GRAB_GLOBAL|GRAB_TEMP_GLOBAL)) {
+ dispPtr->grabFlags &= ~(GRAB_GLOBAL|GRAB_TEMP_GLOBAL);
+ serial = NextRequest(dispPtr->display);
+ XUngrabPointer(dispPtr->display, CurrentTime);
+ XUngrabKeyboard(dispPtr->display, CurrentTime);
+ EatGrabEvents(dispPtr, serial);
+ }
+
+ /*
+ * Generate events to move the pointer back to the window where it really
+ * is. Some notes:
+ * 1. As with grabs, only do this if the "real" window is not a descendant
+ * of the grab window, since in this case the pointer is already where
+ * it's supposed to be.
+ * 2. If the "real" window is in some other application then don't
+ * generate any events at all, since everything's already been reported
+ * correctly.
+ * 3. Only generate enter events. Don't generate leave events, because we
+ * never told the lower-level windows that they had the pointer in the
+ * first place.
+ */
+
+ for (winPtr = dispPtr->serverWinPtr; ; winPtr = winPtr->parentPtr) {
+ if (winPtr == grabWinPtr) {
+ break;
+ }
+ if (winPtr == NULL) {
+ if ((dispPtr->serverWinPtr == NULL) ||
+ (dispPtr->serverWinPtr->mainPtr == grabWinPtr->mainPtr)) {
+ MovePointer2(grabWinPtr, dispPtr->serverWinPtr,
+ NotifyUngrab, 0, 1);
+ }
+ break;
+ }
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ReleaseButtonGrab --
+ *
+ * This function is called to release a simulated button grab, if there
+ * is one in effect. A button grab is present whenever
+ * dispPtr->buttonWinPtr is non-NULL or when the GRAB_TEMP_GLOBAL flag is
+ * set.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * DispPtr->buttonWinPtr is reset to NULL, and enter and leave events are
+ * generated if necessary to move the pointer from the button grab window
+ * to its current window.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+ReleaseButtonGrab(
+ register TkDisplay *dispPtr)/* Display whose button grab is to be
+ * released. */
+{
+ unsigned int serial;
+
+ if (dispPtr->buttonWinPtr != NULL) {
+ if (dispPtr->buttonWinPtr != dispPtr->serverWinPtr) {
+ MovePointer2(dispPtr->buttonWinPtr, dispPtr->serverWinPtr,
+ NotifyUngrab, 1, 1);
+ }
+ dispPtr->buttonWinPtr = NULL;
+ }
+ if (dispPtr->grabFlags & GRAB_TEMP_GLOBAL) {
+ dispPtr->grabFlags &= ~GRAB_TEMP_GLOBAL;
+ serial = NextRequest(dispPtr->display);
+ XUngrabPointer(dispPtr->display, CurrentTime);
+ XUngrabKeyboard(dispPtr->display, CurrentTime);
+ EatGrabEvents(dispPtr, serial);
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkPointerEvent --
+ *
+ * This function is called for each pointer-related event, before the
+ * event has been processed. It does various things to make grabs work
+ * correctly.
+ *
+ * Results:
+ * If the return value is 1 it means the event should be processed (event
+ * handlers should be invoked). If the return value is 0 it means the
+ * event should be ignored in order to make grabs work correctly. In some
+ * cases this function modifies the event.
+ *
+ * Side effects:
+ * Grab state information may be updated. New events may also be pushed
+ * back onto the event queue to replace or augment the one passed in
+ * here.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TkPointerEvent(
+ register XEvent *eventPtr, /* Pointer to the event. */
+ TkWindow *winPtr) /* Tk's information for window where event was
+ * reported. */
+{
+ register TkWindow *winPtr2;
+ TkDisplay *dispPtr = winPtr->dispPtr;
+ unsigned int serial;
+ int outsideGrabTree = 0;
+ int ancestorOfGrab = 0;
+ int appGrabbed = 0; /* Non-zero means event is being reported to
+ * an application that is affected by the
+ * grab. */
+
+ /*
+ * Collect information about the grab (if any).
+ */
+
+ switch (TkGrabState(winPtr)) {
+ case TK_GRAB_IN_TREE:
+ appGrabbed = 1;
+ break;
+ case TK_GRAB_ANCESTOR:
+ appGrabbed = 1;
+ outsideGrabTree = 1;
+ ancestorOfGrab = 1;
+ break;
+ case TK_GRAB_EXCLUDED:
+ appGrabbed = 1;
+ outsideGrabTree = 1;
+ break;
+ }
+
+ if ((eventPtr->type == EnterNotify) || (eventPtr->type == LeaveNotify)) {
+ /*
+ * Keep track of what window the mouse is *really* over. Any events
+ * that we generate have a special send_event value, which is detected
+ * below and used to ignore the event for purposes of setting
+ * serverWinPtr.
+ */
+
+ if (eventPtr->xcrossing.send_event != GENERATED_GRAB_EVENT_MAGIC) {
+ if ((eventPtr->type == LeaveNotify) &&
+ (winPtr->flags & TK_TOP_HIERARCHY)) {
+ dispPtr->serverWinPtr = NULL;
+ } else {
+ dispPtr->serverWinPtr = winPtr;
+ }
+ }
+
+ /*
+ * When a grab is active, X continues to report enter and leave events
+ * for windows outside the tree of the grab window:
+ * 1. Detect these events and ignore them except for windows above the
+ * grab window.
+ * 2. Allow Enter and Leave events to pass through the windows above
+ * the grab window, but never let them end up with the pointer *in*
+ * one of those windows.
+ */
+
+ if (dispPtr->grabWinPtr != NULL) {
+ if (outsideGrabTree && appGrabbed) {
+ if (!ancestorOfGrab) {
+ return 0;
+ }
+ switch (eventPtr->xcrossing.detail) {
+ case NotifyInferior:
+ return 0;
+ case NotifyAncestor:
+ eventPtr->xcrossing.detail = NotifyVirtual;
+ break;
+ case NotifyNonlinear:
+ eventPtr->xcrossing.detail = NotifyNonlinearVirtual;
+ break;
+ }
+ }
+
+ /*
+ * Make buttons have the same grab-like behavior inside a grab as
+ * they do outside a grab: do this by ignoring enter and leave
+ * events except for the window in which the button was pressed.
+ */
+
+ if ((dispPtr->buttonWinPtr != NULL)
+ && (winPtr != dispPtr->buttonWinPtr)) {
+ return 0;
+ }
+ }
+ return 1;
+ }
+
+ if (!appGrabbed) {
+ return 1;
+ }
+
+ if (eventPtr->type == MotionNotify) {
+ /*
+ * When grabs are active, X reports motion events relative to the
+ * window under the pointer. Instead, it should report the events
+ * relative to the window the button went down in, if there is a
+ * button down. Otherwise, if the pointer window is outside the
+ * subtree of the grab window, the events should be reported relative
+ * to the grab window. Otherwise, the event should be reported to the
+ * pointer window.
+ */
+
+ winPtr2 = winPtr;
+ if (dispPtr->buttonWinPtr != NULL) {
+ winPtr2 = dispPtr->buttonWinPtr;
+ } else if (outsideGrabTree || (dispPtr->serverWinPtr == NULL)) {
+ winPtr2 = dispPtr->grabWinPtr;
+ }
+ if (winPtr2 != winPtr) {
+ TkChangeEventWindow(eventPtr, winPtr2);
+ Tk_QueueWindowEvent(eventPtr, TCL_QUEUE_HEAD);
+ return 0;
+ }
+ return 1;
+ }
+
+ /*
+ * Process ButtonPress and ButtonRelease events:
+ * 1. Keep track of whether a button is down and what window it went down
+ * in.
+ * 2. If the first button goes down outside the grab tree, pretend it went
+ * down in the grab window. Note: it's important to redirect events to
+ * the grab window like this in order to make things like menus work,
+ * where button presses outside the grabbed menu need to be seen. An
+ * application can always ignore the events if they occur outside its
+ * window.
+ * 3. If a button press or release occurs outside the window where the
+ * first button was pressed, retarget the event so it's reported to the
+ * window where the first button was pressed.
+ * 4. If the last button is released in a window different than where the
+ * first button was pressed, generate Enter/Leave events to move the
+ * mouse from the button window to its current window.
+ * 5. If the grab is set at a time when a button is already down, or if
+ * the window where the button was pressed was deleted, then
+ * dispPtr->buttonWinPtr will stay NULL. Just forget about the
+ * auto-grab for the button press; events will go to whatever window
+ * contains the pointer. If this window isn't in the grab tree then
+ * redirect events to the grab window.
+ * 6. When a button is pressed during a local grab, the X server sets a
+ * grab of its own, since it doesn't even know about our local grab.
+ * This causes enter and leave events no longer to be generated in the
+ * same way as for global grabs. To eliminate this problem, set a
+ * temporary global grab when the first button goes down and release it
+ * when the last button comes up.
+ */
+
+ if ((eventPtr->type == ButtonPress) || (eventPtr->type == ButtonRelease)) {
+ winPtr2 = dispPtr->buttonWinPtr;
+ if (winPtr2 == NULL) {
+ if (outsideGrabTree) {
+ winPtr2 = dispPtr->grabWinPtr; /* Note 5. */
+ } else {
+ winPtr2 = winPtr; /* Note 5. */
+ }
+ }
+ if (eventPtr->type == ButtonPress) {
+ if (!(eventPtr->xbutton.state & ALL_BUTTONS)) {
+ if (outsideGrabTree) {
+ TkChangeEventWindow(eventPtr, dispPtr->grabWinPtr);
+ Tk_QueueWindowEvent(eventPtr, TCL_QUEUE_HEAD);
+ return 0; /* Note 2. */
+ }
+ if (!(dispPtr->grabFlags & GRAB_GLOBAL)) { /* Note 6. */
+ serial = NextRequest(dispPtr->display);
+ if (XGrabPointer(dispPtr->display,
+ dispPtr->grabWinPtr->window, True,
+ ButtonPressMask|ButtonReleaseMask|ButtonMotionMask,
+ GrabModeAsync, GrabModeAsync, None, None,
+ CurrentTime) == 0) {
+ EatGrabEvents(dispPtr, serial);
+ if (XGrabKeyboard(dispPtr->display, winPtr->window,
+ False, GrabModeAsync, GrabModeAsync,
+ CurrentTime) == 0) {
+ dispPtr->grabFlags |= GRAB_TEMP_GLOBAL;
+ } else {
+ XUngrabPointer(dispPtr->display, CurrentTime);
+ }
+ }
+ }
+ dispPtr->buttonWinPtr = winPtr;
+ return 1;
+ }
+ } else {
+ if ((eventPtr->xbutton.state & ALL_BUTTONS)
+ == buttonStates[eventPtr->xbutton.button - Button1]) {
+ ReleaseButtonGrab(dispPtr); /* Note 4. */
+ }
+ }
+ if (winPtr2 != winPtr) {
+ TkChangeEventWindow(eventPtr, winPtr2);
+ Tk_QueueWindowEvent(eventPtr, TCL_QUEUE_HEAD);
+ return 0; /* Note 3. */
+ }
+ }
+
+ return 1;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkChangeEventWindow --
+ *
+ * Given an event and a new window to which the event should be
+ * retargeted, modify fields of the event so that the event is properly
+ * retargeted to the new window.
+ *
+ * Results:
+ * The following fields of eventPtr are modified: window, subwindow, x,
+ * y, same_screen.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TkChangeEventWindow(
+ register XEvent *eventPtr, /* Event to retarget. Must have type
+ * ButtonPress, ButtonRelease, KeyPress,
+ * KeyRelease, MotionNotify, EnterNotify, or
+ * LeaveNotify. */
+ TkWindow *winPtr) /* New target window for event. */
+{
+ int x, y, sameScreen, bd;
+ register TkWindow *childPtr;
+
+ eventPtr->xmotion.window = Tk_WindowId(winPtr);
+ if (eventPtr->xmotion.root ==
+ RootWindow(winPtr->display, winPtr->screenNum)) {
+ Tk_GetRootCoords((Tk_Window) winPtr, &x, &y);
+ eventPtr->xmotion.x = eventPtr->xmotion.x_root - x;
+ eventPtr->xmotion.y = eventPtr->xmotion.y_root - y;
+ eventPtr->xmotion.subwindow = None;
+ for (childPtr = winPtr->childList; childPtr != NULL;
+ childPtr = childPtr->nextPtr) {
+ if (childPtr->flags & TK_TOP_HIERARCHY) {
+ continue;
+ }
+ x = eventPtr->xmotion.x - childPtr->changes.x;
+ y = eventPtr->xmotion.y - childPtr->changes.y;
+ bd = childPtr->changes.border_width;
+ if ((x >= -bd) && (y >= -bd)
+ && (x < (childPtr->changes.width + bd))
+ && (y < (childPtr->changes.height + bd))) {
+ eventPtr->xmotion.subwindow = childPtr->window;
+ }
+ }
+ sameScreen = 1;
+ } else {
+ eventPtr->xmotion.x = 0;
+ eventPtr->xmotion.y = 0;
+ eventPtr->xmotion.subwindow = None;
+ sameScreen = 0;
+ }
+ if (eventPtr->type == MotionNotify) {
+ eventPtr->xmotion.same_screen = sameScreen;
+ } else {
+ eventPtr->xbutton.same_screen = sameScreen;
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkInOutEvents --
+ *
+ * This function synthesizes EnterNotify and LeaveNotify events to
+ * correctly transfer the pointer from one window to another. It can also
+ * be used to generate FocusIn and FocusOut events to move the input
+ * focus.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Synthesized events may be pushed back onto the event queue. The event
+ * pointed to by eventPtr is modified.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TkInOutEvents(
+ XEvent *eventPtr, /* A template X event. Must have all fields
+ * properly set except for type, window,
+ * subwindow, x, y, detail, and same_screen.
+ * (Not all of these fields are valid for
+ * FocusIn/FocusOut events; x_root and y_root
+ * must be valid for Enter/Leave events, even
+ * though x and y needn't be valid). */
+ TkWindow *sourcePtr, /* Window that used to have the pointer or
+ * focus (NULL means it was not in a window
+ * managed by this process). */
+ TkWindow *destPtr, /* Window that is to end up with the pointer
+ * or focus (NULL means it's not one managed
+ * by this process). */
+ int leaveType, /* Type of events to generate for windows
+ * being left (LeaveNotify or FocusOut). 0
+ * means don't generate leave events. */
+ int enterType, /* Type of events to generate for windows
+ * being entered (EnterNotify or FocusIn). 0
+ * means don't generate enter events. */
+ Tcl_QueuePosition position) /* Position at which events are added to the
+ * system event queue. */
+{
+ register TkWindow *winPtr;
+ int upLevels, downLevels, i, j, focus;
+
+ /*
+ * There are four possible cases to deal with:
+ *
+ * 1. SourcePtr and destPtr are the same. There's nothing to do in this
+ * case.
+ * 2. SourcePtr is an ancestor of destPtr in the same top-level window.
+ * Must generate events down the window tree from source to dest.
+ * 3. DestPtr is an ancestor of sourcePtr in the same top-level window.
+ * Must generate events up the window tree from sourcePtr to destPtr.
+ * 4. All other cases. Must first generate events up the window tree from
+ * sourcePtr to its top-level, then down from destPtr's top-level to
+ * destPtr. This form is called "non-linear."
+ *
+ * The call to FindCommonAncestor separates these four cases and decides
+ * how many levels up and down events have to be generated for.
+ */
+
+ if (sourcePtr == destPtr) {
+ return;
+ }
+ if ((leaveType == FocusOut) || (enterType == FocusIn)) {
+ focus = 1;
+ } else {
+ focus = 0;
+ }
+ FindCommonAncestor(sourcePtr, destPtr, &upLevels, &downLevels);
+
+ /*
+ * Generate enter/leave events and add them to the grab event queue.
+ */
+
+#define QUEUE(w, t, d) \
+ if (w->window != None) { \
+ eventPtr->type = t; \
+ if (focus) { \
+ eventPtr->xfocus.window = w->window; \
+ eventPtr->xfocus.detail = d; \
+ } else { \
+ eventPtr->xcrossing.detail = d; \
+ TkChangeEventWindow(eventPtr, w); \
+ } \
+ Tk_QueueWindowEvent(eventPtr, position); \
+ }
+
+ if (downLevels == 0) {
+ /*
+ * SourcePtr is an inferior of destPtr.
+ */
+
+ if (leaveType != 0) {
+ QUEUE(sourcePtr, leaveType, NotifyAncestor);
+ for (winPtr = sourcePtr->parentPtr, i = upLevels-1; i > 0;
+ winPtr = winPtr->parentPtr, i--) {
+ QUEUE(winPtr, leaveType, NotifyVirtual);
+ }
+ }
+ if ((enterType != 0) && (destPtr != NULL)) {
+ QUEUE(destPtr, enterType, NotifyInferior);
+ }
+ } else if (upLevels == 0) {
+ /*
+ * DestPtr is an inferior of sourcePtr.
+ */
+
+ if ((leaveType != 0) && (sourcePtr != NULL)) {
+ QUEUE(sourcePtr, leaveType, NotifyInferior);
+ }
+ if (enterType != 0) {
+ for (i = downLevels-1; i > 0; i--) {
+ for (winPtr = destPtr->parentPtr, j = 1; j < i;
+ winPtr = winPtr->parentPtr, j++) {
+ /* empty */
+ }
+ QUEUE(winPtr, enterType, NotifyVirtual);
+ }
+ if (destPtr != NULL) {
+ QUEUE(destPtr, enterType, NotifyAncestor);
+ }
+ }
+ } else {
+ /*
+ * Non-linear: neither window is an inferior of the other.
+ */
+
+ if (leaveType != 0) {
+ QUEUE(sourcePtr, leaveType, NotifyNonlinear);
+ for (winPtr = sourcePtr->parentPtr, i = upLevels-1; i > 0;
+ winPtr = winPtr->parentPtr, i--) {
+ QUEUE(winPtr, leaveType, NotifyNonlinearVirtual);
+ }
+ }
+ if (enterType != 0) {
+ for (i = downLevels-1; i > 0; i--) {
+ for (winPtr = destPtr->parentPtr, j = 1; j < i;
+ winPtr = winPtr->parentPtr, j++) {
+ }
+ QUEUE(winPtr, enterType, NotifyNonlinearVirtual);
+ }
+ if (destPtr != NULL) {
+ QUEUE(destPtr, enterType, NotifyNonlinear);
+ }
+ }
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * MovePointer2 --
+ *
+ * This function synthesizes EnterNotify and LeaveNotify events to
+ * correctly transfer the pointer from one window to another. It is
+ * different from TkInOutEvents in that no template X event needs to be
+ * supplied; this function generates the template event and calls
+ * TkInOutEvents.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Synthesized events may be pushed back onto the event queue.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+MovePointer2(
+ TkWindow *sourcePtr, /* Window currently containing pointer (NULL
+ * means it's not one managed by this
+ * process). */
+ TkWindow *destPtr, /* Window that is to end up containing the
+ * pointer (NULL means it's not one managed by
+ * this process). */
+ int mode, /* Mode for enter/leave events, such as
+ * NotifyNormal or NotifyUngrab. */
+ int leaveEvents, /* Non-zero means generate leave events for
+ * the windows being left. Zero means don't
+ * generate leave events. */
+ int enterEvents) /* Non-zero means generate enter events for
+ * the windows being entered. Zero means don't
+ * generate enter events. */
+{
+ XEvent event;
+ Window dummy1, dummy2;
+ int dummy3, dummy4;
+ TkWindow *winPtr;
+
+ winPtr = sourcePtr;
+ if ((winPtr == NULL) || (winPtr->window == None)) {
+ winPtr = destPtr;
+ if ((winPtr == NULL) || (winPtr->window == None)) {
+ return;
+ }
+ }
+
+ event.xcrossing.serial = LastKnownRequestProcessed(winPtr->display);
+ event.xcrossing.send_event = GENERATED_GRAB_EVENT_MAGIC;
+ event.xcrossing.display = winPtr->display;
+ event.xcrossing.root = RootWindow(winPtr->display, winPtr->screenNum);
+ event.xcrossing.time = TkCurrentTime(winPtr->dispPtr);
+ XQueryPointer(winPtr->display, winPtr->window, &dummy1, &dummy2,
+ &event.xcrossing.x_root, &event.xcrossing.y_root,
+ &dummy3, &dummy4, &event.xcrossing.state);
+ event.xcrossing.mode = mode;
+ event.xcrossing.focus = False;
+ TkInOutEvents(&event, sourcePtr, destPtr, (leaveEvents) ? LeaveNotify : 0,
+ (enterEvents) ? EnterNotify : 0, TCL_QUEUE_MARK);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkGrabDeadWindow --
+ *
+ * This function is invoked whenever a window is deleted, so that
+ * grab-related cleanup can be performed.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Various cleanups happen, such as generating events to move the pointer
+ * back to its "natural" window as if an ungrab had been done. See the
+ * code.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TkGrabDeadWindow(
+ register TkWindow *winPtr) /* Window that is in the process of being
+ * deleted. */
+{
+ TkDisplay *dispPtr = winPtr->dispPtr;
+
+ if (dispPtr->eventualGrabWinPtr == winPtr) {
+ /*
+ * Grab window was deleted. Release the grab.
+ */
+
+ Tk_Ungrab((Tk_Window) dispPtr->eventualGrabWinPtr);
+ } else if (dispPtr->buttonWinPtr == winPtr) {
+ ReleaseButtonGrab(dispPtr);
+ }
+ if (dispPtr->serverWinPtr == winPtr) {
+ if (winPtr->flags & TK_TOP_HIERARCHY) {
+ dispPtr->serverWinPtr = NULL;
+ } else {
+ dispPtr->serverWinPtr = winPtr->parentPtr;
+ }
+ }
+ if (dispPtr->grabWinPtr == winPtr) {
+ dispPtr->grabWinPtr = NULL;
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * EatGrabEvents --
+ *
+ * This function is called to eliminate any Enter, Leave, FocusIn, or
+ * FocusOut events in the event queue for a display that have mode
+ * NotifyGrab or NotifyUngrab and have a serial number no less than a
+ * given value and are not generated by the grab module.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * DispPtr's display gets sync-ed, and some of the events get removed
+ * from the Tk event queue.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+EatGrabEvents(
+ TkDisplay *dispPtr, /* Display from which to consume events. */
+ unsigned int serial) /* Only discard events that have a serial
+ * number at least this great. */
+{
+ Tk_RestrictProc *prevProc;
+ GrabInfo info;
+ ClientData prevArg;
+
+ info.display = dispPtr->display;
+ info.serial = serial;
+ TkpSync(info.display);
+ prevProc = Tk_RestrictEvents(GrabRestrictProc, &info, &prevArg);
+ while (Tcl_ServiceEvent(TCL_WINDOW_EVENTS)) {
+ /* EMPTY */
+ }
+ Tk_RestrictEvents(prevProc, prevArg, &prevArg);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * GrabRestrictProc --
+ *
+ * A Tk_RestrictProc used by EatGrabEvents to eliminate any Enter, Leave,
+ * FocusIn, or FocusOut events in the event queue for a display that has
+ * mode NotifyGrab or NotifyUngrab and have a serial number no less than
+ * a given value.
+ *
+ * Results:
+ * Returns either TK_DISCARD_EVENT or TK_DEFER_EVENT.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static Tk_RestrictAction
+GrabRestrictProc(
+ ClientData arg,
+ XEvent *eventPtr)
+{
+ GrabInfo *info = arg;
+ int mode, diff;
+
+ /*
+ * The diff caculation is trickier than it may seem. Don't forget that
+ * serial numbers can wrap around, so can't compare the two serial numbers
+ * directly.
+ */
+
+ diff = eventPtr->xany.serial - info->serial;
+ if ((eventPtr->type == EnterNotify)
+ || (eventPtr->type == LeaveNotify)) {
+ mode = eventPtr->xcrossing.mode;
+ } else if ((eventPtr->type == FocusIn)
+ || (eventPtr->type == FocusOut)) {
+ mode = eventPtr->xfocus.mode;
+ } else {
+ mode = NotifyNormal;
+ }
+ if ((info->display != eventPtr->xany.display) || (mode == NotifyNormal)
+ || (diff < 0)) {
+ return TK_DEFER_EVENT;
+ } else {
+ return TK_DISCARD_EVENT;
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * QueueGrabWindowChange --
+ *
+ * This function queues a special event in the Tcl event queue, which
+ * will cause the "grabWinPtr" field for the display to get modified when
+ * the event is processed. This is needed to make sure that the grab
+ * window changes at the proper time relative to grab-related enter and
+ * leave events that are also in the queue. In particular, this approach
+ * works even when multiple grabs and ungrabs happen back-to-back.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * DispPtr->grabWinPtr will be modified later (by GrabWinEventProc) when
+ * the event is removed from the grab event queue.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+QueueGrabWindowChange(
+ TkDisplay *dispPtr, /* Display on which to change the grab
+ * window. */
+ TkWindow *grabWinPtr) /* Window that is to become the new grab
+ * window (may be NULL). */
+{
+ NewGrabWinEvent *grabEvPtr;
+
+ grabEvPtr = ckalloc(sizeof(NewGrabWinEvent));
+ grabEvPtr->header.proc = GrabWinEventProc;
+ grabEvPtr->dispPtr = dispPtr;
+ if (grabWinPtr == NULL) {
+ grabEvPtr->grabWindow = None;
+ } else {
+ grabEvPtr->grabWindow = grabWinPtr->window;
+ }
+ Tcl_QueueEvent(&grabEvPtr->header, TCL_QUEUE_MARK);
+ dispPtr->eventualGrabWinPtr = grabWinPtr;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * GrabWinEventProc --
+ *
+ * This function is invoked as a handler for Tcl_Events of type
+ * NewGrabWinEvent. It updates the current grab window field in a
+ * display.
+ *
+ * Results:
+ * Returns 1 if the event was processed, 0 if it should be deferred for
+ * processing later.
+ *
+ * Side effects:
+ * The grabWinPtr field is modified in the display associated with the
+ * event.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+GrabWinEventProc(
+ Tcl_Event *evPtr, /* Event of type NewGrabWinEvent. */
+ int flags) /* Flags argument to Tk_DoOneEvent: indicates
+ * what kinds of events are being processed
+ * right now. */
+{
+ NewGrabWinEvent *grabEvPtr = (NewGrabWinEvent *) evPtr;
+
+ grabEvPtr->dispPtr->grabWinPtr = (TkWindow *) Tk_IdToWindow(
+ grabEvPtr->dispPtr->display, grabEvPtr->grabWindow);
+ return 1;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * FindCommonAncestor --
+ *
+ * Given two windows, this function finds their least common ancestor and
+ * also computes how many levels up this ancestor is from each of the
+ * original windows.
+ *
+ * Results:
+ * If the windows are in different applications or top-level windows,
+ * then NULL is returned and *countPtr1 and *countPtr2 are set to the
+ * depths of the two windows in their respective top-level windows (1
+ * means the window is a top-level, 2 means its parent is a top-level,
+ * and so on). Otherwise, the return value is a pointer to the common
+ * ancestor and the counts are set to the distance of winPtr1 and winPtr2
+ * from this ancestor (1 means they're children, 2 means grand-children,
+ * etc.).
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static TkWindow *
+FindCommonAncestor(
+ TkWindow *winPtr1, /* First window. May be NULL. */
+ TkWindow *winPtr2, /* Second window. May be NULL. */
+ int *countPtr1, /* Store nesting level of winPtr1 within
+ * common ancestor here. */
+ int *countPtr2) /* Store nesting level of winPtr2 within
+ * common ancestor here. */
+{
+ register TkWindow *winPtr;
+ TkWindow *ancestorPtr;
+ int count1, count2, i;
+
+ /*
+ * Mark winPtr1 and all of its ancestors with a special flag bit.
+ */
+
+ if (winPtr1 != NULL) {
+ for (winPtr = winPtr1; winPtr != NULL; winPtr = winPtr->parentPtr) {
+ winPtr->flags |= TK_GRAB_FLAG;
+ if (winPtr->flags & TK_TOP_HIERARCHY) {
+ break;
+ }
+ }
+ }
+
+ /*
+ * Search upwards from winPtr2 until an ancestor of winPtr1 is found or a
+ * top-level window is reached.
+ */
+
+ winPtr = winPtr2;
+ count2 = 0;
+ ancestorPtr = NULL;
+ if (winPtr2 != NULL) {
+ for (; winPtr != NULL; count2++, winPtr = winPtr->parentPtr) {
+ if (winPtr->flags & TK_GRAB_FLAG) {
+ ancestorPtr = winPtr;
+ break;
+ }
+ if (winPtr->flags & TK_TOP_HIERARCHY) {
+ count2++;
+ break;
+ }
+ }
+ }
+
+ /*
+ * Search upwards from winPtr1 again, clearing the flag bits and
+ * remembering how many levels up we had to go.
+ */
+
+ if (winPtr1 == NULL) {
+ count1 = 0;
+ } else {
+ count1 = -1;
+ for (i = 0, winPtr = winPtr1; winPtr != NULL;
+ i++, winPtr = winPtr->parentPtr) {
+ winPtr->flags &= ~TK_GRAB_FLAG;
+ if (winPtr == ancestorPtr) {
+ count1 = i;
+ }
+ if (winPtr->flags & TK_TOP_HIERARCHY) {
+ if (count1 == -1) {
+ count1 = i+1;
+ }
+ break;
+ }
+ }
+ }
+
+ *countPtr1 = count1;
+ *countPtr2 = count2;
+ return ancestorPtr;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkPositionInTree --
+ *
+ * Compute where the given window is relative to a particular subtree of
+ * the window hierarchy.
+ *
+ * Results:
+ * Returns TK_GRAB_IN_TREE if the window is contained in the subtree.
+ * Returns TK_GRAB_ANCESTOR if the window is an ancestor of the subtree,
+ * in the same toplevel. Otherwise it returns TK_GRAB_EXCLUDED.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TkPositionInTree(
+ TkWindow *winPtr, /* Window to be checked. */
+ TkWindow *treePtr) /* Root of tree to compare against. */
+{
+ TkWindow *winPtr2;
+
+ for (winPtr2 = winPtr; winPtr2 != treePtr;
+ winPtr2 = winPtr2->parentPtr) {
+ if (winPtr2 == NULL) {
+ for (winPtr2 = treePtr; winPtr2 != NULL;
+ winPtr2 = winPtr2->parentPtr) {
+ if (winPtr2 == winPtr) {
+ return TK_GRAB_ANCESTOR;
+ }
+ if (winPtr2->flags & TK_TOP_HIERARCHY) {
+ break;
+ }
+ }
+ return TK_GRAB_EXCLUDED;
+ }
+ }
+ return TK_GRAB_IN_TREE;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkGrabState --
+ *
+ * Given a window, this function returns a value that indicates the grab
+ * state of the application relative to the window.
+ *
+ * Results:
+ * The return value is one of three things:
+ * TK_GRAB_NONE - no grab is in effect.
+ * TK_GRAB_IN_TREE - there is a grab in effect, and winPtr is in
+ * the grabbed subtree.
+ * TK_GRAB_ANCESTOR - there is a grab in effect; winPtr is an
+ * ancestor of the grabbed window, in the same
+ * toplevel.
+ * TK_GRAB_EXCLUDED - there is a grab in effect; winPtr is outside
+ * the tree of the grab and is not an ancestor of
+ * the grabbed window in the same toplevel.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TkGrabState(
+ TkWindow *winPtr) /* Window for which grab information is
+ * needed. */
+{
+ TkWindow *grabWinPtr = winPtr->dispPtr->grabWinPtr;
+
+ if (grabWinPtr == NULL) {
+ return TK_GRAB_NONE;
+ }
+ if ((winPtr->mainPtr != grabWinPtr->mainPtr)
+ && !(winPtr->dispPtr->grabFlags & GRAB_GLOBAL)) {
+ return TK_GRAB_NONE;
+ }
+
+ return TkPositionInTree(winPtr, grabWinPtr);
+}
+
+/*
+ * Local Variables:
+ * mode: c
+ * c-basic-offset: 4
+ * fill-column: 78
+ * End:
+ */
diff --git a/tk8.6/generic/tkGrid.c b/tk8.6/generic/tkGrid.c
new file mode 100644
index 0000000..2a88b76
--- /dev/null
+++ b/tk8.6/generic/tkGrid.c
@@ -0,0 +1,3666 @@
+/*
+ * tkGrid.c --
+ *
+ * Grid based geometry manager.
+ *
+ * Copyright (c) 1996-1997 by Sun Microsystems, Inc.
+ *
+ * See the file "license.terms" for information on usage and redistribution of
+ * this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ */
+
+#include "tkInt.h"
+
+/*
+ * Convenience Macros
+ */
+
+#ifdef MAX
+# undef MAX
+#endif
+#define MAX(x,y) ((x) > (y) ? (x) : (y))
+
+#define COLUMN (1) /* Working on column offsets. */
+#define ROW (2) /* Working on row offsets. */
+
+#define CHECK_ONLY (1) /* Check max slot constraint. */
+#define CHECK_SPACE (2) /* Alloc more space, don't change max. */
+
+/*
+ * Pre-allocate enough row and column slots for "typical" sized tables this
+ * value should be chosen so by the time the extra malloc's are required, the
+ * layout calculations overwehlm them. [A "slot" contains information for
+ * either a row or column, depending upon the context.]
+ */
+
+#define TYPICAL_SIZE 25 /* (Arbitrary guess) */
+#define PREALLOC 10 /* Extra slots to allocate. */
+
+/*
+ * Pre-allocate room for uniform groups during layout.
+ */
+
+#define UNIFORM_PREALLOC 10
+
+/*
+ * Data structures are allocated dynamically to support arbitrary sized
+ * tables. However, the space is proportional to the highest numbered slot
+ * with some non-default property. This limit is used to head off mistakes and
+ * denial of service attacks by limiting the amount of storage required.
+ */
+
+#define MAX_ELEMENT 10000
+
+/*
+ * Special characters to support relative layouts.
+ */
+
+#define REL_SKIP 'x' /* Skip this column. */
+#define REL_HORIZ '-' /* Extend previous widget horizontally. */
+#define REL_VERT '^' /* Extend widget from row above. */
+
+/*
+ * Default value for 'grid anchor'.
+ */
+
+#define GRID_DEFAULT_ANCHOR TK_ANCHOR_NW
+
+/*
+ * Structure to hold information for grid masters. A slot is either a row or
+ * column.
+ */
+
+typedef struct SlotInfo {
+ int minSize; /* The minimum size of this slot (in pixels).
+ * It is set via the rowconfigure or
+ * columnconfigure commands. */
+ int weight; /* The resize weight of this slot. (0) means
+ * this slot doesn't resize. Extra space in
+ * the layout is given distributed among slots
+ * inproportion to their weights. */
+ int pad; /* Extra padding, in pixels, required for this
+ * slot. This amount is "added" to the largest
+ * slave in the slot. */
+ Tk_Uid uniform; /* Value of -uniform option. It is used to
+ * group slots that should have the same
+ * size. */
+ int offset; /* This is a cached value used for
+ * introspection. It is the pixel offset of
+ * the right or bottom edge of this slot from
+ * the beginning of the layout. */
+ int temp; /* This is a temporary value used for
+ * calculating adjusted weights when shrinking
+ * the layout below its nominal size. */
+} SlotInfo;
+
+/*
+ * Structure to hold information during layout calculations. There is one of
+ * these for each slot, an array for each of the rows or columns.
+ */
+
+typedef struct GridLayout {
+ struct Gridder *binNextPtr; /* The next slave window in this bin. Each bin
+ * contains a list of all slaves whose spans
+ * are >1 and whose right edges fall in this
+ * slot. */
+ int minSize; /* Minimum size needed for this slot, in
+ * pixels. This is the space required to hold
+ * any slaves contained entirely in this slot,
+ * adjusted for any slot constrants, such as
+ * size or padding. */
+ int pad; /* Padding needed for this slot */
+ int weight; /* Slot weight, controls resizing. */
+ Tk_Uid uniform; /* Value of -uniform option. It is used to
+ * group slots that should have the same
+ * size. */
+ int minOffset; /* The minimum offset, in pixels, from the
+ * beginning of the layout to the bottom/right
+ * edge of the slot calculated from top/left
+ * to bottom/right. */
+ int maxOffset; /* The maximum offset, in pixels, from the
+ * beginning of the layout to the bottom/right
+ * edge of the slot calculated from
+ * bottom/right to top/left. */
+} GridLayout;
+
+/*
+ * Keep one of these for each geometry master.
+ */
+
+typedef struct {
+ SlotInfo *columnPtr; /* Pointer to array of column constraints. */
+ SlotInfo *rowPtr; /* Pointer to array of row constraints. */
+ int columnEnd; /* The last column occupied by any slave. */
+ int columnMax; /* The number of columns with constraints. */
+ int columnSpace; /* The number of slots currently allocated for
+ * column constraints. */
+ int rowEnd; /* The last row occupied by any slave. */
+ int rowMax; /* The number of rows with constraints. */
+ int rowSpace; /* The number of slots currently allocated for
+ * row constraints. */
+ int startX; /* Pixel offset of this layout within its
+ * master. */
+ int startY; /* Pixel offset of this layout within its
+ * master. */
+ Tk_Anchor anchor; /* Value of anchor option: specifies where a
+ * grid without weight should be placed. */
+} GridMaster;
+
+/*
+ * For each window that the grid cares about (either because the window is
+ * managed by the grid or because the window has slaves that are managed by
+ * the grid), there is a structure of the following type:
+ */
+
+typedef struct Gridder {
+ Tk_Window tkwin; /* Tk token for window. NULL means that the
+ * window has been deleted, but the gridder
+ * hasn't had a chance to clean up yet because
+ * the structure is still in use. */
+ struct Gridder *masterPtr; /* Master window within which this window is
+ * managed (NULL means this window isn't
+ * managed by the gridder). */
+ struct Gridder *nextPtr; /* Next window managed within same master.
+ * List order doesn't matter. */
+ struct Gridder *slavePtr; /* First in list of slaves managed inside this
+ * window (NULL means no grid slaves). */
+ GridMaster *masterDataPtr; /* Additional data for geometry master. */
+ Tcl_Obj *in; /* Store master name when removed. */
+ int column, row; /* Location in the grid (starting from
+ * zero). */
+ int numCols, numRows; /* Number of columns or rows this slave spans.
+ * Should be at least 1. */
+ int padX, padY; /* Total additional pixels to leave around the
+ * window. Some is of this space is on each
+ * side. This is space *outside* the window:
+ * we'll allocate extra space in frame but
+ * won't enlarge window). */
+ int padLeft, padTop; /* The part of padX or padY to use on the left
+ * or top of the widget, respectively. By
+ * default, this is half of padX or padY. */
+ int iPadX, iPadY; /* Total extra pixels to allocate inside the
+ * window (half this amount will appear on
+ * each side). */
+ int sticky; /* which sides of its cavity this window
+ * sticks to. See below for definitions */
+ int doubleBw; /* Twice the window's last known border width.
+ * If this changes, the window must be
+ * re-arranged within its master. */
+ int *abortPtr; /* If non-NULL, it means that there is a
+ * nested call to ArrangeGrid already working
+ * on this window. *abortPtr may be set to 1
+ * to abort that nested call. This happens,
+ * for example, if tkwin or any of its slaves
+ * is deleted. */
+ int flags; /* Miscellaneous flags; see below for
+ * definitions. */
+
+ /*
+ * These fields are used temporarily for layout calculations only.
+ */
+
+ struct Gridder *binNextPtr; /* Link to next span>1 slave in this bin. */
+ int size; /* Nominal size (width or height) in pixels of
+ * the slave. This includes the padding. */
+} Gridder;
+
+/*
+ * Flag values for "sticky"ness. The 16 combinations subsume the packer's
+ * notion of anchor and fill.
+ *
+ * STICK_NORTH This window sticks to the top of its cavity.
+ * STICK_EAST This window sticks to the right edge of its
+ * cavity.
+ * STICK_SOUTH This window sticks to the bottom of its cavity.
+ * STICK_WEST This window sticks to the left edge of its
+ * cavity.
+ */
+
+#define STICK_NORTH 1
+#define STICK_EAST 2
+#define STICK_SOUTH 4
+#define STICK_WEST 8
+
+
+/*
+ * Structure to gather information about uniform groups during layout.
+ */
+
+typedef struct UniformGroup {
+ Tk_Uid group;
+ int minSize;
+} UniformGroup;
+
+/*
+ * Flag values for Grid structures:
+ *
+ * REQUESTED_RELAYOUT 1 means a Tcl_DoWhenIdle request has already
+ * been made to re-arrange all the slaves of this
+ * window.
+ * DONT_PROPAGATE 1 means don't set this window's requested
+ * size. 0 means if this window is a master then
+ * Tk will set its requested size to fit the
+ * needs of its slaves.
+ * ALLOCED_MASTER 1 means that Grid has allocated itself as
+ * geometry master for this window.
+ */
+
+#define REQUESTED_RELAYOUT 1
+#define DONT_PROPAGATE 2
+#define ALLOCED_MASTER 4
+
+/*
+ * Prototypes for procedures used only in this file:
+ */
+
+static void AdjustForSticky(Gridder *slavePtr, int *xPtr,
+ int *yPtr, int *widthPtr, int *heightPtr);
+static int AdjustOffsets(int width, int elements,
+ SlotInfo *slotPtr);
+static void ArrangeGrid(ClientData clientData);
+static int CheckSlotData(Gridder *masterPtr, int slot,
+ int slotType, int checkOnly);
+static int ConfigureSlaves(Tcl_Interp *interp, Tk_Window tkwin,
+ int objc, Tcl_Obj *const objv[]);
+static void DestroyGrid(void *memPtr);
+static Gridder * GetGrid(Tk_Window tkwin);
+static int GridAnchorCommand(Tk_Window tkwin, Tcl_Interp *interp,
+ int objc, Tcl_Obj *const objv[]);
+static int GridBboxCommand(Tk_Window tkwin, Tcl_Interp *interp,
+ int objc, Tcl_Obj *const objv[]);
+static int GridForgetRemoveCommand(Tk_Window tkwin,
+ Tcl_Interp *interp, int objc,
+ Tcl_Obj *const objv[]);
+static int GridInfoCommand(Tk_Window tkwin, Tcl_Interp *interp,
+ int objc, Tcl_Obj *const objv[]);
+static int GridLocationCommand(Tk_Window tkwin,
+ Tcl_Interp *interp, int objc,
+ Tcl_Obj *const objv[]);
+static int GridPropagateCommand(Tk_Window tkwin,
+ Tcl_Interp *interp, int objc,
+ Tcl_Obj *const objv[]);
+static int GridRowColumnConfigureCommand(Tk_Window tkwin,
+ Tcl_Interp *interp, int objc,
+ Tcl_Obj *const objv[]);
+static int GridSizeCommand(Tk_Window tkwin, Tcl_Interp *interp,
+ int objc, Tcl_Obj *const objv[]);
+static int GridSlavesCommand(Tk_Window tkwin, Tcl_Interp *interp,
+ int objc, Tcl_Obj *const objv[]);
+static void GridStructureProc(ClientData clientData,
+ XEvent *eventPtr);
+static void GridLostSlaveProc(ClientData clientData,
+ Tk_Window tkwin);
+static void GridReqProc(ClientData clientData, Tk_Window tkwin);
+static void InitMasterData(Gridder *masterPtr);
+static Tcl_Obj * NewPairObj(int, int);
+static Tcl_Obj * NewQuadObj(int, int, int, int);
+static int ResolveConstraints(Gridder *gridPtr, int rowOrColumn,
+ int maxOffset);
+static void SetGridSize(Gridder *gridPtr);
+static int SetSlaveColumn(Tcl_Interp *interp, Gridder *slavePtr,
+ int column, int numCols);
+static int SetSlaveRow(Tcl_Interp *interp, Gridder *slavePtr,
+ int row, int numRows);
+static Tcl_Obj * StickyToObj(int flags);
+static int StringToSticky(const char *string);
+static void Unlink(Gridder *gridPtr);
+
+static const Tk_GeomMgr gridMgrType = {
+ "grid", /* name */
+ GridReqProc, /* requestProc */
+ GridLostSlaveProc, /* lostSlaveProc */
+};
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_GridCmd --
+ *
+ * This procedure is invoked to process the "grid" Tcl command. See the
+ * user documentation for details on what it does.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * See the user documentation.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tk_GridObjCmd(
+ ClientData 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 = clientData;
+ static const char *const optionStrings[] = {
+ "anchor", "bbox", "columnconfigure", "configure",
+ "forget", "info", "location", "propagate", "remove",
+ "rowconfigure", "size", "slaves", NULL
+ };
+ enum options {
+ GRID_ANCHOR, GRID_BBOX, GRID_COLUMNCONFIGURE, GRID_CONFIGURE,
+ GRID_FORGET, GRID_INFO, GRID_LOCATION, GRID_PROPAGATE, GRID_REMOVE,
+ GRID_ROWCONFIGURE, GRID_SIZE, GRID_SLAVES
+ };
+ int index;
+
+ if (objc >= 2) {
+ const char *argv1 = Tcl_GetString(objv[1]);
+
+ if ((argv1[0] == '.') || (argv1[0] == REL_SKIP) ||
+ (argv1[0] == REL_VERT)) {
+ return ConfigureSlaves(interp, tkwin, objc-1, objv+1);
+ }
+ }
+ if (objc < 3) {
+ Tcl_WrongNumArgs(interp, 1, objv, "option arg ?arg ...?");
+ return TCL_ERROR;
+ }
+
+ if (Tcl_GetIndexFromObjStruct(interp, objv[1], optionStrings,
+ sizeof(char *), "option", 0, &index) != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ switch ((enum options) index) {
+ case GRID_ANCHOR:
+ return GridAnchorCommand(tkwin, interp, objc, objv);
+ case GRID_BBOX:
+ return GridBboxCommand(tkwin, interp, objc, objv);
+ case GRID_CONFIGURE:
+ return ConfigureSlaves(interp, tkwin, objc-2, objv+2);
+ case GRID_FORGET:
+ case GRID_REMOVE:
+ return GridForgetRemoveCommand(tkwin, interp, objc, objv);
+ case GRID_INFO:
+ return GridInfoCommand(tkwin, interp, objc, objv);
+ case GRID_LOCATION:
+ return GridLocationCommand(tkwin, interp, objc, objv);
+ case GRID_PROPAGATE:
+ return GridPropagateCommand(tkwin, interp, objc, objv);
+ case GRID_SIZE:
+ return GridSizeCommand(tkwin, interp, objc, objv);
+ case GRID_SLAVES:
+ return GridSlavesCommand(tkwin, interp, objc, objv);
+
+ /*
+ * Sample argument combinations:
+ * grid columnconfigure <master> <index> -option
+ * grid columnconfigure <master> <index> -option value -option value
+ * grid rowconfigure <master> <index>
+ * grid rowconfigure <master> <index> -option
+ * grid rowconfigure <master> <index> -option value -option value.
+ */
+
+ case GRID_COLUMNCONFIGURE:
+ case GRID_ROWCONFIGURE:
+ return GridRowColumnConfigureCommand(tkwin, interp, objc, objv);
+ }
+
+ /* This should not happen */
+ Tcl_SetObjResult(interp, Tcl_NewStringObj("internal error in grid", -1));
+ Tcl_SetErrorCode(interp, "TK", "API_ABUSE", NULL);
+ return TCL_ERROR;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * GridAnchorCommand --
+ *
+ * Implementation of the [grid anchor] subcommand. See the user
+ * documentation for details on what it does.
+ *
+ * Results:
+ * Standard Tcl result.
+ *
+ * Side effects:
+ * May recompute grid geometry.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+GridAnchorCommand(
+ Tk_Window tkwin, /* Main window of the application. */
+ Tcl_Interp *interp, /* Current interpreter. */
+ int objc, /* Number of arguments. */
+ Tcl_Obj *const objv[]) /* Argument objects. */
+{
+ Tk_Window master;
+ Gridder *masterPtr;
+ GridMaster *gridPtr;
+ Tk_Anchor old;
+
+ if (objc > 4) {
+ Tcl_WrongNumArgs(interp, 2, objv, "window ?anchor?");
+ return TCL_ERROR;
+ }
+
+ if (TkGetWindowFromObj(interp, tkwin, objv[2], &master) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ masterPtr = GetGrid(master);
+
+ if (objc == 3) {
+ gridPtr = masterPtr->masterDataPtr;
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ Tk_NameOfAnchor(gridPtr?gridPtr->anchor:GRID_DEFAULT_ANCHOR),
+ -1));
+ return TCL_OK;
+ }
+
+ InitMasterData(masterPtr);
+ gridPtr = masterPtr->masterDataPtr;
+ old = gridPtr->anchor;
+ if (Tk_GetAnchorFromObj(interp, objv[3], &gridPtr->anchor) != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ /*
+ * Only request a relayout if the anchor changes.
+ */
+
+ if (old != gridPtr->anchor) {
+ if (masterPtr->abortPtr != NULL) {
+ *masterPtr->abortPtr = 1;
+ }
+ if (!(masterPtr->flags & REQUESTED_RELAYOUT)) {
+ masterPtr->flags |= REQUESTED_RELAYOUT;
+ Tcl_DoWhenIdle(ArrangeGrid, masterPtr);
+ }
+ }
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * GridBboxCommand --
+ *
+ * Implementation of the [grid bbox] subcommand.
+ *
+ * Results:
+ * Standard Tcl result.
+ *
+ * Side effects:
+ * Places bounding box information in the interp's result field.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+GridBboxCommand(
+ Tk_Window tkwin, /* Main window of the application. */
+ Tcl_Interp *interp, /* Current interpreter. */
+ int objc, /* Number of arguments. */
+ Tcl_Obj *const objv[]) /* Argument objects. */
+{
+ Tk_Window master;
+ Gridder *masterPtr; /* master grid record */
+ GridMaster *gridPtr; /* pointer to grid data */
+ int row, column; /* origin for bounding box */
+ int row2, column2; /* end of bounding box */
+ int endX, endY; /* last column/row in the layout */
+ int x=0, y=0; /* starting pixels for this bounding box */
+ int width, height; /* size of the bounding box */
+
+ if (objc!=3 && objc != 5 && objc != 7) {
+ Tcl_WrongNumArgs(interp, 2, objv, "master ?column row ?column row??");
+ return TCL_ERROR;
+ }
+
+ if (TkGetWindowFromObj(interp, tkwin, objv[2], &master) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ masterPtr = GetGrid(master);
+
+ if (objc >= 5) {
+ if (Tcl_GetIntFromObj(interp, objv[3], &column) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (Tcl_GetIntFromObj(interp, objv[4], &row) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ column2 = column;
+ row2 = row;
+ }
+
+ if (objc == 7) {
+ if (Tcl_GetIntFromObj(interp, objv[5], &column2) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (Tcl_GetIntFromObj(interp, objv[6], &row2) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ }
+
+ gridPtr = masterPtr->masterDataPtr;
+ if (gridPtr == NULL) {
+ Tcl_SetObjResult(interp, NewQuadObj(0, 0, 0, 0));
+ return TCL_OK;
+ }
+
+ SetGridSize(masterPtr);
+ endX = MAX(gridPtr->columnEnd, gridPtr->columnMax);
+ endY = MAX(gridPtr->rowEnd, gridPtr->rowMax);
+
+ if ((endX == 0) || (endY == 0)) {
+ Tcl_SetObjResult(interp, NewQuadObj(0, 0, 0, 0));
+ return TCL_OK;
+ }
+ if (objc == 3) {
+ row = 0;
+ column = 0;
+ row2 = endY;
+ column2 = endX;
+ }
+
+ if (column > column2) {
+ int temp = column;
+
+ column = column2;
+ column2 = temp;
+ }
+ if (row > row2) {
+ int temp = row;
+
+ row = row2;
+ row2 = temp;
+ }
+
+ if (column > 0 && column < endX) {
+ x = gridPtr->columnPtr[column-1].offset;
+ } else if (column > 0) {
+ x = gridPtr->columnPtr[endX-1].offset;
+ }
+
+ if (row > 0 && row < endY) {
+ y = gridPtr->rowPtr[row-1].offset;
+ } else if (row > 0) {
+ y = gridPtr->rowPtr[endY-1].offset;
+ }
+
+ if (column2 < 0) {
+ width = 0;
+ } else if (column2 >= endX) {
+ width = gridPtr->columnPtr[endX-1].offset - x;
+ } else {
+ width = gridPtr->columnPtr[column2].offset - x;
+ }
+
+ if (row2 < 0) {
+ height = 0;
+ } else if (row2 >= endY) {
+ height = gridPtr->rowPtr[endY-1].offset - y;
+ } else {
+ height = gridPtr->rowPtr[row2].offset - y;
+ }
+
+ Tcl_SetObjResult(interp, NewQuadObj(
+ x + gridPtr->startX, y + gridPtr->startY, width, height));
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * GridForgetRemoveCommand --
+ *
+ * Implementation of the [grid forget]/[grid remove] subcommands. See the
+ * user documentation for details on what these do.
+ *
+ * Results:
+ * Standard Tcl result.
+ *
+ * Side effects:
+ * Removes a window from a grid layout.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+GridForgetRemoveCommand(
+ Tk_Window tkwin, /* Main window of the application. */
+ Tcl_Interp *interp, /* Current interpreter. */
+ int objc, /* Number of arguments. */
+ Tcl_Obj *const objv[]) /* Argument objects. */
+{
+ Tk_Window slave;
+ Gridder *slavePtr;
+ int i;
+ const char *string = Tcl_GetString(objv[1]);
+ char c = string[0];
+
+ for (i = 2; i < objc; i++) {
+ if (TkGetWindowFromObj(interp, tkwin, objv[i], &slave) != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ slavePtr = GetGrid(slave);
+ if (slavePtr->masterPtr != NULL) {
+ /*
+ * For "forget", reset all the settings to their defaults
+ */
+
+ if (c == 'f') {
+ slavePtr->column = -1;
+ slavePtr->row = -1;
+ slavePtr->numCols = 1;
+ slavePtr->numRows = 1;
+ slavePtr->padX = 0;
+ slavePtr->padY = 0;
+ slavePtr->padLeft = 0;
+ slavePtr->padTop = 0;
+ slavePtr->iPadX = 0;
+ slavePtr->iPadY = 0;
+ if (slavePtr->in != NULL) {
+ Tcl_DecrRefCount(slavePtr->in);
+ slavePtr->in = NULL;
+ }
+ slavePtr->doubleBw = 2*Tk_Changes(tkwin)->border_width;
+ if (slavePtr->flags & REQUESTED_RELAYOUT) {
+ Tcl_CancelIdleCall(ArrangeGrid, slavePtr);
+ }
+ slavePtr->flags = 0;
+ slavePtr->sticky = 0;
+ } else {
+ /*
+ * When removing, store name of master to be able to
+ * restore it later, even if the master is recreated.
+ */
+
+ if (slavePtr->in != NULL) {
+ Tcl_DecrRefCount(slavePtr->in);
+ slavePtr->in = NULL;
+ }
+ if (slavePtr->masterPtr != NULL) {
+ slavePtr->in = Tcl_NewStringObj(
+ Tk_PathName(slavePtr->masterPtr->tkwin), -1);
+ Tcl_IncrRefCount(slavePtr->in);
+ }
+ }
+ Tk_ManageGeometry(slave, NULL, NULL);
+ if (slavePtr->masterPtr->tkwin != Tk_Parent(slavePtr->tkwin)) {
+ Tk_UnmaintainGeometry(slavePtr->tkwin,
+ slavePtr->masterPtr->tkwin);
+ }
+ Unlink(slavePtr);
+ Tk_UnmapWindow(slavePtr->tkwin);
+ }
+ }
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * GridInfoCommand --
+ *
+ * Implementation of the [grid info] subcommand. See the user
+ * documentation for details on what it does.
+ *
+ * Results:
+ * Standard Tcl result.
+ *
+ * Side effects:
+ * Puts gridding information in the interpreter's result.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+GridInfoCommand(
+ Tk_Window tkwin, /* Main window of the application. */
+ Tcl_Interp *interp, /* Current interpreter. */
+ int objc, /* Number of arguments. */
+ Tcl_Obj *const objv[]) /* Argument objects. */
+{
+ register Gridder *slavePtr;
+ Tk_Window slave;
+ Tcl_Obj *infoObj;
+
+ if (objc != 3) {
+ Tcl_WrongNumArgs(interp, 2, objv, "window");
+ return TCL_ERROR;
+ }
+ if (TkGetWindowFromObj(interp, tkwin, objv[2], &slave) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ slavePtr = GetGrid(slave);
+ if (slavePtr->masterPtr == NULL) {
+ Tcl_ResetResult(interp);
+ return TCL_OK;
+ }
+
+ infoObj = Tcl_NewObj();
+ Tcl_DictObjPut(NULL, infoObj, Tcl_NewStringObj("-in", -1),
+ TkNewWindowObj(slavePtr->masterPtr->tkwin));
+ Tcl_DictObjPut(NULL, infoObj, Tcl_NewStringObj("-column", -1),
+ Tcl_NewIntObj(slavePtr->column));
+ Tcl_DictObjPut(NULL, infoObj, Tcl_NewStringObj("-row", -1),
+ Tcl_NewIntObj(slavePtr->row));
+ Tcl_DictObjPut(NULL, infoObj, Tcl_NewStringObj("-columnspan", -1),
+ Tcl_NewIntObj(slavePtr->numCols));
+ Tcl_DictObjPut(NULL, infoObj, Tcl_NewStringObj("-rowspan", -1),
+ Tcl_NewIntObj(slavePtr->numRows));
+ TkAppendPadAmount(infoObj, "-ipadx", slavePtr->iPadX/2, slavePtr->iPadX);
+ TkAppendPadAmount(infoObj, "-ipady", slavePtr->iPadY/2, slavePtr->iPadY);
+ TkAppendPadAmount(infoObj, "-padx", slavePtr->padLeft, slavePtr->padX);
+ TkAppendPadAmount(infoObj, "-pady", slavePtr->padTop, slavePtr->padY);
+ Tcl_DictObjPut(NULL, infoObj, Tcl_NewStringObj("-sticky", -1),
+ StickyToObj(slavePtr->sticky));
+ Tcl_SetObjResult(interp, infoObj);
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * GridLocationCommand --
+ *
+ * Implementation of the [grid location] subcommand. See the user
+ * documentation for details on what it does.
+ *
+ * Results:
+ * Standard Tcl result.
+ *
+ * Side effects:
+ * Puts location information in the interpreter's result field.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+GridLocationCommand(
+ Tk_Window tkwin, /* Main window of the application. */
+ Tcl_Interp *interp, /* Current interpreter. */
+ int objc, /* Number of arguments. */
+ Tcl_Obj *const objv[]) /* Argument objects. */
+{
+ Tk_Window master;
+ Gridder *masterPtr; /* Master grid record. */
+ GridMaster *gridPtr; /* Pointer to grid data. */
+ register SlotInfo *slotPtr;
+ int x, y; /* Offset in pixels, from edge of master. */
+ int i, j; /* Corresponding column and row indeces. */
+ int endX, endY; /* End of grid. */
+
+ if (objc != 5) {
+ Tcl_WrongNumArgs(interp, 2, objv, "master x y");
+ return TCL_ERROR;
+ }
+
+ if (TkGetWindowFromObj(interp, tkwin, objv[2], &master) != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ if (Tk_GetPixelsFromObj(interp, master, objv[3], &x) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (Tk_GetPixelsFromObj(interp, master, objv[4], &y) != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ masterPtr = GetGrid(master);
+ if (masterPtr->masterDataPtr == NULL) {
+ Tcl_SetObjResult(interp, NewPairObj(-1, -1));
+ return TCL_OK;
+ }
+ gridPtr = masterPtr->masterDataPtr;
+
+ /*
+ * Update any pending requests. This is not always the steady state value,
+ * as more configure events could be in the pipeline, but its as close as
+ * its easy to get.
+ */
+
+ while (masterPtr->flags & REQUESTED_RELAYOUT) {
+ Tcl_CancelIdleCall(ArrangeGrid, masterPtr);
+ ArrangeGrid(masterPtr);
+ }
+ SetGridSize(masterPtr);
+ endX = MAX(gridPtr->columnEnd, gridPtr->columnMax);
+ endY = MAX(gridPtr->rowEnd, gridPtr->rowMax);
+
+ slotPtr = masterPtr->masterDataPtr->columnPtr;
+ if (x < masterPtr->masterDataPtr->startX) {
+ i = -1;
+ } else {
+ x -= masterPtr->masterDataPtr->startX;
+ for (i = 0; slotPtr[i].offset < x && i < endX; i++) {
+ /* null body */
+ }
+ }
+
+ slotPtr = masterPtr->masterDataPtr->rowPtr;
+ if (y < masterPtr->masterDataPtr->startY) {
+ j = -1;
+ } else {
+ y -= masterPtr->masterDataPtr->startY;
+ for (j = 0; slotPtr[j].offset < y && j < endY; j++) {
+ /* null body */
+ }
+ }
+
+ Tcl_SetObjResult(interp, NewPairObj(i, j));
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * GridPropagateCommand --
+ *
+ * Implementation of the [grid propagate] subcommand. See the user
+ * documentation for details on what it does.
+ *
+ * Results:
+ * Standard Tcl result.
+ *
+ * Side effects:
+ * May alter geometry propagation for a widget.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+GridPropagateCommand(
+ Tk_Window tkwin, /* Main window of the application. */
+ Tcl_Interp *interp, /* Current interpreter. */
+ int objc, /* Number of arguments. */
+ Tcl_Obj *const objv[]) /* Argument objects. */
+{
+ Tk_Window master;
+ Gridder *masterPtr;
+ int propagate, old;
+
+ if (objc > 4) {
+ Tcl_WrongNumArgs(interp, 2, objv, "window ?boolean?");
+ return TCL_ERROR;
+ }
+
+ if (TkGetWindowFromObj(interp, tkwin, objv[2], &master) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ masterPtr = GetGrid(master);
+ if (objc == 3) {
+ Tcl_SetObjResult(interp,
+ Tcl_NewBooleanObj(!(masterPtr->flags & DONT_PROPAGATE)));
+ return TCL_OK;
+ }
+ if (Tcl_GetBooleanFromObj(interp, objv[3], &propagate) != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ /*
+ * Only request a relayout if the propagation bit changes.
+ */
+
+ old = !(masterPtr->flags & DONT_PROPAGATE);
+ if (propagate != old) {
+ if (propagate) {
+ /*
+ * If we have slaves, we need to register as geometry master.
+ */
+
+ if (masterPtr->slavePtr != NULL) {
+ if (TkSetGeometryMaster(interp, master, "grid") != TCL_OK) {
+ return TCL_ERROR;
+ }
+ masterPtr->flags |= ALLOCED_MASTER;
+ }
+ masterPtr->flags &= ~DONT_PROPAGATE;
+ } else {
+ if (masterPtr->flags & ALLOCED_MASTER) {
+ TkFreeGeometryMaster(master, "grid");
+ masterPtr->flags &= ~ALLOCED_MASTER;
+ }
+ masterPtr->flags |= DONT_PROPAGATE;
+ }
+
+ /*
+ * Re-arrange the master to allow new geometry information to
+ * propagate upwards to the master's master.
+ */
+
+ if (masterPtr->abortPtr != NULL) {
+ *masterPtr->abortPtr = 1;
+ }
+ if (!(masterPtr->flags & REQUESTED_RELAYOUT)) {
+ masterPtr->flags |= REQUESTED_RELAYOUT;
+ Tcl_DoWhenIdle(ArrangeGrid, masterPtr);
+ }
+ }
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * GridRowColumnConfigureCommand --
+ *
+ * Implementation of the [grid rowconfigure] and [grid columnconfigure]
+ * subcommands. See the user documentation for details on what these do.
+ *
+ * Results:
+ * Standard Tcl result.
+ *
+ * Side effects:
+ * Depends on arguments; see user documentation.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+GridRowColumnConfigureCommand(
+ Tk_Window tkwin, /* Main window of the application. */
+ Tcl_Interp *interp, /* Current interpreter. */
+ int objc, /* Number of arguments. */
+ Tcl_Obj *const objv[]) /* Argument objects. */
+{
+ Tk_Window master, slave;
+ Gridder *masterPtr, *slavePtr;
+ SlotInfo *slotPtr = NULL;
+ int slot; /* the column or row number */
+ int slotType; /* COLUMN or ROW */
+ int size; /* the configuration value */
+ int lObjc; /* Number of items in index list */
+ Tcl_Obj **lObjv; /* array of indices */
+ int ok; /* temporary TCL result code */
+ int i, j, first, last;
+ const char *string;
+ static const char *const optionStrings[] = {
+ "-minsize", "-pad", "-uniform", "-weight", NULL
+ };
+ enum options {
+ ROWCOL_MINSIZE, ROWCOL_PAD, ROWCOL_UNIFORM, ROWCOL_WEIGHT
+ };
+ int index;
+ Tcl_Obj *listCopy;
+
+ if (((objc % 2 != 0) && (objc > 6)) || (objc < 4)) {
+ Tcl_WrongNumArgs(interp, 2, objv, "master index ?-option value ...?");
+ return TCL_ERROR;
+ }
+
+ if (TkGetWindowFromObj(interp, tkwin, objv[2], &master) != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ listCopy = Tcl_DuplicateObj(objv[3]);
+ Tcl_IncrRefCount(listCopy);
+ if (Tcl_ListObjGetElements(interp, listCopy, &lObjc, &lObjv) != TCL_OK) {
+ Tcl_DecrRefCount(listCopy);
+ return TCL_ERROR;
+ }
+
+ string = Tcl_GetString(objv[1]);
+ slotType = (*string == 'c') ? COLUMN : ROW;
+ if (lObjc == 0) {
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf("no %s indices specified",
+ (slotType == COLUMN) ? "column" : "row"));
+ Tcl_SetErrorCode(interp, "TK", "GRID", "NO_INDEX", NULL);
+ Tcl_DecrRefCount(listCopy);
+ return TCL_ERROR;
+ }
+
+ masterPtr = GetGrid(master);
+ first = 0; /* lint */
+ last = 0; /* lint */
+
+ if ((objc == 4) || (objc == 5)) {
+ if (lObjc != 1) {
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "must specify a single element on retrieval", -1));
+ Tcl_SetErrorCode(interp, "TK", "GRID", "USAGE", NULL);
+ Tcl_DecrRefCount(listCopy);
+ return TCL_ERROR;
+ }
+ if (Tcl_GetIntFromObj(interp, lObjv[0], &slot) != TCL_OK) {
+ Tcl_AppendResult(interp,
+ " (when retrieving options only integer indices are "
+ "allowed)", NULL);
+ Tcl_SetErrorCode(interp, "TK", "GRID", "INDEX_FORMAT", NULL);
+ Tcl_DecrRefCount(listCopy);
+ return TCL_ERROR;
+ }
+ ok = CheckSlotData(masterPtr, slot, slotType, /* checkOnly */ 1);
+ if (ok == TCL_OK) {
+ slotPtr = (slotType == COLUMN) ?
+ masterPtr->masterDataPtr->columnPtr :
+ masterPtr->masterDataPtr->rowPtr;
+ }
+
+ /*
+ * Return all of the options for this row or column. If the request is
+ * out of range, return all 0's.
+ */
+
+ if (objc == 4) {
+ int minsize = 0, pad = 0, weight = 0;
+ Tk_Uid uniform = NULL;
+ Tcl_Obj *res = Tcl_NewListObj(0, NULL);
+
+ if (ok == TCL_OK) {
+ minsize = slotPtr[slot].minSize;
+ pad = slotPtr[slot].pad;
+ weight = slotPtr[slot].weight;
+ uniform = slotPtr[slot].uniform;
+ }
+
+ Tcl_ListObjAppendElement(interp, res,
+ Tcl_NewStringObj("-minsize", -1));
+ Tcl_ListObjAppendElement(interp, res, Tcl_NewIntObj(minsize));
+ Tcl_ListObjAppendElement(interp, res,
+ Tcl_NewStringObj("-pad", -1));
+ Tcl_ListObjAppendElement(interp, res, Tcl_NewIntObj(pad));
+ Tcl_ListObjAppendElement(interp, res,
+ Tcl_NewStringObj("-uniform", -1));
+ Tcl_ListObjAppendElement(interp, res,
+ Tcl_NewStringObj(uniform == NULL ? "" : uniform, -1));
+ Tcl_ListObjAppendElement(interp, res,
+ Tcl_NewStringObj("-weight", -1));
+ Tcl_ListObjAppendElement(interp, res, Tcl_NewIntObj(weight));
+ Tcl_SetObjResult(interp, res);
+ Tcl_DecrRefCount(listCopy);
+ return TCL_OK;
+ }
+
+ /*
+ * If only one option is given, with no value, the current value is
+ * returned.
+ */
+
+ if (Tcl_GetIndexFromObjStruct(interp, objv[4], optionStrings,
+ sizeof(char *), "option", 0, &index) != TCL_OK) {
+ Tcl_DecrRefCount(listCopy);
+ return TCL_ERROR;
+ }
+ if (index == ROWCOL_MINSIZE) {
+ Tcl_SetObjResult(interp, Tcl_NewIntObj(
+ (ok == TCL_OK) ? slotPtr[slot].minSize : 0));
+ } else if (index == ROWCOL_WEIGHT) {
+ Tcl_SetObjResult(interp, Tcl_NewIntObj(
+ (ok == TCL_OK) ? slotPtr[slot].weight : 0));
+ } else if (index == ROWCOL_UNIFORM) {
+ Tk_Uid value = (ok == TCL_OK) ? slotPtr[slot].uniform : "";
+
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ (value == NULL) ? "" : value, -1));
+ } else if (index == ROWCOL_PAD) {
+ Tcl_SetObjResult(interp, Tcl_NewIntObj(
+ (ok == TCL_OK) ? slotPtr[slot].pad : 0));
+ }
+ Tcl_DecrRefCount(listCopy);
+ return TCL_OK;
+ }
+
+ for (j = 0; j < lObjc; j++) {
+ int allSlaves = 0;
+
+ if (Tcl_GetIntFromObj(NULL, lObjv[j], &slot) == TCL_OK) {
+ first = slot;
+ last = slot;
+ slavePtr = NULL;
+ } else if (strcmp(Tcl_GetString(lObjv[j]), "all") == 0) {
+ /*
+ * Make sure master is initialised.
+ */
+
+ InitMasterData(masterPtr);
+
+ slavePtr = masterPtr->slavePtr;
+ if (slavePtr == NULL) {
+ continue;
+ }
+ allSlaves = 1;
+ } else if (TkGetWindowFromObj(NULL, tkwin, lObjv[j], &slave)
+ == TCL_OK) {
+ /*
+ * Is it gridded in this master?
+ */
+
+ slavePtr = GetGrid(slave);
+ if (slavePtr->masterPtr != masterPtr) {
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "the window \"%s\" is not managed by \"%s\"",
+ Tcl_GetString(lObjv[j]), Tcl_GetString(objv[2])));
+ Tcl_SetErrorCode(interp, "TK", "GRID", "NOT_MASTER", NULL);
+ Tcl_DecrRefCount(listCopy);
+ return TCL_ERROR;
+ }
+ } else {
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "illegal index \"%s\"", Tcl_GetString(lObjv[j])));
+ Tcl_SetErrorCode(interp, "TK", "VALUE", "GRID_INDEX", NULL);
+ Tcl_DecrRefCount(listCopy);
+ return TCL_ERROR;
+ }
+
+ /*
+ * The outer loop is only to handle "all".
+ */
+
+ do {
+ if (slavePtr != NULL) {
+ first = (slotType == COLUMN) ?
+ slavePtr->column : slavePtr->row;
+ last = first - 1 + ((slotType == COLUMN) ?
+ slavePtr->numCols : slavePtr->numRows);
+ }
+
+ for (slot = first; slot <= last; slot++) {
+ ok = CheckSlotData(masterPtr, slot, slotType, /*checkOnly*/ 0);
+ if (ok != TCL_OK) {
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "\"%s\" is out of range",
+ Tcl_GetString(lObjv[j])));
+ Tcl_SetErrorCode(interp, "TK", "GRID", "INDEX_RANGE",
+ NULL);
+ Tcl_DecrRefCount(listCopy);
+ return TCL_ERROR;
+ }
+ slotPtr = (slotType == COLUMN) ?
+ masterPtr->masterDataPtr->columnPtr :
+ masterPtr->masterDataPtr->rowPtr;
+
+ /*
+ * Loop through each option value pair, setting the values as
+ * required.
+ */
+
+ for (i = 4; i < objc; i += 2) {
+ if (Tcl_GetIndexFromObjStruct(interp, objv[i], optionStrings,
+ sizeof(char *), "option", 0, &index) != TCL_OK) {
+ Tcl_DecrRefCount(listCopy);
+ return TCL_ERROR;
+ }
+ if (index == ROWCOL_MINSIZE) {
+ if (Tk_GetPixelsFromObj(interp, master, objv[i+1],
+ &size) != TCL_OK) {
+ Tcl_DecrRefCount(listCopy);
+ return TCL_ERROR;
+ } else {
+ slotPtr[slot].minSize = size;
+ }
+ } else if (index == ROWCOL_WEIGHT) {
+ int wt;
+
+ if (Tcl_GetIntFromObj(interp,objv[i+1],&wt)!=TCL_OK) {
+ Tcl_DecrRefCount(listCopy);
+ return TCL_ERROR;
+ } else if (wt < 0) {
+ Tcl_DecrRefCount(listCopy);
+ goto negativeIndex;
+ } else {
+ slotPtr[slot].weight = wt;
+ }
+ } else if (index == ROWCOL_UNIFORM) {
+ slotPtr[slot].uniform =
+ Tk_GetUid(Tcl_GetString(objv[i+1]));
+ if (slotPtr[slot].uniform != NULL &&
+ slotPtr[slot].uniform[0] == 0) {
+ slotPtr[slot].uniform = NULL;
+ }
+ } else if (index == ROWCOL_PAD) {
+ if (Tk_GetPixelsFromObj(interp, master, objv[i+1],
+ &size) != TCL_OK) {
+ Tcl_DecrRefCount(listCopy);
+ return TCL_ERROR;
+ } else if (size < 0) {
+ Tcl_DecrRefCount(listCopy);
+ goto negativeIndex;
+ } else {
+ slotPtr[slot].pad = size;
+ }
+ }
+ }
+ }
+ if (slavePtr != NULL) {
+ slavePtr = slavePtr->nextPtr;
+ }
+ } while ((allSlaves == 1) && (slavePtr != NULL));
+ }
+ Tcl_DecrRefCount(listCopy);
+
+ /*
+ * We changed a property, re-arrange the table, and check for constraint
+ * shrinkage. A null slotPtr will occur for 'all' checks.
+ */
+
+ if (slotPtr != NULL) {
+ if (slotType == ROW) {
+ int last = masterPtr->masterDataPtr->rowMax - 1;
+
+ while ((last >= 0) && (slotPtr[last].weight == 0)
+ && (slotPtr[last].pad == 0) && (slotPtr[last].minSize == 0)
+ && (slotPtr[last].uniform == NULL)) {
+ last--;
+ }
+ masterPtr->masterDataPtr->rowMax = last+1;
+ } else {
+ int last = masterPtr->masterDataPtr->columnMax - 1;
+
+ while ((last >= 0) && (slotPtr[last].weight == 0)
+ && (slotPtr[last].pad == 0) && (slotPtr[last].minSize == 0)
+ && (slotPtr[last].uniform == NULL)) {
+ last--;
+ }
+ masterPtr->masterDataPtr->columnMax = last + 1;
+ }
+ }
+
+ if (masterPtr->abortPtr != NULL) {
+ *masterPtr->abortPtr = 1;
+ }
+ if (!(masterPtr->flags & REQUESTED_RELAYOUT)) {
+ masterPtr->flags |= REQUESTED_RELAYOUT;
+ Tcl_DoWhenIdle(ArrangeGrid, masterPtr);
+ }
+ return TCL_OK;
+
+ negativeIndex:
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "invalid arg \"%s\": should be non-negative",
+ Tcl_GetString(objv[i])));
+ Tcl_SetErrorCode(interp, "TK", "GRID", "NEG_INDEX", NULL);
+ return TCL_ERROR;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * GridSizeCommand --
+ *
+ * Implementation of the [grid size] subcommand. See the user
+ * documentation for details on what it does.
+ *
+ * Results:
+ * Standard Tcl result.
+ *
+ * Side effects:
+ * Puts grid size information in the interpreter's result.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+GridSizeCommand(
+ Tk_Window tkwin, /* Main window of the application. */
+ Tcl_Interp *interp, /* Current interpreter. */
+ int objc, /* Number of arguments. */
+ Tcl_Obj *const objv[]) /* Argument objects. */
+{
+ Tk_Window master;
+ Gridder *masterPtr;
+ GridMaster *gridPtr; /* pointer to grid data */
+
+ if (objc != 3) {
+ Tcl_WrongNumArgs(interp, 2, objv, "window");
+ return TCL_ERROR;
+ }
+
+ if (TkGetWindowFromObj(interp, tkwin, objv[2], &master) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ masterPtr = GetGrid(master);
+
+ if (masterPtr->masterDataPtr != NULL) {
+ SetGridSize(masterPtr);
+ gridPtr = masterPtr->masterDataPtr;
+ Tcl_SetObjResult(interp, NewPairObj(
+ MAX(gridPtr->columnEnd, gridPtr->columnMax),
+ MAX(gridPtr->rowEnd, gridPtr->rowMax)));
+ } else {
+ Tcl_SetObjResult(interp, NewPairObj(0, 0));
+ }
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * GridSlavesCommand --
+ *
+ * Implementation of the [grid slaves] subcommand. See the user
+ * documentation for details on what it does.
+ *
+ * Results:
+ * Standard Tcl result.
+ *
+ * Side effects:
+ * Places a list of slaves of the specified window in the interpreter's
+ * result field.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+GridSlavesCommand(
+ Tk_Window tkwin, /* Main window of the application. */
+ Tcl_Interp *interp, /* Current interpreter. */
+ int objc, /* Number of arguments. */
+ Tcl_Obj *const objv[]) /* Argument objects. */
+{
+ Tk_Window master;
+ Gridder *masterPtr; /* master grid record */
+ Gridder *slavePtr;
+ int i, value, index;
+ int row = -1, column = -1;
+ static const char *const optionStrings[] = {
+ "-column", "-row", NULL
+ };
+ enum options { SLAVES_COLUMN, SLAVES_ROW };
+ Tcl_Obj *res;
+
+ if ((objc < 3) || ((objc % 2) == 0)) {
+ Tcl_WrongNumArgs(interp, 2, objv, "window ?-option value ...?");
+ return TCL_ERROR;
+ }
+
+ for (i = 3; i < objc; i += 2) {
+ if (Tcl_GetIndexFromObjStruct(interp, objv[i], optionStrings,
+ sizeof(char *), "option", 0, &index) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (Tcl_GetIntFromObj(interp, objv[i+1], &value) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (value < 0) {
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "%d is an invalid value: should NOT be < 0", value));
+ Tcl_SetErrorCode(interp, "TK", "GRID", "NEG_INDEX", NULL);
+ return TCL_ERROR;
+ }
+ if (index == SLAVES_COLUMN) {
+ column = value;
+ } else {
+ row = value;
+ }
+ }
+
+ if (TkGetWindowFromObj(interp, tkwin, objv[2], &master) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ masterPtr = GetGrid(master);
+
+ res = Tcl_NewListObj(0, NULL);
+ for (slavePtr = masterPtr->slavePtr; slavePtr != NULL;
+ slavePtr = slavePtr->nextPtr) {
+ if ((column >= 0) && (slavePtr->column > column
+ || slavePtr->column+slavePtr->numCols-1 < column)) {
+ continue;
+ }
+ if ((row >= 0) && (slavePtr->row > row ||
+ slavePtr->row+slavePtr->numRows-1 < row)) {
+ continue;
+ }
+ Tcl_ListObjAppendElement(interp,res, TkNewWindowObj(slavePtr->tkwin));
+ }
+ Tcl_SetObjResult(interp, res);
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * GridReqProc --
+ *
+ * This procedure is invoked by Tk_GeometryRequest for windows managed by
+ * the grid.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Arranges for tkwin, and all its managed siblings, to be re-arranged at
+ * the next idle point.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+GridReqProc(
+ ClientData clientData, /* Grid's information about window that got
+ * new preferred geometry. */
+ Tk_Window tkwin) /* Other Tk-related information about the
+ * window. */
+{
+ register Gridder *gridPtr = clientData;
+
+ gridPtr = gridPtr->masterPtr;
+ if (gridPtr && !(gridPtr->flags & REQUESTED_RELAYOUT)) {
+ gridPtr->flags |= REQUESTED_RELAYOUT;
+ Tcl_DoWhenIdle(ArrangeGrid, gridPtr);
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * GridLostSlaveProc --
+ *
+ * This procedure is invoked by Tk whenever some other geometry claims
+ * control over a slave that used to be managed by us.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Forgets all grid-related information about the slave.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+GridLostSlaveProc(
+ ClientData clientData, /* Grid structure for slave window that was
+ * stolen away. */
+ Tk_Window tkwin) /* Tk's handle for the slave window. */
+{
+ register Gridder *slavePtr = clientData;
+
+ if (slavePtr->masterPtr->tkwin != Tk_Parent(slavePtr->tkwin)) {
+ Tk_UnmaintainGeometry(slavePtr->tkwin, slavePtr->masterPtr->tkwin);
+ }
+ Unlink(slavePtr);
+ Tk_UnmapWindow(slavePtr->tkwin);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * AdjustOffsets --
+ *
+ * This procedure adjusts the size of the layout to fit in the space
+ * provided. If it needs more space, the extra is added according to the
+ * weights. If it needs less, the space is removed according to the
+ * weights, but at no time does the size drop below the minsize specified
+ * for that slot.
+ *
+ * Results:
+ * The size used by the layout.
+ *
+ * Side effects:
+ * The slot offsets are modified to shrink the layout.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+AdjustOffsets(
+ int size, /* The total layout size (in pixels). */
+ int slots, /* Number of slots. */
+ register SlotInfo *slotPtr) /* Pointer to slot array. */
+{
+ register int slot; /* Current slot. */
+ int diff; /* Extra pixels needed to add to the layout. */
+ int totalWeight; /* Sum of the weights for all the slots. */
+ int weight; /* Sum of the weights so far. */
+ int minSize; /* Minimum possible layout size. */
+ int newDiff; /* The most pixels that can be added on the
+ * current pass. */
+
+ diff = size - slotPtr[slots-1].offset;
+
+ /*
+ * The layout is already the correct size; all done.
+ */
+
+ if (diff == 0) {
+ return size;
+ }
+
+ /*
+ * If all the weights are zero, there is nothing more to do.
+ */
+
+ totalWeight = 0;
+ for (slot = 0; slot < slots; slot++) {
+ totalWeight += slotPtr[slot].weight;
+ }
+
+ if (totalWeight == 0) {
+ return slotPtr[slots-1].offset;
+ }
+
+ /*
+ * Add extra space according to the slot weights. This is done
+ * cumulatively to prevent round-off error accumulation.
+ */
+
+ if (diff > 0) {
+ weight = 0;
+ for (slot = 0; slot < slots; slot++) {
+ weight += slotPtr[slot].weight;
+ slotPtr[slot].offset += diff * weight / totalWeight;
+ }
+ return size;
+ }
+
+ /*
+ * The layout must shrink below its requested size. Compute the minimum
+ * possible size by looking at the slot minSizes. Store each slot's
+ * minimum size in temp.
+ */
+
+ minSize = 0;
+ for (slot = 0; slot < slots; slot++) {
+ if (slotPtr[slot].weight > 0) {
+ slotPtr[slot].temp = slotPtr[slot].minSize;
+ } else if (slot > 0) {
+ slotPtr[slot].temp = slotPtr[slot].offset - slotPtr[slot-1].offset;
+ } else {
+ slotPtr[slot].temp = slotPtr[slot].offset;
+ }
+ minSize += slotPtr[slot].temp;
+ }
+
+ /*
+ * If the requested size is less than the minimum required size, set the
+ * slot sizes to their minimum values.
+ */
+
+ if (size <= minSize) {
+ int offset = 0;
+
+ for (slot = 0; slot < slots; slot++) {
+ offset += slotPtr[slot].temp;
+ slotPtr[slot].offset = offset;
+ }
+ return minSize;
+ }
+
+ /*
+ * Remove space from slots according to their weights. The weights get
+ * renormalized anytime a slot shrinks to its minimum size.
+ */
+
+ while (diff < 0) {
+ /*
+ * Find the total weight for the shrinkable slots.
+ */
+
+ totalWeight = 0;
+ for (slot = 0; slot < slots; slot++) {
+ int current = (slot == 0) ? slotPtr[slot].offset :
+ slotPtr[slot].offset - slotPtr[slot-1].offset;
+
+ if (current > slotPtr[slot].minSize) {
+ totalWeight += slotPtr[slot].weight;
+ slotPtr[slot].temp = slotPtr[slot].weight;
+ } else {
+ slotPtr[slot].temp = 0;
+ }
+ }
+ if (totalWeight == 0) {
+ break;
+ }
+
+ /*
+ * Find the maximum amount of space we can distribute this pass.
+ */
+
+ newDiff = diff;
+ for (slot = 0; slot < slots; slot++) {
+ int current; /* Current size of this slot. */
+ int maxDiff; /* Maximum diff that would cause this slot to
+ * equal its minsize. */
+
+ if (slotPtr[slot].temp == 0) {
+ continue;
+ }
+ current = (slot == 0) ? slotPtr[slot].offset :
+ slotPtr[slot].offset - slotPtr[slot-1].offset;
+ maxDiff = totalWeight * (slotPtr[slot].minSize - current)
+ / slotPtr[slot].temp;
+ if (maxDiff > newDiff) {
+ newDiff = maxDiff;
+ }
+ }
+
+ /*
+ * Now distribute the space.
+ */
+
+ weight = 0;
+ for (slot = 0; slot < slots; slot++) {
+ weight += slotPtr[slot].temp;
+ slotPtr[slot].offset += newDiff * weight / totalWeight;
+ }
+ diff -= newDiff;
+ }
+ return size;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * AdjustForSticky --
+ *
+ * This procedure adjusts the size of a slave in its cavity based on its
+ * "sticky" flags.
+ *
+ * Results:
+ * The input x, y, width, and height are changed to represent the desired
+ * coordinates of the slave.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+AdjustForSticky(
+ Gridder *slavePtr, /* Slave window to arrange in its cavity. */
+ int *xPtr, /* Pixel location of the left edge of the cavity. */
+ int *yPtr, /* Pixel location of the top edge of the cavity. */
+ int *widthPtr, /* Width of the cavity (in pixels). */
+ int *heightPtr) /* Height of the cavity (in pixels). */
+{
+ int diffx = 0; /* Cavity width - slave width. */
+ int diffy = 0; /* Cavity hight - slave height. */
+ int sticky = slavePtr->sticky;
+
+ *xPtr += slavePtr->padLeft;
+ *widthPtr -= slavePtr->padX;
+ *yPtr += slavePtr->padTop;
+ *heightPtr -= slavePtr->padY;
+
+ if (*widthPtr > (Tk_ReqWidth(slavePtr->tkwin) + slavePtr->iPadX)) {
+ diffx = *widthPtr - (Tk_ReqWidth(slavePtr->tkwin) + slavePtr->iPadX);
+ *widthPtr = Tk_ReqWidth(slavePtr->tkwin) + slavePtr->iPadX;
+ }
+
+ if (*heightPtr > (Tk_ReqHeight(slavePtr->tkwin) + slavePtr->iPadY)) {
+ diffy = *heightPtr - (Tk_ReqHeight(slavePtr->tkwin) + slavePtr->iPadY);
+ *heightPtr = Tk_ReqHeight(slavePtr->tkwin) + slavePtr->iPadY;
+ }
+
+ if (sticky&STICK_EAST && sticky&STICK_WEST) {
+ *widthPtr += diffx;
+ }
+ if (sticky&STICK_NORTH && sticky&STICK_SOUTH) {
+ *heightPtr += diffy;
+ }
+ if (!(sticky&STICK_WEST)) {
+ *xPtr += (sticky&STICK_EAST) ? diffx : diffx/2;
+ }
+ if (!(sticky&STICK_NORTH)) {
+ *yPtr += (sticky&STICK_SOUTH) ? diffy : diffy/2;
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ArrangeGrid --
+ *
+ * This procedure is invoked (using the Tcl_DoWhenIdle mechanism) to
+ * re-layout a set of windows managed by the grid. It is invoked at idle
+ * time so that a series of grid requests can be merged into a single
+ * layout operation.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The slaves of masterPtr may get resized or moved.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+ArrangeGrid(
+ ClientData clientData) /* Structure describing master whose slaves
+ * are to be re-layed out. */
+{
+ register Gridder *masterPtr = clientData;
+ register Gridder *slavePtr;
+ GridMaster *slotPtr = masterPtr->masterDataPtr;
+ int abort;
+ int width, height; /* Requested size of layout, in pixels. */
+ int realWidth, realHeight; /* Actual size layout should take-up. */
+ int usedX, usedY;
+
+ masterPtr->flags &= ~REQUESTED_RELAYOUT;
+
+ /*
+ * If the master has no slaves anymore, then don't do anything at all:
+ * just leave the master's size as-is. Otherwise there is no way to
+ * "relinquish" control over the master so another geometry manager can
+ * take over.
+ */
+
+ if (masterPtr->slavePtr == NULL) {
+ return;
+ }
+
+ if (masterPtr->masterDataPtr == NULL) {
+ return;
+ }
+
+ /*
+ * Abort any nested call to ArrangeGrid for this window, since we'll do
+ * everything necessary here, and set up so this call can be aborted if
+ * necessary.
+ */
+
+ if (masterPtr->abortPtr != NULL) {
+ *masterPtr->abortPtr = 1;
+ }
+ masterPtr->abortPtr = &abort;
+ abort = 0;
+ Tcl_Preserve(masterPtr);
+
+ /*
+ * Call the constraint engine to fill in the row and column offsets.
+ */
+
+ SetGridSize(masterPtr);
+ width = ResolveConstraints(masterPtr, COLUMN, 0);
+ height = ResolveConstraints(masterPtr, ROW, 0);
+ width += Tk_InternalBorderLeft(masterPtr->tkwin) +
+ Tk_InternalBorderRight(masterPtr->tkwin);
+ height += Tk_InternalBorderTop(masterPtr->tkwin) +
+ Tk_InternalBorderBottom(masterPtr->tkwin);
+
+ if (width < Tk_MinReqWidth(masterPtr->tkwin)) {
+ width = Tk_MinReqWidth(masterPtr->tkwin);
+ }
+ if (height < Tk_MinReqHeight(masterPtr->tkwin)) {
+ height = Tk_MinReqHeight(masterPtr->tkwin);
+ }
+
+ if (((width != Tk_ReqWidth(masterPtr->tkwin))
+ || (height != Tk_ReqHeight(masterPtr->tkwin)))
+ && !(masterPtr->flags & DONT_PROPAGATE)) {
+ Tk_GeometryRequest(masterPtr->tkwin, width, height);
+ if (width>1 && height>1) {
+ masterPtr->flags |= REQUESTED_RELAYOUT;
+ Tcl_DoWhenIdle(ArrangeGrid, masterPtr);
+ }
+ masterPtr->abortPtr = NULL;
+ Tcl_Release(masterPtr);
+ return;
+ }
+
+ /*
+ * If the currently requested layout size doesn't match the master's
+ * window size, then adjust the slot offsets according to the weights. If
+ * all of the weights are zero, place the layout according to the anchor
+ * value.
+ */
+
+ realWidth = Tk_Width(masterPtr->tkwin) -
+ Tk_InternalBorderLeft(masterPtr->tkwin) -
+ Tk_InternalBorderRight(masterPtr->tkwin);
+ realHeight = Tk_Height(masterPtr->tkwin) -
+ Tk_InternalBorderTop(masterPtr->tkwin) -
+ Tk_InternalBorderBottom(masterPtr->tkwin);
+ usedX = AdjustOffsets(realWidth,
+ MAX(slotPtr->columnEnd, slotPtr->columnMax), slotPtr->columnPtr);
+ usedY = AdjustOffsets(realHeight, MAX(slotPtr->rowEnd, slotPtr->rowMax),
+ slotPtr->rowPtr);
+ TkComputeAnchor(masterPtr->masterDataPtr->anchor, masterPtr->tkwin,
+ 0, 0, usedX, usedY, &slotPtr->startX, &slotPtr->startY);
+
+ /*
+ * Now adjust the actual size of the slave to its cavity by computing the
+ * cavity size, and adjusting the widget according to its stickyness.
+ */
+
+ for (slavePtr = masterPtr->slavePtr; slavePtr != NULL && !abort;
+ slavePtr = slavePtr->nextPtr) {
+ int x, y; /* Top left coordinate */
+ int width, height; /* Slot or slave size */
+ int col = slavePtr->column;
+ int row = slavePtr->row;
+
+ x = (col>0) ? slotPtr->columnPtr[col-1].offset : 0;
+ y = (row>0) ? slotPtr->rowPtr[row-1].offset : 0;
+
+ width = slotPtr->columnPtr[slavePtr->numCols+col-1].offset - x;
+ height = slotPtr->rowPtr[slavePtr->numRows+row-1].offset - y;
+
+ x += slotPtr->startX;
+ y += slotPtr->startY;
+
+ AdjustForSticky(slavePtr, &x, &y, &width, &height);
+
+ /*
+ * Now put the window in the proper spot. (This was taken directly
+ * from tkPack.c.) If the slave is a child of the master, then do this
+ * here. Otherwise let Tk_MaintainGeometry do the work.
+ */
+
+ if (masterPtr->tkwin == Tk_Parent(slavePtr->tkwin)) {
+ if ((width <= 0) || (height <= 0)) {
+ Tk_UnmapWindow(slavePtr->tkwin);
+ } else {
+ if ((x != Tk_X(slavePtr->tkwin))
+ || (y != Tk_Y(slavePtr->tkwin))
+ || (width != Tk_Width(slavePtr->tkwin))
+ || (height != Tk_Height(slavePtr->tkwin))) {
+ Tk_MoveResizeWindow(slavePtr->tkwin, x, y, width, height);
+ }
+ if (abort) {
+ break;
+ }
+
+ /*
+ * Don't map the slave if the master isn't mapped: wait until
+ * the master gets mapped later.
+ */
+
+ if (Tk_IsMapped(masterPtr->tkwin)) {
+ Tk_MapWindow(slavePtr->tkwin);
+ }
+ }
+ } else if ((width <= 0) || (height <= 0)) {
+ Tk_UnmaintainGeometry(slavePtr->tkwin, masterPtr->tkwin);
+ Tk_UnmapWindow(slavePtr->tkwin);
+ } else {
+ Tk_MaintainGeometry(slavePtr->tkwin, masterPtr->tkwin, x, y,
+ width, height);
+ }
+ }
+
+ masterPtr->abortPtr = NULL;
+ Tcl_Release(masterPtr);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ResolveConstraints --
+ *
+ * Resolve all of the column and row boundaries. Most of the calculations
+ * are identical for rows and columns, so this procedure is called twice,
+ * once for rows, and again for columns.
+ *
+ * Results:
+ * The offset (in pixels) from the left/top edge of this layout is
+ * returned.
+ *
+ * Side effects:
+ * The slot offsets are copied into the SlotInfo structure for the
+ * geometry master.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+ResolveConstraints(
+ Gridder *masterPtr, /* The geometry master for this grid. */
+ int slotType, /* Either ROW or COLUMN. */
+ int maxOffset) /* The actual maximum size of this layout in
+ * pixels, or 0 (not currently used). */
+{
+ register SlotInfo *slotPtr; /* Pointer to row/col constraints. */
+ register Gridder *slavePtr; /* List of slave windows in this grid. */
+ int constraintCount; /* Count of rows or columns that have
+ * constraints. */
+ int slotCount; /* Last occupied row or column. */
+ int gridCount; /* The larger of slotCount and
+ * constraintCount. */
+ GridLayout *layoutPtr; /* Temporary layout structure. */
+ int requiredSize; /* The natural size of the grid (pixels).
+ * This is the minimum size needed to
+ * accomodate all of the slaves at their
+ * requested sizes. */
+ int offset; /* The pixel offset of the right edge of the
+ * current slot from the beginning of the
+ * layout. */
+ int slot; /* The current slot. */
+ int start; /* The first slot of a contiguous set whose
+ * constraints are not yet fully resolved. */
+ int end; /* The Last slot of a contiguous set whose
+ * constraints are not yet fully resolved. */
+ UniformGroup uniformPre[UNIFORM_PREALLOC];
+ /* Pre-allocated space for uniform groups. */
+ UniformGroup *uniformGroupPtr;
+ /* Uniform groups data. */
+ int uniformGroups; /* Number of currently used uniform groups. */
+ int uniformGroupsAlloced; /* Size of allocated space for uniform
+ * groups. */
+ int weight, minSize;
+ int prevGrow, accWeight, grow;
+
+ /*
+ * For typical sized tables, we'll use stack space for the layout data to
+ * avoid the overhead of a malloc and free for every layout.
+ */
+
+ GridLayout layoutData[TYPICAL_SIZE + 1];
+
+ if (slotType == COLUMN) {
+ constraintCount = masterPtr->masterDataPtr->columnMax;
+ slotCount = masterPtr->masterDataPtr->columnEnd;
+ slotPtr = masterPtr->masterDataPtr->columnPtr;
+ } else {
+ constraintCount = masterPtr->masterDataPtr->rowMax;
+ slotCount = masterPtr->masterDataPtr->rowEnd;
+ slotPtr = masterPtr->masterDataPtr->rowPtr;
+ }
+
+ /*
+ * Make sure there is enough memory for the layout.
+ */
+
+ gridCount = MAX(constraintCount, slotCount);
+ if (gridCount >= TYPICAL_SIZE) {
+ layoutPtr = ckalloc(sizeof(GridLayout) * (1+gridCount));
+ } else {
+ layoutPtr = layoutData;
+ }
+
+ /*
+ * Allocate an extra layout slot to represent the left/top edge of the 0th
+ * slot to make it easier to calculate slot widths from offsets without
+ * special case code.
+ *
+ * Initialize the "dummy" slot to the left/top of the table. This slot
+ * avoids special casing the first slot.
+ */
+
+ layoutPtr->minOffset = 0;
+ layoutPtr->maxOffset = 0;
+ layoutPtr++;
+
+ /*
+ * Step 1.
+ * Copy the slot constraints into the layout structure, and initialize the
+ * rest of the fields.
+ */
+
+ for (slot=0; slot < constraintCount; slot++) {
+ layoutPtr[slot].minSize = slotPtr[slot].minSize;
+ layoutPtr[slot].weight = slotPtr[slot].weight;
+ layoutPtr[slot].uniform = slotPtr[slot].uniform;
+ layoutPtr[slot].pad = slotPtr[slot].pad;
+ layoutPtr[slot].binNextPtr = NULL;
+ }
+ for (; slot<gridCount; slot++) {
+ layoutPtr[slot].minSize = 0;
+ layoutPtr[slot].weight = 0;
+ layoutPtr[slot].uniform = NULL;
+ layoutPtr[slot].pad = 0;
+ layoutPtr[slot].binNextPtr = NULL;
+ }
+
+ /*
+ * Step 2.
+ * Slaves with a span of 1 are used to determine the minimum size of each
+ * slot. Slaves whose span is two or more slots don't contribute to the
+ * minimum size of each slot directly, but can cause slots to grow if
+ * their size exceeds the the sizes of the slots they span.
+ *
+ * Bin all slaves whose spans are > 1 by their right edges. This allows
+ * the computation on minimum and maximum possible layout sizes at each
+ * slot boundary, without the need to re-sort the slaves.
+ */
+
+ switch (slotType) {
+ case COLUMN:
+ for (slavePtr = masterPtr->slavePtr; slavePtr != NULL;
+ slavePtr = slavePtr->nextPtr) {
+ int rightEdge = slavePtr->column + slavePtr->numCols - 1;
+
+ slavePtr->size = Tk_ReqWidth(slavePtr->tkwin) + slavePtr->padX
+ + slavePtr->iPadX + slavePtr->doubleBw;
+ if (slavePtr->numCols > 1) {
+ slavePtr->binNextPtr = layoutPtr[rightEdge].binNextPtr;
+ layoutPtr[rightEdge].binNextPtr = slavePtr;
+ } else if (rightEdge >= 0) {
+ int size = slavePtr->size + layoutPtr[rightEdge].pad;
+
+ if (size > layoutPtr[rightEdge].minSize) {
+ layoutPtr[rightEdge].minSize = size;
+ }
+ }
+ }
+ break;
+ case ROW:
+ for (slavePtr = masterPtr->slavePtr; slavePtr != NULL;
+ slavePtr = slavePtr->nextPtr) {
+ int rightEdge = slavePtr->row + slavePtr->numRows - 1;
+
+ slavePtr->size = Tk_ReqHeight(slavePtr->tkwin) + slavePtr->padY
+ + slavePtr->iPadY + slavePtr->doubleBw;
+ if (slavePtr->numRows > 1) {
+ slavePtr->binNextPtr = layoutPtr[rightEdge].binNextPtr;
+ layoutPtr[rightEdge].binNextPtr = slavePtr;
+ } else if (rightEdge >= 0) {
+ int size = slavePtr->size + layoutPtr[rightEdge].pad;
+
+ if (size > layoutPtr[rightEdge].minSize) {
+ layoutPtr[rightEdge].minSize = size;
+ }
+ }
+ }
+ break;
+ }
+
+ /*
+ * Step 2b.
+ * Consider demands on uniform sizes.
+ */
+
+ uniformGroupPtr = uniformPre;
+ uniformGroupsAlloced = UNIFORM_PREALLOC;
+ uniformGroups = 0;
+
+ for (slot = 0; slot < gridCount; slot++) {
+ if (layoutPtr[slot].uniform != NULL) {
+ for (start = 0; start < uniformGroups; start++) {
+ if (uniformGroupPtr[start].group == layoutPtr[slot].uniform) {
+ break;
+ }
+ }
+ if (start >= uniformGroups) {
+ /*
+ * Have not seen that group before, set up data for it.
+ */
+
+ if (uniformGroups >= uniformGroupsAlloced) {
+ /*
+ * We need to allocate more space.
+ */
+
+ size_t oldSize = uniformGroupsAlloced
+ * sizeof(UniformGroup);
+ size_t newSize = (uniformGroupsAlloced + UNIFORM_PREALLOC)
+ * sizeof(UniformGroup);
+ UniformGroup *newUG = ckalloc(newSize);
+ UniformGroup *oldUG = uniformGroupPtr;
+
+ memcpy(newUG, oldUG, oldSize);
+ if (oldUG != uniformPre) {
+ ckfree(oldUG);
+ }
+ uniformGroupPtr = newUG;
+ uniformGroupsAlloced += UNIFORM_PREALLOC;
+ }
+ uniformGroups++;
+ uniformGroupPtr[start].group = layoutPtr[slot].uniform;
+ uniformGroupPtr[start].minSize = 0;
+ }
+ weight = layoutPtr[slot].weight;
+ weight = weight > 0 ? weight : 1;
+ minSize = (layoutPtr[slot].minSize + weight - 1) / weight;
+ if (minSize > uniformGroupPtr[start].minSize) {
+ uniformGroupPtr[start].minSize = minSize;
+ }
+ }
+ }
+
+ /*
+ * Data has been gathered about uniform groups. Now relayout accordingly.
+ */
+
+ if (uniformGroups > 0) {
+ for (slot = 0; slot < gridCount; slot++) {
+ if (layoutPtr[slot].uniform != NULL) {
+ for (start = 0; start < uniformGroups; start++) {
+ if (uniformGroupPtr[start].group ==
+ layoutPtr[slot].uniform) {
+ weight = layoutPtr[slot].weight;
+ weight = weight > 0 ? weight : 1;
+ layoutPtr[slot].minSize =
+ uniformGroupPtr[start].minSize * weight;
+ break;
+ }
+ }
+ }
+ }
+ }
+
+ if (uniformGroupPtr != uniformPre) {
+ ckfree(uniformGroupPtr);
+ }
+
+ /*
+ * Step 3.
+ * Determine the minimum slot offsets going from left to right that would
+ * fit all of the slaves. This determines the minimum
+ */
+
+ for (offset=0,slot=0; slot < gridCount; slot++) {
+ layoutPtr[slot].minOffset = layoutPtr[slot].minSize + offset;
+ for (slavePtr = layoutPtr[slot].binNextPtr; slavePtr != NULL;
+ slavePtr = slavePtr->binNextPtr) {
+ int span = (slotType == COLUMN) ?
+ slavePtr->numCols : slavePtr->numRows;
+ int required = slavePtr->size + layoutPtr[slot - span].minOffset;
+
+ if (required > layoutPtr[slot].minOffset) {
+ layoutPtr[slot].minOffset = required;
+ }
+ }
+ offset = layoutPtr[slot].minOffset;
+ }
+
+ /*
+ * At this point, we know the minimum required size of the entire layout.
+ * It might be prudent to stop here if our "master" will resize itself to
+ * this size.
+ */
+
+ requiredSize = offset;
+ if (maxOffset > offset) {
+ offset=maxOffset;
+ }
+
+ /*
+ * Step 4.
+ * Determine the minimum slot offsets going from right to left, bounding
+ * the pixel range of each slot boundary. Pre-fill all of the right
+ * offsets with the actual size of the table; they will be reduced as
+ * required.
+ */
+
+ for (slot=0; slot < gridCount; slot++) {
+ layoutPtr[slot].maxOffset = offset;
+ }
+ for (slot=gridCount-1; slot > 0;) {
+ for (slavePtr = layoutPtr[slot].binNextPtr; slavePtr != NULL;
+ slavePtr = slavePtr->binNextPtr) {
+ int span = (slotType == COLUMN) ?
+ slavePtr->numCols : slavePtr->numRows;
+ int require = offset - slavePtr->size;
+ int startSlot = slot - span;
+
+ if (startSlot >=0 && require < layoutPtr[startSlot].maxOffset) {
+ layoutPtr[startSlot].maxOffset = require;
+ }
+ }
+ offset -= layoutPtr[slot].minSize;
+ slot--;
+ if (layoutPtr[slot].maxOffset < offset) {
+ offset = layoutPtr[slot].maxOffset;
+ } else {
+ layoutPtr[slot].maxOffset = offset;
+ }
+ }
+
+ /*
+ * Step 5.
+ * At this point, each slot boundary has a range of values that will
+ * satisfy the overall layout size. Make repeated passes over the layout
+ * structure looking for spans of slot boundaries where the minOffsets are
+ * less than the maxOffsets, and adjust the offsets according to the slot
+ * weights. At each pass, at least one slot boundary will have its range
+ * of possible values fixed at a single value.
+ */
+
+ for (start = 0; start < gridCount;) {
+ int totalWeight = 0; /* Sum of the weights for all of the slots in
+ * this span. */
+ int need = 0; /* The minimum space needed to layout this
+ * span. */
+ int have; /* The actual amount of space that will be
+ * taken up by this span. */
+ int weight; /* Cumulative weights of the columns in this
+ * span. */
+ int noWeights = 0; /* True if the span has no weights. */
+
+ /*
+ * Find a span by identifying ranges of slots whose edges are already
+ * constrained at fixed offsets, but whose internal slot boundaries
+ * have a range of possible positions.
+ */
+
+ if (layoutPtr[start].minOffset == layoutPtr[start].maxOffset) {
+ start++;
+ continue;
+ }
+
+ for (end = start + 1; end < gridCount; end++) {
+ if (layoutPtr[end].minOffset == layoutPtr[end].maxOffset) {
+ break;
+ }
+ }
+
+ /*
+ * We found a span. Compute the total weight, minumum space required,
+ * for this span, and the actual amount of space the span should use.
+ */
+
+ for (slot = start; slot <= end; slot++) {
+ totalWeight += layoutPtr[slot].weight;
+ need += layoutPtr[slot].minSize;
+ }
+ have = layoutPtr[end].maxOffset - layoutPtr[start-1].minOffset;
+
+ /*
+ * If all the weights in the span are zero, then distribute the extra
+ * space evenly.
+ */
+
+ if (totalWeight == 0) {
+ noWeights++;
+ totalWeight = end - start + 1;
+ }
+
+ /*
+ * It might not be possible to give the span all of the space
+ * available on this pass without violating the size constraints of
+ * one or more of the internal slot boundaries. Try to determine the
+ * maximum amount of space that when added to the entire span, would
+ * cause a slot boundary to have its possible range reduced to one
+ * value, and reduce the amount of extra space allocated on this pass
+ * accordingly.
+ *
+ * The calculation is done cumulatively to avoid accumulating roundoff
+ * errors.
+ */
+
+ do {
+ int prevMinOffset = layoutPtr[start - 1].minOffset;
+
+ prevGrow = 0;
+ accWeight = 0;
+ for (slot = start; slot <= end; slot++) {
+ weight = noWeights ? 1 : layoutPtr[slot].weight;
+ accWeight += weight;
+ grow = (have - need) * accWeight / totalWeight - prevGrow;
+ prevGrow += grow;
+
+ if ((weight > 0) &&
+ ((prevMinOffset + layoutPtr[slot].minSize + grow)
+ > layoutPtr[slot].maxOffset)) {
+ int newHave;
+
+ /*
+ * There is not enough room to grow that much. Calculate
+ * how much this slot can grow and how much "have" that
+ * corresponds to.
+ */
+
+ grow = layoutPtr[slot].maxOffset -
+ layoutPtr[slot].minSize - prevMinOffset;
+ newHave = grow * totalWeight / weight;
+ if (newHave > totalWeight) {
+ /*
+ * By distributing multiples of totalWeight we
+ * minimize rounding errors since they will only
+ * happen in the last loop(s).
+ */
+
+ newHave = newHave / totalWeight * totalWeight;
+ }
+ if (newHave <= 0) {
+ /*
+ * We can end up with a "have" of 0 here if the
+ * previous slots have taken all the space. In that
+ * case we cannot guess an appropriate "have" so we
+ * just try some lower "have" that is >= 1, to make
+ * sure this terminates.
+ */
+
+ newHave = (have - need) - 1;
+ if (newHave > (3 * totalWeight)) {
+ /*
+ * Go down 25% for large values.
+ */
+ newHave = newHave * 3 / 4;
+ }
+
+ if (newHave > totalWeight) {
+ /*
+ * Round down to a multiple of totalWeight.
+ */
+ newHave = newHave / totalWeight * totalWeight;
+ }
+
+ if (newHave <= 0) {
+ newHave = 1;
+ }
+ }
+ have = newHave + need;
+
+ /*
+ * Restart loop to check if the new "have" will fit.
+ */
+
+ break;
+ }
+ prevMinOffset += layoutPtr[slot].minSize + grow;
+ if (prevMinOffset < layoutPtr[slot].minOffset) {
+ prevMinOffset = layoutPtr[slot].minOffset;
+ }
+ }
+
+ /*
+ * Quit the outer loop if the inner loop ran all the way.
+ */
+ } while (slot <= end);
+
+ /*
+ * Now distribute the extra space among the slots by adjusting the
+ * minSizes and minOffsets.
+ */
+
+ prevGrow = 0;
+ accWeight = 0;
+ for (slot = start; slot <= end; slot++) {
+ accWeight += noWeights ? 1 : layoutPtr[slot].weight;
+ grow = (have - need) * accWeight / totalWeight - prevGrow;
+ prevGrow += grow;
+ layoutPtr[slot].minSize += grow;
+ if ((layoutPtr[slot-1].minOffset + layoutPtr[slot].minSize)
+ > layoutPtr[slot].minOffset) {
+ layoutPtr[slot].minOffset = layoutPtr[slot-1].minOffset +
+ layoutPtr[slot].minSize;
+ }
+ }
+
+ /*
+ * Having pushed the top/left boundaries of the slots to take up extra
+ * space, the bottom/right space is recalculated to propagate the new
+ * space allocation.
+ */
+
+ for (slot = end; slot > start; slot--) {
+ /*
+ * maxOffset may not go up.
+ */
+
+ if ((layoutPtr[slot].maxOffset-layoutPtr[slot].minSize)
+ < layoutPtr[slot-1].maxOffset) {
+ layoutPtr[slot-1].maxOffset =
+ layoutPtr[slot].maxOffset-layoutPtr[slot].minSize;
+ }
+ }
+ }
+
+ /*
+ * Step 6.
+ * All of the space has been apportioned; copy the layout information back
+ * into the master.
+ */
+
+ for (slot=0; slot < gridCount; slot++) {
+ slotPtr[slot].offset = layoutPtr[slot].minOffset;
+ }
+
+ --layoutPtr;
+ if (layoutPtr != layoutData) {
+ ckfree(layoutPtr);
+ }
+ return requiredSize;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * GetGrid --
+ *
+ * This internal procedure is used to locate a Grid structure for a given
+ * window, creating one if one doesn't exist already.
+ *
+ * Results:
+ * The return value is a pointer to the Grid structure corresponding to
+ * tkwin.
+ *
+ * Side effects:
+ * A new grid structure may be created. If so, then a callback is set up
+ * to clean things up when the window is deleted.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static Gridder *
+GetGrid(
+ Tk_Window tkwin) /* Token for window for which grid structure
+ * is desired. */
+{
+ register Gridder *gridPtr;
+ Tcl_HashEntry *hPtr;
+ int isNew;
+ TkDisplay *dispPtr = ((TkWindow *) tkwin)->dispPtr;
+
+ if (!dispPtr->gridInit) {
+ Tcl_InitHashTable(&dispPtr->gridHashTable, TCL_ONE_WORD_KEYS);
+ dispPtr->gridInit = 1;
+ }
+
+ /*
+ * See if there's already grid for this window. If not, then create a new
+ * one.
+ */
+
+ hPtr = Tcl_CreateHashEntry(&dispPtr->gridHashTable, (char*) tkwin, &isNew);
+ if (!isNew) {
+ return Tcl_GetHashValue(hPtr);
+ }
+ gridPtr = ckalloc(sizeof(Gridder));
+ gridPtr->tkwin = tkwin;
+ gridPtr->masterPtr = NULL;
+ gridPtr->masterDataPtr = NULL;
+ gridPtr->nextPtr = NULL;
+ gridPtr->slavePtr = NULL;
+ gridPtr->binNextPtr = NULL;
+
+ gridPtr->column = -1;
+ gridPtr->row = -1;
+ gridPtr->numCols = 1;
+ gridPtr->numRows = 1;
+
+ gridPtr->padX = 0;
+ gridPtr->padY = 0;
+ gridPtr->padLeft = 0;
+ gridPtr->padTop = 0;
+ gridPtr->iPadX = 0;
+ gridPtr->iPadY = 0;
+ gridPtr->doubleBw = 2 * Tk_Changes(tkwin)->border_width;
+ gridPtr->abortPtr = NULL;
+ gridPtr->flags = 0;
+ gridPtr->sticky = 0;
+ gridPtr->size = 0;
+ gridPtr->in = NULL;
+ gridPtr->masterDataPtr = NULL;
+ Tcl_SetHashValue(hPtr, gridPtr);
+ Tk_CreateEventHandler(tkwin, StructureNotifyMask,
+ GridStructureProc, gridPtr);
+ return gridPtr;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * SetGridSize --
+ *
+ * This internal procedure sets the size of the grid occupied by slaves.
+ *
+ * Results:
+ * None
+ *
+ * Side effects:
+ * The width and height arguments are filled in the master data
+ * structure. Additional space is allocated for the constraints to
+ * accomodate the offsets.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+SetGridSize(
+ Gridder *masterPtr) /* The geometry master for this grid. */
+{
+ register Gridder *slavePtr; /* Current slave window. */
+ int maxX = 0, maxY = 0;
+
+ for (slavePtr = masterPtr->slavePtr; slavePtr != NULL;
+ slavePtr = slavePtr->nextPtr) {
+ maxX = MAX(maxX, slavePtr->numCols + slavePtr->column);
+ maxY = MAX(maxY, slavePtr->numRows + slavePtr->row);
+ }
+ masterPtr->masterDataPtr->columnEnd = maxX;
+ masterPtr->masterDataPtr->rowEnd = maxY;
+ CheckSlotData(masterPtr, maxX, COLUMN, CHECK_SPACE);
+ CheckSlotData(masterPtr, maxY, ROW, CHECK_SPACE);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * SetSlaveColumn --
+ *
+ * Update column data for a slave, checking that MAX_ELEMENT bound
+ * is not passed.
+ *
+ * Results:
+ * TCL_ERROR if out of bounds, TCL_OK otherwise
+ *
+ * Side effects:
+ * Slave fields are updated.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+SetSlaveColumn(
+ Tcl_Interp *interp, /* Interp for error message. */
+ Gridder *slavePtr, /* Slave to be updated. */
+ int column, /* New column or -1 to be unchanged. */
+ int numCols) /* New columnspan or -1 to be unchanged. */
+{
+ int newColumn, newNumCols, lastCol;
+
+ newColumn = (column >= 0) ? column : slavePtr->column;
+ newNumCols = (numCols >= 1) ? numCols : slavePtr->numCols;
+
+ lastCol = ((newColumn >= 0) ? newColumn : 0) + newNumCols;
+ if (lastCol >= MAX_ELEMENT) {
+ Tcl_SetObjResult(interp, Tcl_NewStringObj("column out of bounds",-1));
+ Tcl_SetErrorCode(interp, "TK", "GRID", "BAD_COLUMN", NULL);
+ return TCL_ERROR;
+ }
+
+ slavePtr->column = newColumn;
+ slavePtr->numCols = newNumCols;
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * SetSlaveRow --
+ *
+ * Update row data for a slave, checking that MAX_ELEMENT bound
+ * is not passed.
+ *
+ * Results:
+ * TCL_ERROR if out of bounds, TCL_OK otherwise
+ *
+ * Side effects:
+ * Slave fields are updated.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+SetSlaveRow(
+ Tcl_Interp *interp, /* Interp for error message. */
+ Gridder *slavePtr, /* Slave to be updated. */
+ int row, /* New row or -1 to be unchanged. */
+ int numRows) /* New rowspan or -1 to be unchanged. */
+{
+ int newRow, newNumRows, lastRow;
+
+ newRow = (row >= 0) ? row : slavePtr->row;
+ newNumRows = (numRows >= 1) ? numRows : slavePtr->numRows;
+
+ lastRow = ((newRow >= 0) ? newRow : 0) + newNumRows;
+ if (lastRow >= MAX_ELEMENT) {
+ Tcl_SetObjResult(interp, Tcl_NewStringObj("row out of bounds", -1));
+ Tcl_SetErrorCode(interp, "TK", "GRID", "BAD_ROW", NULL);
+ return TCL_ERROR;
+ }
+
+ slavePtr->row = newRow;
+ slavePtr->numRows = newNumRows;
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * CheckSlotData --
+ *
+ * This internal procedure is used to manage the storage for row and
+ * column (slot) constraints.
+ *
+ * Results:
+ * TRUE if the index is OK, False otherwise.
+ *
+ * Side effects:
+ * A new master grid structure may be created. If so, then it is
+ * initialized. In addition, additional storage for a row or column
+ * constraints may be allocated, and the constraint maximums are
+ * adjusted.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+CheckSlotData(
+ Gridder *masterPtr, /* The geometry master for this grid. */
+ int slot, /* Which slot to look at. */
+ int slotType, /* ROW or COLUMN. */
+ int checkOnly) /* Don't allocate new space if true. */
+{
+ int numSlot; /* Number of slots already allocated (Space) */
+ int end; /* Last used constraint. */
+
+ /*
+ * If slot is out of bounds, return immediately.
+ */
+
+ if (slot < 0 || slot >= MAX_ELEMENT) {
+ return TCL_ERROR;
+ }
+
+ if ((checkOnly == CHECK_ONLY) && (masterPtr->masterDataPtr == NULL)) {
+ return TCL_ERROR;
+ }
+
+ /*
+ * If we need to allocate more space, allocate a little extra to avoid
+ * repeated re-alloc's for large tables. We need enough space to hold all
+ * of the offsets as well.
+ */
+
+ InitMasterData(masterPtr);
+ end = (slotType == ROW) ? masterPtr->masterDataPtr->rowMax :
+ masterPtr->masterDataPtr->columnMax;
+ if (checkOnly == CHECK_ONLY) {
+ return ((end < slot) ? TCL_ERROR : TCL_OK);
+ } else {
+ numSlot = (slotType == ROW) ? masterPtr->masterDataPtr->rowSpace
+ : masterPtr->masterDataPtr->columnSpace;
+ if (slot >= numSlot) {
+ int newNumSlot = slot + PREALLOC;
+ size_t oldSize = numSlot * sizeof(SlotInfo);
+ size_t newSize = newNumSlot * sizeof(SlotInfo);
+ SlotInfo *newSI = ckalloc(newSize);
+ SlotInfo *oldSI = (slotType == ROW)
+ ? masterPtr->masterDataPtr->rowPtr
+ : masterPtr->masterDataPtr->columnPtr;
+
+ memcpy(newSI, oldSI, oldSize);
+ memset(newSI+numSlot, 0, newSize - oldSize);
+ ckfree(oldSI);
+ if (slotType == ROW) {
+ masterPtr->masterDataPtr->rowPtr = newSI;
+ masterPtr->masterDataPtr->rowSpace = newNumSlot;
+ } else {
+ masterPtr->masterDataPtr->columnPtr = newSI;
+ masterPtr->masterDataPtr->columnSpace = newNumSlot;
+ }
+ }
+ if (slot >= end && checkOnly != CHECK_SPACE) {
+ if (slotType == ROW) {
+ masterPtr->masterDataPtr->rowMax = slot+1;
+ } else {
+ masterPtr->masterDataPtr->columnMax = slot+1;
+ }
+ }
+ return TCL_OK;
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * InitMasterData --
+ *
+ * This internal procedure is used to allocate and initialize the data
+ * for a geometry master, if the data doesn't exist already.
+ *
+ * Results:
+ * none
+ *
+ * Side effects:
+ * A new master grid structure may be created. If so, then it is
+ * initialized.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+InitMasterData(
+ Gridder *masterPtr)
+{
+ if (masterPtr->masterDataPtr == NULL) {
+ GridMaster *gridPtr = masterPtr->masterDataPtr =
+ ckalloc(sizeof(GridMaster));
+ size_t size = sizeof(SlotInfo) * TYPICAL_SIZE;
+
+ gridPtr->columnEnd = 0;
+ gridPtr->columnMax = 0;
+ gridPtr->columnPtr = ckalloc(size);
+ gridPtr->columnSpace = TYPICAL_SIZE;
+ gridPtr->rowEnd = 0;
+ gridPtr->rowMax = 0;
+ gridPtr->rowPtr = ckalloc(size);
+ gridPtr->rowSpace = TYPICAL_SIZE;
+ gridPtr->startX = 0;
+ gridPtr->startY = 0;
+ gridPtr->anchor = GRID_DEFAULT_ANCHOR;
+
+ memset(gridPtr->columnPtr, 0, size);
+ memset(gridPtr->rowPtr, 0, size);
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Unlink --
+ *
+ * Remove a grid from its master's list of slaves.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The master will be scheduled for re-arranging, and the size of the
+ * grid will be adjusted accordingly
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+Unlink(
+ register Gridder *slavePtr) /* Window to unlink. */
+{
+ register Gridder *masterPtr, *slavePtr2;
+
+ masterPtr = slavePtr->masterPtr;
+ if (masterPtr == NULL) {
+ return;
+ }
+
+ if (masterPtr->slavePtr == slavePtr) {
+ masterPtr->slavePtr = slavePtr->nextPtr;
+ } else {
+ for (slavePtr2=masterPtr->slavePtr ; ; slavePtr2=slavePtr2->nextPtr) {
+ if (slavePtr2 == NULL) {
+ Tcl_Panic("Unlink couldn't find previous window");
+ }
+ if (slavePtr2->nextPtr == slavePtr) {
+ slavePtr2->nextPtr = slavePtr->nextPtr;
+ break;
+ }
+ }
+ }
+ if (!(masterPtr->flags & REQUESTED_RELAYOUT)) {
+ masterPtr->flags |= REQUESTED_RELAYOUT;
+ Tcl_DoWhenIdle(ArrangeGrid, masterPtr);
+ }
+ if (masterPtr->abortPtr != NULL) {
+ *masterPtr->abortPtr = 1;
+ }
+
+ SetGridSize(slavePtr->masterPtr);
+ slavePtr->masterPtr = NULL;
+
+ /*
+ * If we have emptied this master from slaves it means we are no longer
+ * handling it and should mark it as free.
+ */
+
+ if ((masterPtr->slavePtr == NULL) && (masterPtr->flags & ALLOCED_MASTER)) {
+ TkFreeGeometryMaster(masterPtr->tkwin, "grid");
+ masterPtr->flags &= ~ALLOCED_MASTER;
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * DestroyGrid --
+ *
+ * This procedure is invoked by Tcl_EventuallyFree or Tcl_Release to
+ * clean up the internal structure of a grid at a safe time (when no-one
+ * is using it anymore). Cleaning up the grid involves freeing the main
+ * structure for all windows and the master structure for geometry
+ * managers.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Everything associated with the grid is freed up.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+DestroyGrid(
+ void *memPtr) /* Info about window that is now dead. */
+{
+ register Gridder *gridPtr = memPtr;
+
+ if (gridPtr->masterDataPtr != NULL) {
+ if (gridPtr->masterDataPtr->rowPtr != NULL) {
+ ckfree(gridPtr->masterDataPtr -> rowPtr);
+ }
+ if (gridPtr->masterDataPtr->columnPtr != NULL) {
+ ckfree(gridPtr->masterDataPtr -> columnPtr);
+ }
+ ckfree(gridPtr->masterDataPtr);
+ }
+ if (gridPtr->in != NULL) {
+ Tcl_DecrRefCount(gridPtr->in);
+ }
+ ckfree(gridPtr);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * GridStructureProc --
+ *
+ * This procedure is invoked by the Tk event dispatcher in response to
+ * StructureNotify events.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * If a window was just deleted, clean up all its grid-related
+ * information. If it was just resized, re-configure its slaves, if any.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+GridStructureProc(
+ ClientData clientData, /* Our information about window referred to by
+ * eventPtr. */
+ XEvent *eventPtr) /* Describes what just happened. */
+{
+ register Gridder *gridPtr = clientData;
+ TkDisplay *dispPtr = ((TkWindow *) gridPtr->tkwin)->dispPtr;
+
+ if (eventPtr->type == ConfigureNotify) {
+ if ((gridPtr->slavePtr != NULL)
+ && !(gridPtr->flags & REQUESTED_RELAYOUT)) {
+ gridPtr->flags |= REQUESTED_RELAYOUT;
+ Tcl_DoWhenIdle(ArrangeGrid, gridPtr);
+ }
+ if ((gridPtr->masterPtr != NULL) &&
+ (gridPtr->doubleBw != 2*Tk_Changes(gridPtr->tkwin)->border_width)) {
+ if (!(gridPtr->masterPtr->flags & REQUESTED_RELAYOUT)) {
+ gridPtr->doubleBw = 2*Tk_Changes(gridPtr->tkwin)->border_width;
+ gridPtr->masterPtr->flags |= REQUESTED_RELAYOUT;
+ Tcl_DoWhenIdle(ArrangeGrid, gridPtr->masterPtr);
+ }
+ }
+ } else if (eventPtr->type == DestroyNotify) {
+ register Gridder *gridPtr2, *nextPtr;
+
+ if (gridPtr->masterPtr != NULL) {
+ Unlink(gridPtr);
+ }
+ for (gridPtr2 = gridPtr->slavePtr; gridPtr2 != NULL;
+ gridPtr2 = nextPtr) {
+ Tk_UnmapWindow(gridPtr2->tkwin);
+ gridPtr2->masterPtr = NULL;
+ nextPtr = gridPtr2->nextPtr;
+ gridPtr2->nextPtr = NULL;
+ }
+ Tcl_DeleteHashEntry(Tcl_FindHashEntry(&dispPtr->gridHashTable,
+ (char *) gridPtr->tkwin));
+ if (gridPtr->flags & REQUESTED_RELAYOUT) {
+ Tcl_CancelIdleCall(ArrangeGrid, gridPtr);
+ }
+ gridPtr->tkwin = NULL;
+ Tcl_EventuallyFree(gridPtr, (Tcl_FreeProc *)DestroyGrid);
+ } else if (eventPtr->type == MapNotify) {
+ if ((gridPtr->slavePtr != NULL)
+ && !(gridPtr->flags & REQUESTED_RELAYOUT)) {
+ gridPtr->flags |= REQUESTED_RELAYOUT;
+ Tcl_DoWhenIdle(ArrangeGrid, gridPtr);
+ }
+ } else if (eventPtr->type == UnmapNotify) {
+ register Gridder *gridPtr2;
+
+ for (gridPtr2 = gridPtr->slavePtr; gridPtr2 != NULL;
+ gridPtr2 = gridPtr2->nextPtr) {
+ Tk_UnmapWindow(gridPtr2->tkwin);
+ }
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ConfigureSlaves --
+ *
+ * This implements the guts of the "grid configure" command. Given a list
+ * of slaves and configuration options, it arranges for the grid to
+ * manage the slaves and sets the specified options. Arguments consist
+ * of windows or window shortcuts followed by "-option value" pairs.
+ *
+ * Results:
+ * TCL_OK is returned if all went well. Otherwise, TCL_ERROR is returned
+ * and the interp's result is set to contain an error message.
+ *
+ * Side effects:
+ * Slave windows get taken over by the grid.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+ConfigureSlaves(
+ Tcl_Interp *interp, /* Interpreter for error reporting. */
+ Tk_Window tkwin, /* Any window in application containing
+ * slaves. Used to look up slave names. */
+ int objc, /* Number of elements in argv. */
+ Tcl_Obj *const objv[]) /* Argument objects: contains one or more
+ * window names followed by any number of
+ * "option value" pairs. Caller must make sure
+ * that there is at least one window name. */
+{
+ Gridder *masterPtr = NULL;
+ Gridder *slavePtr;
+ Tk_Window other, slave, parent, ancestor;
+ int i, j, tmp;
+ int numWindows;
+ int width;
+ int defaultRow = -1;
+ int defaultColumn = 0; /* Default column number */
+ int defaultColumnSpan = 1; /* Default number of columns */
+ const char *lastWindow; /* Use this window to base current row/col
+ * on */
+ int numSkip; /* Number of 'x' found */
+ static const char *const optionStrings[] = {
+ "-column", "-columnspan", "-in", "-ipadx", "-ipady",
+ "-padx", "-pady", "-row", "-rowspan", "-sticky", NULL
+ };
+ enum options {
+ CONF_COLUMN, CONF_COLUMNSPAN, CONF_IN, CONF_IPADX, CONF_IPADY,
+ CONF_PADX, CONF_PADY, CONF_ROW, CONF_ROWSPAN, CONF_STICKY };
+ int index;
+ const char *string;
+ char firstChar;
+ int positionGiven;
+
+ /*
+ * Count the number of windows, or window short-cuts.
+ */
+
+ firstChar = 0;
+ for (numWindows=0, i=0; i < objc; i++) {
+ int length;
+ char prevChar = firstChar;
+
+ string = Tcl_GetStringFromObj(objv[i], &length);
+ firstChar = string[0];
+
+ if (firstChar == '.') {
+ /*
+ * Check that windows are valid, and locate the first slave's
+ * parent window (default for -in).
+ */
+
+ if (TkGetWindowFromObj(interp, tkwin, objv[i], &slave) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (masterPtr == NULL) {
+ /*
+ * Is there any saved -in from a removed slave?
+ * If there is, it becomes default for -in.
+ * If the stored master does not exist, just ignore it.
+ */
+
+ struct Gridder *slavePtr = GetGrid(slave);
+ if (slavePtr->in != NULL) {
+ if (TkGetWindowFromObj(interp, slave, slavePtr->in, &parent)
+ == TCL_OK) {
+ masterPtr = GetGrid(parent);
+ InitMasterData(masterPtr);
+ }
+ }
+ }
+ if (masterPtr == NULL) {
+ parent = Tk_Parent(slave);
+ if (parent != NULL) {
+ masterPtr = GetGrid(parent);
+ InitMasterData(masterPtr);
+ }
+ }
+ numWindows++;
+ continue;
+ }
+ if (length > 1 && i == 0) {
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "bad argument \"%s\": must be name of window", string));
+ Tcl_SetErrorCode(interp, "TK", "GRID", "BAD_PARAMETER", NULL);
+ return TCL_ERROR;
+ }
+ if (length > 1 && firstChar == '-') {
+ break;
+ }
+ if (length > 1) {
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "unexpected parameter \"%s\" in configure list:"
+ " should be window name or option", string));
+ Tcl_SetErrorCode(interp, "TK", "GRID", "BAD_PARAMETER", NULL);
+ return TCL_ERROR;
+ }
+
+ if ((firstChar == REL_HORIZ) && ((numWindows == 0) ||
+ (prevChar == REL_SKIP) || (prevChar == REL_VERT))) {
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "must specify window before shortcut '-'", -1));
+ Tcl_SetErrorCode(interp, "TK", "GRID", "SHORTCUT_USAGE", NULL);
+ return TCL_ERROR;
+ }
+
+ if ((firstChar == REL_VERT) || (firstChar == REL_SKIP)
+ || (firstChar == REL_HORIZ)) {
+ continue;
+ }
+
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "invalid window shortcut, \"%s\" should be '-', 'x', or '^'",
+ string));
+ Tcl_SetErrorCode(interp, "TK", "GRID", "SHORTCUT_USAGE", NULL);
+ return TCL_ERROR;
+ }
+ numWindows = i;
+
+ if ((objc - numWindows) & 1) {
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "extra option or option with no value", -1));
+ Tcl_SetErrorCode(interp, "TK", "GRID", "BAD_PARAMETER", NULL);
+ return TCL_ERROR;
+ }
+
+ /*
+ * Go through all options looking for -in and -row, which are needed to be
+ * found first to handle the special case where ^ is used on a row without
+ * windows names, but with an -in option. Since all options are checked
+ * here, we do not need to handle the error case again later.
+ */
+
+ for (i = numWindows; i < objc; i += 2) {
+ if (Tcl_GetIndexFromObjStruct(interp, objv[i], optionStrings,
+ sizeof(char *), "option", 0, &index) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (index == CONF_IN) {
+ if (TkGetWindowFromObj(interp, tkwin, objv[i+1], &other) !=
+ TCL_OK) {
+ return TCL_ERROR;
+ }
+ masterPtr = GetGrid(other);
+ InitMasterData(masterPtr);
+ } else if (index == CONF_ROW) {
+ if (Tcl_GetIntFromObj(interp, objv[i+1], &tmp) != TCL_OK
+ || tmp < 0) {
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "bad row value \"%s\": must be a non-negative integer",
+ Tcl_GetString(objv[i+1])));
+ Tcl_SetErrorCode(interp, "TK", "VALUE", "POSITIVE_INT", NULL);
+ return TCL_ERROR;
+ }
+ defaultRow = tmp;
+ }
+ }
+
+ /*
+ * If no -row is given, use the first unoccupied row of the master.
+ */
+
+ if (defaultRow < 0) {
+ if (masterPtr != NULL && masterPtr->masterDataPtr != NULL) {
+ SetGridSize(masterPtr);
+ defaultRow = masterPtr->masterDataPtr->rowEnd;
+ } else {
+ defaultRow = 0;
+ }
+ }
+
+ /*
+ * Iterate over all of the slave windows and short-cuts, parsing options
+ * for each slave. It's a bit wasteful to re-parse the options for each
+ * slave, but things get too messy if we try to parse the arguments just
+ * once at the beginning. For example, if a slave already is managed we
+ * want to just change a few existing values without resetting everything.
+ * If there are multiple windows, the -in option only gets processed for
+ * the first window.
+ */
+
+ positionGiven = 0;
+ for (j = 0; j < numWindows; j++) {
+ string = Tcl_GetString(objv[j]);
+ firstChar = string[0];
+
+ /*
+ * '^' and 'x' cause us to skip a column. '-' is processed as part of
+ * its preceeding slave.
+ */
+
+ if ((firstChar == REL_VERT) || (firstChar == REL_SKIP)) {
+ defaultColumn++;
+ continue;
+ }
+ if (firstChar == REL_HORIZ) {
+ continue;
+ }
+
+ for (defaultColumnSpan = 1; j + defaultColumnSpan < numWindows;
+ defaultColumnSpan++) {
+ const char *string = Tcl_GetString(objv[j + defaultColumnSpan]);
+
+ if (*string != REL_HORIZ) {
+ break;
+ }
+ }
+
+ if (TkGetWindowFromObj(interp, tkwin, objv[j], &slave) != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ if (Tk_TopWinHierarchy(slave)) {
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "can't manage \"%s\": it's a top-level window",
+ Tcl_GetString(objv[j])));
+ Tcl_SetErrorCode(interp, "TK", "GEOMETRY", "TOPLEVEL", NULL);
+ return TCL_ERROR;
+ }
+ slavePtr = GetGrid(slave);
+
+ /*
+ * The following statement is taken from tkPack.c:
+ *
+ * "If the slave isn't currently managed, reset all of its
+ * configuration information to default values (there could be old
+ * values left from a previous packer)."
+ *
+ * I [D.S.] disagree with this statement. If a slave is disabled
+ * (using "forget") and then re-enabled, I submit that 90% of the time
+ * the programmer will want it to retain its old configuration
+ * information. If the programmer doesn't want this behavior, then the
+ * defaults can be reestablished by hand, without having to worry
+ * about keeping track of the old state.
+ */
+
+ for (i = numWindows; i < objc; i += 2) {
+ Tcl_GetIndexFromObjStruct(interp, objv[i], optionStrings,
+ sizeof(char *), "option", 0, &index);
+ switch ((enum options) index) {
+ case CONF_COLUMN:
+ if (Tcl_GetIntFromObj(NULL, objv[i+1], &tmp) != TCL_OK
+ || tmp < 0) {
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "bad column value \"%s\": must be a non-negative integer",
+ Tcl_GetString(objv[i+1])));
+ Tcl_SetErrorCode(interp, "TK", "VALUE", "COLUMN", NULL);
+ return TCL_ERROR;
+ }
+ if (SetSlaveColumn(interp, slavePtr, tmp, -1) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ break;
+ case CONF_COLUMNSPAN:
+ if (Tcl_GetIntFromObj(NULL, objv[i+1], &tmp) != TCL_OK
+ || tmp <= 0) {
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "bad columnspan value \"%s\": must be a positive integer",
+ Tcl_GetString(objv[i+1])));
+ Tcl_SetErrorCode(interp, "TK", "VALUE", "SPAN", NULL);
+ return TCL_ERROR;
+ }
+ if (SetSlaveColumn(interp, slavePtr, -1, tmp) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ break;
+ case CONF_IN:
+ if (TkGetWindowFromObj(interp, tkwin, objv[i+1],
+ &other) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (other == slave) {
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "window can't be managed in itself", -1));
+ Tcl_SetErrorCode(interp, "TK", "GEOMETRY", "SELF", NULL);
+ return TCL_ERROR;
+ }
+ positionGiven = 1;
+ masterPtr = GetGrid(other);
+ InitMasterData(masterPtr);
+ break;
+ case CONF_STICKY: {
+ int sticky = StringToSticky(Tcl_GetString(objv[i+1]));
+
+ if (sticky == -1) {
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "bad stickyness value \"%s\": must be"
+ " a string containing n, e, s, and/or w",
+ Tcl_GetString(objv[i+1])));
+ Tcl_SetErrorCode(interp, "TK", "VALUE", "STICKY", NULL);
+ return TCL_ERROR;
+ }
+ slavePtr->sticky = sticky;
+ break;
+ }
+ case CONF_IPADX:
+ if ((Tk_GetPixelsFromObj(NULL, slave, objv[i+1],
+ &tmp) != TCL_OK) || (tmp < 0)) {
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "bad ipadx value \"%s\": must be positive screen distance",
+ Tcl_GetString(objv[i+1])));
+ Tcl_SetErrorCode(interp, "TK", "VALUE", "INT_PAD", NULL);
+ return TCL_ERROR;
+ }
+ slavePtr->iPadX = tmp * 2;
+ break;
+ case CONF_IPADY:
+ if ((Tk_GetPixelsFromObj(NULL, slave, objv[i+1],
+ &tmp) != TCL_OK) || (tmp < 0)) {
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "bad ipady value \"%s\": must be positive screen distance",
+ Tcl_GetString(objv[i+1])));
+ Tcl_SetErrorCode(interp, "TK", "VALUE", "INT_PAD", NULL);
+ return TCL_ERROR;
+ }
+ slavePtr->iPadY = tmp * 2;
+ break;
+ case CONF_PADX:
+ if (TkParsePadAmount(interp, tkwin, objv[i+1],
+ &slavePtr->padLeft, &slavePtr->padX) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ break;
+ case CONF_PADY:
+ if (TkParsePadAmount(interp, tkwin, objv[i+1],
+ &slavePtr->padTop, &slavePtr->padY) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ break;
+ case CONF_ROW:
+ if (Tcl_GetIntFromObj(NULL, objv[i+1], &tmp) != TCL_OK
+ || tmp < 0) {
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "bad row value \"%s\": must be a non-negative integer",
+ Tcl_GetString(objv[i+1])));
+ Tcl_SetErrorCode(interp, "TK", "VALUE", "COLUMN", NULL);
+ return TCL_ERROR;
+ }
+ if (SetSlaveRow(interp, slavePtr, tmp, -1) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ break;
+ case CONF_ROWSPAN:
+ if ((Tcl_GetIntFromObj(NULL, objv[i+1], &tmp) != TCL_OK)
+ || tmp <= 0) {
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "bad rowspan value \"%s\": must be a positive integer",
+ Tcl_GetString(objv[i+1])));
+ Tcl_SetErrorCode(interp, "TK", "VALUE", "SPAN", NULL);
+ return TCL_ERROR;
+ }
+ if (SetSlaveRow(interp, slavePtr, -1, tmp) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ break;
+ }
+ }
+
+ /*
+ * If no position was specified via -in and the slave is already
+ * packed, then leave it in its current location.
+ */
+
+ if (!positionGiven && (slavePtr->masterPtr != NULL)) {
+ masterPtr = slavePtr->masterPtr;
+ goto scheduleLayout;
+ }
+
+ /*
+ * If the same -in window is passed in again, then just leave it in
+ * its current location.
+ */
+
+ if (positionGiven && (masterPtr == slavePtr->masterPtr)) {
+ goto scheduleLayout;
+ }
+
+ /*
+ * Make sure we have a geometry master. We look at:
+ * 1) the -in flag
+ * 2) the parent of the first slave.
+ */
+
+ parent = Tk_Parent(slave);
+ if (masterPtr == NULL) {
+ masterPtr = GetGrid(parent);
+ InitMasterData(masterPtr);
+ }
+
+ if (slavePtr->masterPtr != NULL && slavePtr->masterPtr != masterPtr) {
+ Unlink(slavePtr);
+ slavePtr->masterPtr = NULL;
+ }
+
+ if (slavePtr->masterPtr == NULL) {
+ Gridder *tempPtr = masterPtr->slavePtr;
+
+ slavePtr->masterPtr = masterPtr;
+ masterPtr->slavePtr = slavePtr;
+ slavePtr->nextPtr = tempPtr;
+ }
+
+ /*
+ * Make sure that the slave's parent is either the master or an
+ * ancestor of the master, and that the master and slave aren't the
+ * same.
+ */
+
+ for (ancestor = masterPtr->tkwin; ; ancestor = Tk_Parent(ancestor)) {
+ if (ancestor == parent) {
+ break;
+ }
+ if (Tk_TopWinHierarchy(ancestor)) {
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "can't put %s inside %s", Tcl_GetString(objv[j]),
+ Tk_PathName(masterPtr->tkwin)));
+ Tcl_SetErrorCode(interp, "TK", "GEOMETRY", "HIERARCHY", NULL);
+ Unlink(slavePtr);
+ return TCL_ERROR;
+ }
+ }
+
+ /*
+ * Try to make sure our master isn't managed by us.
+ */
+
+ if (masterPtr->masterPtr == slavePtr) {
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "can't put %s inside %s, would cause management loop",
+ Tcl_GetString(objv[j]), Tk_PathName(masterPtr->tkwin)));
+ Tcl_SetErrorCode(interp, "TK", "GEOMETRY", "LOOP", NULL);
+ Unlink(slavePtr);
+ return TCL_ERROR;
+ }
+
+ Tk_ManageGeometry(slave, &gridMgrType, slavePtr);
+
+ if (!(masterPtr->flags & DONT_PROPAGATE)) {
+ if (TkSetGeometryMaster(interp, masterPtr->tkwin, "grid")
+ != TCL_OK) {
+ Tk_ManageGeometry(slave, NULL, NULL);
+ Unlink(slavePtr);
+ return TCL_ERROR;
+ }
+ masterPtr->flags |= ALLOCED_MASTER;
+ }
+
+ /*
+ * Assign default position information.
+ */
+
+ if (slavePtr->column == -1) {
+ if (SetSlaveColumn(interp, slavePtr, defaultColumn,-1) != TCL_OK){
+ return TCL_ERROR;
+ }
+ }
+ if (SetSlaveColumn(interp, slavePtr, -1,
+ slavePtr->numCols + defaultColumnSpan - 1) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (slavePtr->row == -1) {
+ if (SetSlaveRow(interp, slavePtr, defaultRow, -1) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ }
+ defaultColumn += slavePtr->numCols;
+ defaultColumnSpan = 1;
+
+ /*
+ * Arrange for the master to be re-arranged at the first idle moment.
+ */
+
+ scheduleLayout:
+ if (masterPtr->abortPtr != NULL) {
+ *masterPtr->abortPtr = 1;
+ }
+ if (!(masterPtr->flags & REQUESTED_RELAYOUT)) {
+ masterPtr->flags |= REQUESTED_RELAYOUT;
+ Tcl_DoWhenIdle(ArrangeGrid, masterPtr);
+ }
+ }
+
+ /*
+ * Now look for all the "^"'s.
+ */
+
+ lastWindow = NULL;
+ numSkip = 0;
+ for (j = 0; j < numWindows; j++) {
+ struct Gridder *otherPtr;
+ int match; /* Found a match for the ^ */
+ int lastRow, lastColumn; /* Implied end of table. */
+
+ string = Tcl_GetString(objv[j]);
+ firstChar = string[0];
+
+ if (firstChar == '.') {
+ lastWindow = string;
+ numSkip = 0;
+ }
+ if (firstChar == REL_SKIP) {
+ numSkip++;
+ }
+ if (firstChar != REL_VERT) {
+ continue;
+ }
+
+ if (masterPtr == NULL) {
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "can't use '^', cant find master", -1));
+ Tcl_SetErrorCode(interp, "TK", "GRID", "SHORTCUT_USAGE", NULL);
+ return TCL_ERROR;
+ }
+
+ /*
+ * Count the number of consecutive ^'s starting from this position.
+ */
+
+ for (width = 1; width + j < numWindows; width++) {
+ const char *string = Tcl_GetString(objv[j+width]);
+
+ if (*string != REL_VERT) {
+ break;
+ }
+ }
+
+ /*
+ * Find the implied grid location of the ^
+ */
+
+ if (lastWindow == NULL) {
+ lastRow = defaultRow - 1;
+ lastColumn = 0;
+ } else {
+ other = Tk_NameToWindow(interp, lastWindow, tkwin);
+ otherPtr = GetGrid(other);
+ lastRow = otherPtr->row + otherPtr->numRows - 2;
+ lastColumn = otherPtr->column + otherPtr->numCols;
+ }
+
+ lastColumn += numSkip;
+
+ match = 0;
+ for (slavePtr = masterPtr->slavePtr; slavePtr != NULL;
+ slavePtr = slavePtr->nextPtr) {
+
+ if (slavePtr->column == lastColumn
+ && slavePtr->row + slavePtr->numRows - 1 == lastRow) {
+ if (slavePtr->numCols <= width) {
+ if (SetSlaveRow(interp, slavePtr, -1,
+ slavePtr->numRows + 1) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ match++;
+ j += slavePtr->numCols - 1;
+ lastWindow = Tk_PathName(slavePtr->tkwin);
+ numSkip = 0;
+ break;
+ }
+ }
+ }
+ if (!match) {
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "can't find slave to extend with \"^\"", -1));
+ Tcl_SetErrorCode(interp, "TK", "GRID", "SHORTCUT_USAGE", NULL);
+ return TCL_ERROR;
+ }
+ }
+
+ if (masterPtr == NULL) {
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "can't determine master window", -1));
+ Tcl_SetErrorCode(interp, "TK", "GRID", "SHORTCUT_USAGE", NULL);
+ return TCL_ERROR;
+ }
+ SetGridSize(masterPtr);
+
+ /*
+ * If we have emptied this master from slaves it means we are no longer
+ * handling it and should mark it as free.
+ */
+
+ if (masterPtr->slavePtr == NULL && masterPtr->flags & ALLOCED_MASTER) {
+ TkFreeGeometryMaster(masterPtr->tkwin, "grid");
+ masterPtr->flags &= ~ALLOCED_MASTER;
+ }
+
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * StickyToObj
+ *
+ * Converts the internal boolean combination of "sticky" bits onto a Tcl
+ * list element containing zero or more of n, s, e, or w.
+ *
+ * Results:
+ * A new object is returned that holds the sticky representation.
+ *
+ * Side effects:
+ * none.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static Tcl_Obj *
+StickyToObj(
+ int flags) /* The sticky flags. */
+{
+ int count = 0;
+ char buffer[4];
+
+ if (flags & STICK_NORTH) {
+ buffer[count++] = 'n';
+ }
+ if (flags & STICK_EAST) {
+ buffer[count++] = 'e';
+ }
+ if (flags & STICK_SOUTH) {
+ buffer[count++] = 's';
+ }
+ if (flags & STICK_WEST) {
+ buffer[count++] = 'w';
+ }
+ return Tcl_NewStringObj(buffer, count);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * StringToSticky --
+ *
+ * Converts an ascii string representing a widgets stickyness into the
+ * boolean result.
+ *
+ * Results:
+ * The boolean combination of the "sticky" bits is retuned. If an error
+ * occurs, such as an invalid character, -1 is returned instead.
+ *
+ * Side effects:
+ * none
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+StringToSticky(
+ const char *string)
+{
+ int sticky = 0;
+ char c;
+
+ while ((c = *string++) != '\0') {
+ switch (c) {
+ case 'n': case 'N':
+ sticky |= STICK_NORTH;
+ break;
+ case 'e': case 'E':
+ sticky |= STICK_EAST;
+ break;
+ case 's': case 'S':
+ sticky |= STICK_SOUTH;
+ break;
+ case 'w': case 'W':
+ sticky |= STICK_WEST;
+ break;
+ case ' ': case ',': case '\t': case '\r': case '\n':
+ break;
+ default:
+ return -1;
+ }
+ }
+ return sticky;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * NewPairObj --
+ *
+ * Creates a new list object and fills it with two integer objects.
+ *
+ * Results:
+ * The newly created list object is returned.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static Tcl_Obj *
+NewPairObj(
+ int val1, int val2)
+{
+ Tcl_Obj *ary[2];
+
+ ary[0] = Tcl_NewIntObj(val1);
+ ary[1] = Tcl_NewIntObj(val2);
+ return Tcl_NewListObj(2, ary);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * NewQuadObj --
+ *
+ * Creates a new list object and fills it with four integer objects.
+ *
+ * Results:
+ * The newly created list object is returned.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static Tcl_Obj *
+NewQuadObj(
+ int val1, int val2, int val3, int val4)
+{
+ Tcl_Obj *ary[4];
+
+ ary[0] = Tcl_NewIntObj(val1);
+ ary[1] = Tcl_NewIntObj(val2);
+ ary[2] = Tcl_NewIntObj(val3);
+ ary[3] = Tcl_NewIntObj(val4);
+ return Tcl_NewListObj(4, ary);
+}
+
+/*
+ * Local Variables:
+ * mode: c
+ * c-basic-offset: 4
+ * fill-column: 78
+ * End:
+ */
diff --git a/tk8.6/generic/tkImage.c b/tk8.6/generic/tkImage.c
new file mode 100644
index 0000000..359d6c6
--- /dev/null
+++ b/tk8.6/generic/tkImage.c
@@ -0,0 +1,1142 @@
+/*
+ * tkImage.c --
+ *
+ * This module implements the image protocol, which allows lots of
+ * different kinds of images to be used in lots of different widgets.
+ *
+ * Copyright (c) 1994 The Regents of the University of California.
+ * Copyright (c) 1994-1997 Sun Microsystems, Inc.
+ *
+ * See the file "license.terms" for information on usage and redistribution of
+ * this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ */
+
+#include "tkInt.h"
+
+/*
+ * Each call to Tk_GetImage returns a pointer to one of the following
+ * structures, which is used as a token by clients (widgets) that display
+ * images.
+ */
+
+typedef struct Image {
+ Tk_Window tkwin; /* Window passed to Tk_GetImage (needed to
+ * "re-get" the image later if the manager
+ * changes). */
+ Display *display; /* Display for tkwin. Needed because when the
+ * image is eventually freed tkwin may not
+ * exist anymore. */
+ struct ImageMaster *masterPtr;
+ /* Master for this image (identifiers image
+ * manager, for example). */
+ ClientData instanceData; /* One word argument to pass to image manager
+ * when dealing with this image instance. */
+ Tk_ImageChangedProc *changeProc;
+ /* Code in widget to call when image changes
+ * in a way that affects redisplay. */
+ ClientData widgetClientData;/* Argument to pass to changeProc. */
+ struct Image *nextPtr; /* Next in list of all image instances
+ * associated with the same name. */
+} Image;
+
+/*
+ * For each image master there is one of the following structures, which
+ * represents a name in the image table and all of the images instantiated
+ * from it. Entries in mainPtr->imageTable point to these structures.
+ */
+
+typedef struct ImageMaster {
+ Tk_ImageType *typePtr; /* Information about image type. NULL means
+ * that no image manager owns this image: the
+ * image was deleted. */
+ ClientData masterData; /* One-word argument to pass to image mgr when
+ * dealing with the master, as opposed to
+ * instances. */
+ int width, height; /* Last known dimensions for image. */
+ Tcl_HashTable *tablePtr; /* Pointer to hash table containing image (the
+ * imageTable field in some TkMainInfo
+ * structure). */
+ Tcl_HashEntry *hPtr; /* Hash entry in mainPtr->imageTable for this
+ * structure (used to delete the hash
+ * entry). */
+ Image *instancePtr; /* Pointer to first in list of instances
+ * derived from this name. */
+ int deleted; /* Flag set when image is being deleted. */
+ TkWindow *winPtr; /* Main window of interpreter (used to detect
+ * when the world is falling apart.) */
+} ImageMaster;
+
+typedef struct ThreadSpecificData {
+ Tk_ImageType *imageTypeList;/* First in a list of all known image
+ * types. */
+ Tk_ImageType *oldImageTypeList;
+ /* First in a list of all known old-style
+ * image types. */
+ int initialized; /* Set to 1 if we've initialized the
+ * structure. */
+} ThreadSpecificData;
+static Tcl_ThreadDataKey dataKey;
+
+/*
+ * Prototypes for local functions:
+ */
+
+static void ImageTypeThreadExitProc(ClientData clientData);
+static void DeleteImage(ImageMaster *masterPtr);
+static void EventuallyDeleteImage(ImageMaster *masterPtr,
+ int forgetImageHashNow);
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ImageTypeThreadExitProc --
+ *
+ * Clean up the registered list of image types.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The thread's linked lists of photo image formats is deleted.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+ImageTypeThreadExitProc(
+ ClientData clientData) /* not used */
+{
+ Tk_ImageType *freePtr;
+ ThreadSpecificData *tsdPtr =
+ Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
+
+ while (tsdPtr->oldImageTypeList != NULL) {
+ freePtr = tsdPtr->oldImageTypeList;
+ tsdPtr->oldImageTypeList = tsdPtr->oldImageTypeList->nextPtr;
+ ckfree(freePtr);
+ }
+ while (tsdPtr->imageTypeList != NULL) {
+ freePtr = tsdPtr->imageTypeList;
+ tsdPtr->imageTypeList = tsdPtr->imageTypeList->nextPtr;
+ ckfree(freePtr);
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_CreateOldImageType, Tk_CreateImageType --
+ *
+ * This function is invoked by an image manager to tell Tk about a new
+ * kind of image and the functions that manage the new type. The function
+ * is typically invoked during Tcl_AppInit.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The new image type is entered into a table used in the "image create"
+ * command.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tk_CreateOldImageType(
+ const Tk_ImageType *typePtr)
+ /* Structure describing the type. All of the
+ * fields except "nextPtr" must be filled in
+ * by caller. */
+{
+ Tk_ImageType *copyPtr;
+ ThreadSpecificData *tsdPtr =
+ Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
+
+ if (!tsdPtr->initialized) {
+ tsdPtr->initialized = 1;
+ Tcl_CreateThreadExitHandler(ImageTypeThreadExitProc, NULL);
+ }
+ copyPtr = ckalloc(sizeof(Tk_ImageType));
+ *copyPtr = *typePtr;
+ copyPtr->nextPtr = tsdPtr->oldImageTypeList;
+ tsdPtr->oldImageTypeList = copyPtr;
+}
+
+void
+Tk_CreateImageType(
+ const Tk_ImageType *typePtr)
+ /* Structure describing the type. All of the
+ * fields except "nextPtr" must be filled in
+ * by caller. */
+{
+ Tk_ImageType *copyPtr;
+ ThreadSpecificData *tsdPtr =
+ Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
+
+ if (!tsdPtr->initialized) {
+ tsdPtr->initialized = 1;
+ Tcl_CreateThreadExitHandler(ImageTypeThreadExitProc, NULL);
+ }
+ copyPtr = ckalloc(sizeof(Tk_ImageType));
+ *copyPtr = *typePtr;
+ copyPtr->nextPtr = tsdPtr->imageTypeList;
+ tsdPtr->imageTypeList = copyPtr;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_ImageObjCmd --
+ *
+ * This function is invoked to process the "image" Tcl command. See the
+ * user documentation for details on what it does.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * See the user documentation.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tk_ImageObjCmd(
+ ClientData clientData, /* Main window associated with interpreter. */
+ Tcl_Interp *interp, /* Current interpreter. */
+ int objc, /* Number of arguments. */
+ Tcl_Obj *const objv[]) /* Argument strings. */
+{
+ static const char *const imageOptions[] = {
+ "create", "delete", "height", "inuse", "names", "type", "types",
+ "width", NULL
+ };
+ enum options {
+ IMAGE_CREATE, IMAGE_DELETE, IMAGE_HEIGHT, IMAGE_INUSE, IMAGE_NAMES,
+ IMAGE_TYPE, IMAGE_TYPES, IMAGE_WIDTH
+ };
+ TkWindow *winPtr = clientData;
+ int i, isNew, firstOption, index;
+ Tk_ImageType *typePtr;
+ ImageMaster *masterPtr;
+ Image *imagePtr;
+ Tcl_HashEntry *hPtr;
+ Tcl_HashSearch search;
+ char idString[16 + TCL_INTEGER_SPACE];
+ TkDisplay *dispPtr = winPtr->dispPtr;
+ const char *arg, *name;
+ Tcl_Obj *resultObj;
+ ThreadSpecificData *tsdPtr =
+ Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
+
+ if (objc < 2) {
+ Tcl_WrongNumArgs(interp, 1, objv, "option ?args?");
+ return TCL_ERROR;
+ }
+
+ if (Tcl_GetIndexFromObjStruct(interp, objv[1], imageOptions,
+ sizeof(char *), "option", 0, &index) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ switch ((enum options) index) {
+ case IMAGE_CREATE: {
+ Tcl_Obj **args;
+ int oldimage = 0;
+
+ if (objc < 3) {
+ Tcl_WrongNumArgs(interp, 2, objv,
+ "type ?name? ?-option value ...?");
+ return TCL_ERROR;
+ }
+
+ /*
+ * Look up the image type.
+ */
+
+ arg = Tcl_GetString(objv[2]);
+ for (typePtr = tsdPtr->imageTypeList; typePtr != NULL;
+ typePtr = typePtr->nextPtr) {
+ if ((*arg == typePtr->name[0])
+ && (strcmp(arg, typePtr->name) == 0)) {
+ break;
+ }
+ }
+ if (typePtr == NULL) {
+ oldimage = 1;
+ for (typePtr = tsdPtr->oldImageTypeList; typePtr != NULL;
+ typePtr = typePtr->nextPtr) {
+ if ((*arg == typePtr->name[0])
+ && (strcmp(arg, typePtr->name) == 0)) {
+ break;
+ }
+ }
+ }
+ if (typePtr == NULL) {
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "image type \"%s\" doesn't exist", arg));
+ Tcl_SetErrorCode(interp, "TK", "LOOKUP", "IMAGE_TYPE", arg, NULL);
+ return TCL_ERROR;
+ }
+
+ /*
+ * Figure out a name to use for the new image.
+ */
+
+ if ((objc == 3) || (*(arg = Tcl_GetString(objv[3])) == '-')) {
+ do {
+ dispPtr->imageId++;
+ sprintf(idString, "image%d", dispPtr->imageId);
+ name = idString;
+ } while (Tcl_FindCommand(interp, name, NULL, 0) != NULL);
+ firstOption = 3;
+ } else {
+ TkWindow *topWin;
+
+ name = arg;
+ firstOption = 4;
+
+ /*
+ * Need to check if the _command_ that we are about to create is
+ * the name of the current master widget command (normally "." but
+ * could have been renamed) and fail in that case before a really
+ * nasty and hard to stop crash happens.
+ */
+
+ topWin = (TkWindow *) TkToplevelWindowForCommand(interp, name);
+ if (topWin != NULL && winPtr->mainPtr->winPtr == topWin) {
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "images may not be named the same as the main window",
+ -1));
+ Tcl_SetErrorCode(interp, "TK", "IMAGE", "SMASH_MAIN", NULL);
+ return TCL_ERROR;
+ }
+ }
+
+ /*
+ * Create the data structure for the new image.
+ */
+
+ hPtr = Tcl_CreateHashEntry(&winPtr->mainPtr->imageTable, name, &isNew);
+ if (isNew) {
+ masterPtr = ckalloc(sizeof(ImageMaster));
+ masterPtr->typePtr = NULL;
+ masterPtr->masterData = NULL;
+ masterPtr->width = masterPtr->height = 1;
+ masterPtr->tablePtr = &winPtr->mainPtr->imageTable;
+ masterPtr->hPtr = hPtr;
+ masterPtr->instancePtr = NULL;
+ masterPtr->deleted = 0;
+ masterPtr->winPtr = winPtr->mainPtr->winPtr;
+ Tcl_Preserve(masterPtr->winPtr);
+ Tcl_SetHashValue(hPtr, masterPtr);
+ } else {
+ /*
+ * An image already exists by this name. Disconnect the instances
+ * from the master.
+ */
+
+ masterPtr = 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;
+ }
+ masterPtr->deleted = 0;
+ }
+
+ /*
+ * Call the image type manager so that it can perform its own
+ * initialization, then re-"get" for any existing instances of the
+ * image.
+ */
+
+ objv += firstOption;
+ objc -= firstOption;
+ args = (Tcl_Obj **) objv;
+ if (oldimage) {
+ int i;
+
+ args = ckalloc((objc+1) * sizeof(char *));
+ for (i = 0; i < objc; i++) {
+ args[i] = (Tcl_Obj *) Tcl_GetString(objv[i]);
+ }
+ args[objc] = NULL;
+ }
+ Tcl_Preserve(masterPtr);
+ if (typePtr->createProc(interp, name, objc, args, typePtr,
+ (Tk_ImageMaster)masterPtr, &masterPtr->masterData) != TCL_OK){
+ EventuallyDeleteImage(masterPtr, 0);
+ Tcl_Release(masterPtr);
+ if (oldimage) {
+ ckfree(args);
+ }
+ return TCL_ERROR;
+ }
+ Tcl_Release(masterPtr);
+ if (oldimage) {
+ ckfree(args);
+ }
+ masterPtr->typePtr = typePtr;
+ for (imagePtr = masterPtr->instancePtr; imagePtr != NULL;
+ imagePtr = imagePtr->nextPtr) {
+ imagePtr->instanceData = typePtr->getProc(imagePtr->tkwin,
+ masterPtr->masterData);
+ }
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ Tcl_GetHashKey(&winPtr->mainPtr->imageTable, hPtr), -1));
+ break;
+ }
+ case IMAGE_DELETE:
+ for (i = 2; i < objc; i++) {
+ arg = Tcl_GetString(objv[i]);
+ hPtr = Tcl_FindHashEntry(&winPtr->mainPtr->imageTable, arg);
+ if (hPtr == NULL) {
+ goto alreadyDeleted;
+ }
+ masterPtr = Tcl_GetHashValue(hPtr);
+ if (masterPtr->deleted) {
+ goto alreadyDeleted;
+ }
+ DeleteImage(masterPtr);
+ }
+ break;
+ case IMAGE_NAMES:
+ if (objc != 2) {
+ Tcl_WrongNumArgs(interp, 2, objv, NULL);
+ return TCL_ERROR;
+ }
+ hPtr = Tcl_FirstHashEntry(&winPtr->mainPtr->imageTable, &search);
+ resultObj = Tcl_NewObj();
+ for ( ; hPtr != NULL; hPtr = Tcl_NextHashEntry(&search)) {
+ masterPtr = Tcl_GetHashValue(hPtr);
+ if (masterPtr->deleted) {
+ continue;
+ }
+ Tcl_ListObjAppendElement(NULL, resultObj, Tcl_NewStringObj(
+ Tcl_GetHashKey(&winPtr->mainPtr->imageTable, hPtr), -1));
+ }
+ Tcl_SetObjResult(interp, resultObj);
+ break;
+ case IMAGE_TYPES:
+ if (objc != 2) {
+ Tcl_WrongNumArgs(interp, 2, objv, NULL);
+ return TCL_ERROR;
+ }
+ resultObj = Tcl_NewObj();
+ for (typePtr = tsdPtr->imageTypeList; typePtr != NULL;
+ typePtr = typePtr->nextPtr) {
+ Tcl_ListObjAppendElement(NULL, resultObj, Tcl_NewStringObj(
+ typePtr->name, -1));
+ }
+ for (typePtr = tsdPtr->oldImageTypeList; typePtr != NULL;
+ typePtr = typePtr->nextPtr) {
+ Tcl_ListObjAppendElement(NULL, resultObj, Tcl_NewStringObj(
+ typePtr->name, -1));
+ }
+ Tcl_SetObjResult(interp, resultObj);
+ break;
+
+ case IMAGE_HEIGHT:
+ case IMAGE_INUSE:
+ case IMAGE_TYPE:
+ case IMAGE_WIDTH:
+ /*
+ * These operations all parse virtually identically. First check to
+ * see if three args are given. Then get a non-deleted master from the
+ * third 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) {
+ goto alreadyDeleted;
+ }
+ masterPtr = Tcl_GetHashValue(hPtr);
+ if (masterPtr->deleted) {
+ goto alreadyDeleted;
+ }
+
+ /*
+ * Now we read off the specific piece of data we were asked for.
+ */
+
+ switch ((enum options) index) {
+ case IMAGE_HEIGHT:
+ Tcl_SetObjResult(interp, Tcl_NewIntObj(masterPtr->height));
+ break;
+ case IMAGE_INUSE:
+ Tcl_SetObjResult(interp, Tcl_NewBooleanObj(
+ masterPtr->typePtr && masterPtr->instancePtr));
+ break;
+ case IMAGE_TYPE:
+ if (masterPtr->typePtr != NULL) {
+ Tcl_SetObjResult(interp,
+ Tcl_NewStringObj(masterPtr->typePtr->name, -1));
+ }
+ break;
+ case IMAGE_WIDTH:
+ Tcl_SetObjResult(interp, Tcl_NewIntObj(masterPtr->width));
+ break;
+ default:
+ Tcl_Panic("can't happen");
+ }
+ break;
+ }
+ return TCL_OK;
+
+ alreadyDeleted:
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf("image \"%s\" doesn't exist",arg));
+ Tcl_SetErrorCode(interp, "TK", "LOOKUP", "IMAGE", arg, NULL);
+ return TCL_ERROR;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_ImageChanged --
+ *
+ * This function is called by an image manager whenever something has
+ * happened that requires the image to be redrawn (some of its pixels
+ * have changed, or its size has changed).
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Any widgets that display the image are notified so that they can
+ * redisplay themselves as appropriate.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tk_ImageChanged(
+ Tk_ImageMaster imageMaster, /* Image that needs redisplay. */
+ int x, int y, /* Coordinates of upper-left pixel of region
+ * of image that needs to be redrawn. */
+ int width, int height, /* Dimensions (in pixels) of region of image
+ * to redraw. If either dimension is zero then
+ * the image doesn't need to be redrawn
+ * (perhaps all that happened is that its size
+ * changed). */
+ int imageWidth, int imageHeight)
+ /* New dimensions of image. */
+{
+ ImageMaster *masterPtr = (ImageMaster *) imageMaster;
+ Image *imagePtr;
+
+ masterPtr->width = imageWidth;
+ masterPtr->height = imageHeight;
+ for (imagePtr = masterPtr->instancePtr; imagePtr != NULL;
+ imagePtr = imagePtr->nextPtr) {
+ imagePtr->changeProc(imagePtr->widgetClientData, x, y, width, height,
+ imageWidth, imageHeight);
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_NameOfImage --
+ *
+ * Given a token for an image master, this function returns the name of
+ * the image.
+ *
+ * Results:
+ * The return value is the string name for imageMaster.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+const char *
+Tk_NameOfImage(
+ Tk_ImageMaster imageMaster) /* Token for image. */
+{
+ ImageMaster *masterPtr = (ImageMaster *) imageMaster;
+
+ if (masterPtr->hPtr == NULL) {
+ return NULL;
+ }
+ return Tcl_GetHashKey(masterPtr->tablePtr, masterPtr->hPtr);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_GetImage --
+ *
+ * This function is invoked by a widget when it wants to use a particular
+ * image in a particular window.
+ *
+ * Results:
+ * The return value is a token for the image. If there is no image by the
+ * given name, then NULL is returned and an error message is left in the
+ * interp's result.
+ *
+ * Side effects:
+ * Tk records the fact that the widget is using the image, and it will
+ * invoke changeProc later if the widget needs redisplay (i.e. its size
+ * changes or some of its pixels change). The caller must eventually
+ * invoke Tk_FreeImage when it no longer needs the image.
+ *
+ *----------------------------------------------------------------------
+ */
+
+Tk_Image
+Tk_GetImage(
+ Tcl_Interp *interp, /* Place to leave error message if image can't
+ * be found. */
+ Tk_Window tkwin, /* Token for window in which image will be
+ * used. */
+ const char *name, /* Name of desired image. */
+ Tk_ImageChangedProc *changeProc,
+ /* Function to invoke when redisplay is needed
+ * because image's pixels or size changed. */
+ ClientData clientData) /* One-word argument to pass to damageProc. */
+{
+ Tcl_HashEntry *hPtr;
+ ImageMaster *masterPtr;
+ Image *imagePtr;
+
+ hPtr = Tcl_FindHashEntry(&((TkWindow *) tkwin)->mainPtr->imageTable, name);
+ if (hPtr == NULL) {
+ goto noSuchImage;
+ }
+ masterPtr = Tcl_GetHashValue(hPtr);
+ if (masterPtr->typePtr == NULL) {
+ goto noSuchImage;
+ }
+ if (masterPtr->deleted) {
+ goto noSuchImage;
+ }
+ imagePtr = ckalloc(sizeof(Image));
+ imagePtr->tkwin = tkwin;
+ imagePtr->display = Tk_Display(tkwin);
+ imagePtr->masterPtr = masterPtr;
+ imagePtr->instanceData =
+ masterPtr->typePtr->getProc(tkwin, masterPtr->masterData);
+ imagePtr->changeProc = changeProc;
+ imagePtr->widgetClientData = clientData;
+ imagePtr->nextPtr = masterPtr->instancePtr;
+ masterPtr->instancePtr = imagePtr;
+ return (Tk_Image) imagePtr;
+
+ noSuchImage:
+ if (interp) {
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "image \"%s\" doesn't exist", name));
+ Tcl_SetErrorCode(interp, "TK", "LOOKUP", "IMAGE", name, NULL);
+ }
+ return NULL;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_FreeImage --
+ *
+ * This function is invoked by a widget when it no longer needs an image
+ * acquired by a previous call to Tk_GetImage. For each call to
+ * Tk_GetImage there must be exactly one call to Tk_FreeImage.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The association between the image and the widget is removed.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tk_FreeImage(
+ Tk_Image image) /* Token for image that is no longer needed by
+ * a widget. */
+{
+ Image *imagePtr = (Image *) image;
+ ImageMaster *masterPtr = imagePtr->masterPtr;
+ Image *prevPtr;
+
+ /*
+ * Clean up the particular instance.
+ */
+
+ if (masterPtr->typePtr != NULL) {
+ masterPtr->typePtr->freeProc(imagePtr->instanceData,
+ imagePtr->display);
+ }
+ prevPtr = masterPtr->instancePtr;
+ if (prevPtr == imagePtr) {
+ masterPtr->instancePtr = imagePtr->nextPtr;
+ } else {
+ while (prevPtr->nextPtr != imagePtr) {
+ prevPtr = prevPtr->nextPtr;
+ }
+ prevPtr->nextPtr = imagePtr->nextPtr;
+ }
+ ckfree(imagePtr);
+
+ /*
+ * If there are no more instances left for the master, and if the master
+ * image has been deleted, then delete the master too.
+ */
+
+ if ((masterPtr->typePtr == NULL) && (masterPtr->instancePtr == NULL)) {
+ if (masterPtr->hPtr != NULL) {
+ Tcl_DeleteHashEntry(masterPtr->hPtr);
+ }
+ Tcl_Release(masterPtr->winPtr);
+ ckfree(masterPtr);
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_PostscriptImage --
+ *
+ * This function 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(
+ Tk_Image image, /* Token for image to redisplay. */
+ Tcl_Interp *interp,
+ Tk_Window tkwin,
+ Tk_PostscriptInfo psinfo, /* postscript info */
+ int x, int y, /* Upper-left pixel of region in image that
+ * needs to be redisplayed. */
+ int width, int 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) width, (unsigned) 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) width, (unsigned) 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 function is called by widgets that contain images in order to
+ * redisplay an image on the screen or an off-screen pixmap.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The image's manager is notified, and it redraws the desired portion of
+ * the image before returning.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tk_RedrawImage(
+ Tk_Image image, /* Token for image to redisplay. */
+ int imageX, int imageY, /* Upper-left pixel of region in image that
+ * needs to be redisplayed. */
+ int width, int height, /* Dimensions of region to redraw. */
+ Drawable drawable, /* Drawable in which to display image (window
+ * or pixmap). If this is a pixmap, it must
+ * have the same depth as the window used in
+ * the Tk_GetImage call for the image. */
+ int drawableX, int drawableY)
+ /* Coordinates in drawable that correspond to
+ * imageX and imageY. */
+{
+ Image *imagePtr = (Image *) image;
+
+ if (imagePtr->masterPtr->typePtr == NULL) {
+ /*
+ * No master for image, so nothing to display.
+ */
+
+ return;
+ }
+
+ /*
+ * Clip the redraw area to the area of the image.
+ */
+
+ if (imageX < 0) {
+ width += imageX;
+ drawableX -= imageX;
+ imageX = 0;
+ }
+ if (imageY < 0) {
+ height += imageY;
+ drawableY -= imageY;
+ imageY = 0;
+ }
+ if ((imageX + width) > imagePtr->masterPtr->width) {
+ width = imagePtr->masterPtr->width - imageX;
+ }
+ if ((imageY + height) > imagePtr->masterPtr->height) {
+ height = imagePtr->masterPtr->height - imageY;
+ }
+ imagePtr->masterPtr->typePtr->displayProc(imagePtr->instanceData,
+ imagePtr->display, drawable, imageX, imageY, width, height,
+ drawableX, drawableY);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_SizeOfImage --
+ *
+ * This function returns the current dimensions of an image.
+ *
+ * Results:
+ * The width and height of the image are returned in *widthPtr and
+ * *heightPtr.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tk_SizeOfImage(
+ Tk_Image image, /* Token for image whose size is wanted. */
+ int *widthPtr, /* Return width of image here. */
+ int *heightPtr) /* Return height of image here. */
+{
+ Image *imagePtr = (Image *) image;
+
+ *widthPtr = imagePtr->masterPtr->width;
+ *heightPtr = imagePtr->masterPtr->height;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_DeleteImage --
+ *
+ * Given the name of an image, this function destroys the image.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The image is destroyed; existing instances will display as blank
+ * areas. If no such image exists then the function does nothing.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tk_DeleteImage(
+ Tcl_Interp *interp, /* Interpreter in which the image was
+ * created. */
+ const char *name) /* Name of image. */
+{
+ Tcl_HashEntry *hPtr;
+ TkWindow *winPtr;
+
+ winPtr = (TkWindow *) Tk_MainWindow(interp);
+ if (winPtr == NULL) {
+ return;
+ }
+ hPtr = Tcl_FindHashEntry(&winPtr->mainPtr->imageTable, name);
+ if (hPtr == NULL) {
+ return;
+ }
+ DeleteImage(Tcl_GetHashValue(hPtr));
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * DeleteImage --
+ *
+ * This function is responsible for deleting an image.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The connection is dropped between instances of this image and an image
+ * master. Image instances will redisplay themselves as empty areas, but
+ * existing instances will not be deleted.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+DeleteImage(
+ ImageMaster *masterPtr) /* Pointer to main data structure for image. */
+{
+ Image *imagePtr;
+ Tk_ImageType *typePtr;
+
+ typePtr = masterPtr->typePtr;
+ masterPtr->typePtr = NULL;
+ if (typePtr != NULL) {
+ for (imagePtr = masterPtr->instancePtr; imagePtr != NULL;
+ imagePtr = imagePtr->nextPtr) {
+ typePtr->freeProc(imagePtr->instanceData, imagePtr->display);
+ imagePtr->changeProc(imagePtr->widgetClientData, 0, 0,
+ masterPtr->width, masterPtr->height, masterPtr->width,
+ masterPtr->height);
+ }
+ typePtr->deleteProc(masterPtr->masterData);
+ }
+ if (masterPtr->instancePtr == NULL) {
+ if (masterPtr->hPtr != NULL) {
+ Tcl_DeleteHashEntry(masterPtr->hPtr);
+ }
+ Tcl_Release(masterPtr->winPtr);
+ ckfree(masterPtr);
+ } else {
+ masterPtr->deleted = 1;
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * EventuallyDeleteImage --
+ *
+ * Arrange for an image to be deleted when it is safe to do so.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Image will get freed, though not until it is no longer Tcl_Preserve()d
+ * by anything. May be called multiple times on the same image without
+ * ill effects.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+EventuallyDeleteImage(
+ ImageMaster *masterPtr, /* Pointer to main data structure for image. */
+ int forgetImageHashNow) /* Flag to say whether the hash table is about
+ * to vanish. */
+{
+ if (forgetImageHashNow) {
+ masterPtr->hPtr = NULL;
+ }
+ if (!masterPtr->deleted) {
+ masterPtr->deleted = 1;
+ Tcl_EventuallyFree(masterPtr, (Tcl_FreeProc *) DeleteImage);
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkDeleteAllImages --
+ *
+ * This function is called when an application is deleted. It calls back
+ * all of the managers for all images so that they can cleanup, then it
+ * deletes all of Tk's internal information about images.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * All information for all images gets deleted.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TkDeleteAllImages(
+ TkMainInfo *mainPtr) /* Structure describing application that is
+ * going away. */
+{
+ Tcl_HashSearch search;
+ Tcl_HashEntry *hPtr;
+
+ for (hPtr = Tcl_FirstHashEntry(&mainPtr->imageTable, &search);
+ hPtr != NULL; hPtr = Tcl_NextHashEntry(&search)) {
+ EventuallyDeleteImage(Tcl_GetHashValue(hPtr), 1);
+ }
+ Tcl_DeleteHashTable(&mainPtr->imageTable);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_GetImageMasterData --
+ *
+ * Given the name of an image, this function returns the type of the
+ * image and the clientData associated with its master.
+ *
+ * Results:
+ * If there is no image by the given name, then NULL is returned and a
+ * NULL value is stored at *typePtrPtr. Otherwise the return value is the
+ * clientData returned by the createProc when the image was created and a
+ * pointer to the type structure for the image is stored at *typePtrPtr.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+ClientData
+Tk_GetImageMasterData(
+ Tcl_Interp *interp, /* Interpreter in which the image was
+ * created. */
+ const char *name, /* Name of image. */
+ const Tk_ImageType **typePtrPtr)
+ /* Points to location to fill in with pointer
+ * to type information for image. */
+{
+ TkWindow *winPtr = (TkWindow *) Tk_MainWindow(interp);
+ Tcl_HashEntry *hPtr;
+ ImageMaster *masterPtr;
+
+ hPtr = Tcl_FindHashEntry(&winPtr->mainPtr->imageTable, name);
+ if (hPtr == NULL) {
+ *typePtrPtr = NULL;
+ return NULL;
+ }
+ masterPtr = Tcl_GetHashValue(hPtr);
+ if (masterPtr->deleted) {
+ *typePtrPtr = NULL;
+ return NULL;
+ }
+ *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(
+ Tk_Window tkwin,
+ GC gc,
+ int x, int y)
+{
+ while (!Tk_TopWinHierarchy(tkwin)) {
+ x -= Tk_X(tkwin) + Tk_Changes(tkwin)->border_width;
+ y -= Tk_Y(tkwin) + Tk_Changes(tkwin)->border_width;
+ tkwin = Tk_Parent(tkwin);
+ }
+ XSetTSOrigin(Tk_Display(tkwin), gc, x, y);
+}
+
+/*
+ * Local Variables:
+ * mode: c
+ * c-basic-offset: 4
+ * fill-column: 78
+ * End:
+ */
diff --git a/tk8.6/generic/tkImgBmap.c b/tk8.6/generic/tkImgBmap.c
new file mode 100644
index 0000000..0906673
--- /dev/null
+++ b/tk8.6/generic/tkImgBmap.c
@@ -0,0 +1,1323 @@
+/*
+ * tkImgBmap.c --
+ *
+ * This procedure implements images of type "bitmap" for Tk.
+ *
+ * Copyright (c) 1994 The Regents of the University of California.
+ * Copyright (c) 1994-1997 Sun Microsystems, Inc.
+ * Copyright (c) 1999 by Scriptics Corporation.
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ */
+
+#include "tkInt.h"
+
+/*
+ * The following data structure represents the master for a bitmap
+ * image:
+ */
+
+typedef struct BitmapMaster {
+ Tk_ImageMaster tkMaster; /* Tk's token for image master. NULL means the
+ * image is being deleted. */
+ Tcl_Interp *interp; /* Interpreter for application that is using
+ * image. */
+ Tcl_Command imageCmd; /* Token for image command (used to delete it
+ * when the image goes away). NULL means the
+ * image command has already been deleted. */
+ int width, height; /* Dimensions of image. */
+ char *data; /* Data comprising bitmap (suitable for input
+ * to XCreateBitmapFromData). May be NULL if
+ * no data. Malloc'ed. */
+ char *maskData; /* Data for bitmap's mask (suitable for input
+ * to XCreateBitmapFromData). Malloc'ed. */
+ Tk_Uid fgUid; /* Value of -foreground option (malloc'ed). */
+ Tk_Uid bgUid; /* Value of -background option (malloc'ed). */
+ char *fileString; /* Value of -file option (malloc'ed). */
+ char *dataString; /* Value of -data option (malloc'ed). */
+ char *maskFileString; /* Value of -maskfile option (malloc'ed). */
+ char *maskDataString; /* Value of -maskdata option (malloc'ed). */
+ struct BitmapInstance *instancePtr;
+ /* First in list of all instances associated
+ * with this master. */
+} BitmapMaster;
+
+/*
+ * The following data structure represents all of the instances of an image
+ * that lie within a particular window:
+ */
+
+typedef struct BitmapInstance {
+ int refCount; /* Number of instances that share this data
+ * structure. */
+ BitmapMaster *masterPtr; /* Pointer to master for image. */
+ Tk_Window tkwin; /* Window in which the instances will be
+ * displayed. */
+ XColor *fg; /* Foreground color for displaying image. */
+ XColor *bg; /* Background color for displaying image. */
+ Pixmap bitmap; /* The bitmap to display. */
+ Pixmap mask; /* Mask: only display bitmap pixels where
+ * there are 1's here. */
+ GC gc; /* Graphics context for displaying bitmap.
+ * None means there was an error while setting
+ * up the instance, so it cannot be
+ * displayed. */
+ struct BitmapInstance *nextPtr;
+ /* Next in list of all instance structures
+ * associated with masterPtr (NULL means end
+ * of list). */
+} BitmapInstance;
+
+/*
+ * The type record for bitmap images:
+ */
+
+static int GetByte(Tcl_Channel chan);
+static int ImgBmapCreate(Tcl_Interp *interp,
+ const char *name, int argc, Tcl_Obj *const objv[],
+ const Tk_ImageType *typePtr, Tk_ImageMaster master,
+ ClientData *clientDataPtr);
+static ClientData ImgBmapGet(Tk_Window tkwin, ClientData clientData);
+static void ImgBmapDisplay(ClientData clientData,
+ Display *display, Drawable drawable,
+ int imageX, int imageY, int width, int height,
+ int drawableX, int drawableY);
+static void ImgBmapFree(ClientData clientData, Display *display);
+static void ImgBmapDelete(ClientData clientData);
+static int ImgBmapPostscript(ClientData clientData,
+ Tcl_Interp *interp, Tk_Window tkwin,
+ Tk_PostscriptInfo psinfo, int x, int y,
+ int width, int height, int prepass);
+
+Tk_ImageType tkBitmapImageType = {
+ "bitmap", /* name */
+ ImgBmapCreate, /* createProc */
+ ImgBmapGet, /* getProc */
+ ImgBmapDisplay, /* displayProc */
+ ImgBmapFree, /* freeProc */
+ ImgBmapDelete, /* deleteProc */
+ ImgBmapPostscript, /* postscriptProc */
+ NULL, /* nextPtr */
+ NULL
+};
+
+/*
+ * Information used for parsing configuration specs:
+ */
+
+static const Tk_ConfigSpec configSpecs[] = {
+ {TK_CONFIG_UID, "-background", NULL, NULL,
+ "", Tk_Offset(BitmapMaster, bgUid), 0, NULL},
+ {TK_CONFIG_STRING, "-data", NULL, NULL,
+ NULL, Tk_Offset(BitmapMaster, dataString), TK_CONFIG_NULL_OK, NULL},
+ {TK_CONFIG_STRING, "-file", NULL, NULL,
+ NULL, Tk_Offset(BitmapMaster, fileString), TK_CONFIG_NULL_OK, NULL},
+ {TK_CONFIG_UID, "-foreground", NULL, NULL,
+ "#000000", Tk_Offset(BitmapMaster, fgUid), 0, NULL},
+ {TK_CONFIG_STRING, "-maskdata", NULL, NULL,
+ NULL, Tk_Offset(BitmapMaster, maskDataString), TK_CONFIG_NULL_OK, NULL},
+ {TK_CONFIG_STRING, "-maskfile", NULL, NULL,
+ NULL, Tk_Offset(BitmapMaster, maskFileString), TK_CONFIG_NULL_OK, NULL},
+ {TK_CONFIG_END, NULL, NULL, NULL, NULL, 0, 0, NULL}
+};
+
+/*
+ * The following data structure is used to describe the state of parsing a
+ * bitmap file or string. It is used for communication between TkGetBitmapData
+ * and NextBitmapWord.
+ */
+
+#define MAX_WORD_LENGTH 100
+typedef struct ParseInfo {
+ const char *string; /* Next character of string data for bitmap,
+ * or NULL if bitmap is being read from
+ * file. */
+ Tcl_Channel chan; /* File containing bitmap data, or NULL if no
+ * file. */
+ char word[MAX_WORD_LENGTH+1];
+ /* Current word of bitmap data, NULL
+ * terminated. */
+ int wordLength; /* Number of non-NULL bytes in word. */
+} ParseInfo;
+
+/*
+ * Prototypes for procedures used only locally in this file:
+ */
+
+static int ImgBmapCmd(ClientData clientData, Tcl_Interp *interp,
+ int argc, Tcl_Obj *const objv[]);
+static void ImgBmapCmdDeletedProc(ClientData clientData);
+static void ImgBmapConfigureInstance(BitmapInstance *instancePtr);
+static int ImgBmapConfigureMaster(BitmapMaster *masterPtr,
+ int argc, Tcl_Obj *const objv[], int flags);
+static int NextBitmapWord(ParseInfo *parseInfoPtr);
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ImgBmapCreate --
+ *
+ * This procedure is called by the Tk image code to create "test" images.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * The data structure for a new image is allocated.
+ *
+ *----------------------------------------------------------------------
+ */
+
+ /* ARGSUSED */
+static int
+ImgBmapCreate(
+ Tcl_Interp *interp, /* Interpreter for application containing
+ * image. */
+ const char *name, /* Name to use for image. */
+ int argc, /* Number of arguments. */
+ Tcl_Obj *const argv[], /* Argument objects for options (doesn't
+ * include image name or type). */
+ const Tk_ImageType *typePtr,/* Pointer to our type record (not used). */
+ Tk_ImageMaster master, /* Token for image, to be used by us in later
+ * callbacks. */
+ ClientData *clientDataPtr) /* Store manager's token for image here; it
+ * will be returned in later callbacks. */
+{
+ BitmapMaster *masterPtr = ckalloc(sizeof(BitmapMaster));
+
+ masterPtr->tkMaster = master;
+ masterPtr->interp = interp;
+ masterPtr->imageCmd = Tcl_CreateObjCommand(interp, name, ImgBmapCmd,
+ masterPtr, ImgBmapCmdDeletedProc);
+ masterPtr->width = masterPtr->height = 0;
+ masterPtr->data = NULL;
+ masterPtr->maskData = NULL;
+ masterPtr->fgUid = NULL;
+ masterPtr->bgUid = NULL;
+ masterPtr->fileString = NULL;
+ masterPtr->dataString = NULL;
+ masterPtr->maskFileString = NULL;
+ masterPtr->maskDataString = NULL;
+ masterPtr->instancePtr = NULL;
+ if (ImgBmapConfigureMaster(masterPtr, argc, argv, 0) != TCL_OK) {
+ ImgBmapDelete(masterPtr);
+ return TCL_ERROR;
+ }
+ *clientDataPtr = masterPtr;
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ImgBmapConfigureMaster --
+ *
+ * This procedure is called when a bitmap image is created or
+ * reconfigured. It process configuration options and resets any
+ * instances of the image.
+ *
+ * Results:
+ * A standard Tcl return value. If TCL_ERROR is returned then an error
+ * message is left in the masterPtr->interp's result.
+ *
+ * Side effects:
+ * Existing instances of the image will be redisplayed to match the new
+ * configuration options.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+ImgBmapConfigureMaster(
+ BitmapMaster *masterPtr, /* Pointer to data structure describing
+ * overall bitmap image to (reconfigure). */
+ int objc, /* Number of entries in objv. */
+ Tcl_Obj *const objv[], /* Pairs of configuration options for image. */
+ int flags) /* Flags to pass to Tk_ConfigureWidget, such
+ * as TK_CONFIG_ARGV_ONLY. */
+{
+ BitmapInstance *instancePtr;
+ int maskWidth, maskHeight, dummy1, dummy2;
+ const char **argv = ckalloc((objc+1) * sizeof(char *));
+
+ for (dummy1 = 0; dummy1 < objc; dummy1++) {
+ argv[dummy1] = Tcl_GetString(objv[dummy1]);
+ }
+ argv[objc] = NULL;
+
+ if (Tk_ConfigureWidget(masterPtr->interp, Tk_MainWindow(masterPtr->interp),
+ configSpecs, objc, argv, (char *) masterPtr, flags) != TCL_OK) {
+ ckfree(argv);
+ return TCL_ERROR;
+ }
+ ckfree(argv);
+
+ /*
+ * Parse the bitmap and/or mask to create binary data. Make sure that the
+ * bitmap and mask have the same dimensions.
+ */
+
+ if (masterPtr->data != NULL) {
+ ckfree(masterPtr->data);
+ masterPtr->data = NULL;
+ }
+ if ((masterPtr->fileString != NULL) || (masterPtr->dataString != NULL)) {
+ masterPtr->data = TkGetBitmapData(masterPtr->interp,
+ masterPtr->dataString, masterPtr->fileString,
+ &masterPtr->width, &masterPtr->height, &dummy1, &dummy2);
+ if (masterPtr->data == NULL) {
+ return TCL_ERROR;
+ }
+ }
+ if (masterPtr->maskData != NULL) {
+ ckfree(masterPtr->maskData);
+ masterPtr->maskData = NULL;
+ }
+ if ((masterPtr->maskFileString != NULL)
+ || (masterPtr->maskDataString != NULL)) {
+ if (masterPtr->data == NULL) {
+ Tcl_SetObjResult(masterPtr->interp, Tcl_NewStringObj(
+ "can't have mask without bitmap", -1));
+ Tcl_SetErrorCode(masterPtr->interp, "TK", "IMAGE", "BITMAP",
+ "NO_BITMAP", NULL);
+ return TCL_ERROR;
+ }
+ masterPtr->maskData = TkGetBitmapData(masterPtr->interp,
+ masterPtr->maskDataString, masterPtr->maskFileString,
+ &maskWidth, &maskHeight, &dummy1, &dummy2);
+ if (masterPtr->maskData == NULL) {
+ return TCL_ERROR;
+ }
+ if ((maskWidth != masterPtr->width)
+ || (maskHeight != masterPtr->height)) {
+ ckfree(masterPtr->maskData);
+ masterPtr->maskData = NULL;
+ Tcl_SetObjResult(masterPtr->interp, Tcl_NewStringObj(
+ "bitmap and mask have different sizes", -1));
+ Tcl_SetErrorCode(masterPtr->interp, "TK", "IMAGE", "BITMAP",
+ "MASK_SIZE", NULL);
+ return TCL_ERROR;
+ }
+ }
+
+ /*
+ * Cycle through all of the instances of this image, regenerating the
+ * information for each instance. Then force the image to be redisplayed
+ * everywhere that it is used.
+ */
+
+ for (instancePtr = masterPtr->instancePtr; instancePtr != NULL;
+ instancePtr = instancePtr->nextPtr) {
+ ImgBmapConfigureInstance(instancePtr);
+ }
+ Tk_ImageChanged(masterPtr->tkMaster, 0, 0, masterPtr->width,
+ masterPtr->height, masterPtr->width, masterPtr->height);
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ImgBmapConfigureInstance --
+ *
+ * This procedure is called to create displaying information for a bitmap
+ * image instance based on the configuration information in the master.
+ * It is invoked both when new instances are created and when the master
+ * is reconfigured.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Generates errors via Tcl_BackgroundException if there are problems in
+ * setting up the instance.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+ImgBmapConfigureInstance(
+ BitmapInstance *instancePtr)/* Instance to reconfigure. */
+{
+ BitmapMaster *masterPtr = instancePtr->masterPtr;
+ XColor *colorPtr;
+ XGCValues gcValues;
+ GC gc;
+ unsigned int mask;
+ Pixmap oldBitmap, oldMask;
+
+ /*
+ * For each of the options in masterPtr, translate the string form into an
+ * internal form appropriate for instancePtr.
+ */
+
+ if (*masterPtr->bgUid != 0) {
+ colorPtr = Tk_GetColor(masterPtr->interp, instancePtr->tkwin,
+ masterPtr->bgUid);
+ if (colorPtr == NULL) {
+ goto error;
+ }
+ } else {
+ colorPtr = NULL;
+ }
+ if (instancePtr->bg != NULL) {
+ Tk_FreeColor(instancePtr->bg);
+ }
+ instancePtr->bg = colorPtr;
+
+ colorPtr = Tk_GetColor(masterPtr->interp, instancePtr->tkwin,
+ masterPtr->fgUid);
+ if (colorPtr == NULL) {
+ goto error;
+ }
+ if (instancePtr->fg != NULL) {
+ Tk_FreeColor(instancePtr->fg);
+ }
+ instancePtr->fg = colorPtr;
+
+ /*
+ * Careful: We have to allocate new Pixmaps before deleting the old ones.
+ * Otherwise, The XID allocator will always return the same XID for the
+ * new Pixmaps as was used for the old Pixmaps. And that will prevent the
+ * data and/or mask from changing in the GC below.
+ */
+
+ oldBitmap = instancePtr->bitmap;
+ instancePtr->bitmap = None;
+ oldMask = instancePtr->mask;
+ instancePtr->mask = None;
+
+ if (masterPtr->data != NULL) {
+ instancePtr->bitmap = XCreateBitmapFromData(
+ Tk_Display(instancePtr->tkwin),
+ RootWindowOfScreen(Tk_Screen(instancePtr->tkwin)),
+ masterPtr->data, (unsigned) masterPtr->width,
+ (unsigned) masterPtr->height);
+ }
+ if (masterPtr->maskData != NULL) {
+ instancePtr->mask = XCreateBitmapFromData(
+ Tk_Display(instancePtr->tkwin),
+ RootWindowOfScreen(Tk_Screen(instancePtr->tkwin)),
+ masterPtr->maskData, (unsigned) masterPtr->width,
+ (unsigned) masterPtr->height);
+ }
+
+ if (oldMask != None) {
+ Tk_FreePixmap(Tk_Display(instancePtr->tkwin), oldMask);
+ }
+ if (oldBitmap != None) {
+ Tk_FreePixmap(Tk_Display(instancePtr->tkwin), oldBitmap);
+ }
+
+ if (masterPtr->data != NULL) {
+ gcValues.foreground = instancePtr->fg->pixel;
+ gcValues.graphics_exposures = False;
+ mask = GCForeground|GCGraphicsExposures;
+ if (instancePtr->bg != NULL) {
+ gcValues.background = instancePtr->bg->pixel;
+ mask |= GCBackground;
+ if (instancePtr->mask != None) {
+ gcValues.clip_mask = instancePtr->mask;
+ mask |= GCClipMask;
+ }
+ } else {
+ gcValues.clip_mask = instancePtr->bitmap;
+ mask |= GCClipMask;
+ }
+ gc = Tk_GetGC(instancePtr->tkwin, mask, &gcValues);
+ } else {
+ gc = None;
+ }
+ if (instancePtr->gc != None) {
+ Tk_FreeGC(Tk_Display(instancePtr->tkwin), instancePtr->gc);
+ }
+ instancePtr->gc = gc;
+ return;
+
+ error:
+ /*
+ * An error occurred: clear the graphics context in the instance to make
+ * it clear that this instance cannot be displayed. Then report the error.
+ */
+
+ if (instancePtr->gc != None) {
+ Tk_FreeGC(Tk_Display(instancePtr->tkwin), instancePtr->gc);
+ }
+ instancePtr->gc = None;
+ Tcl_AppendObjToErrorInfo(masterPtr->interp, Tcl_ObjPrintf(
+ "\n (while configuring image \"%s\")", Tk_NameOfImage(
+ masterPtr->tkMaster)));
+ Tcl_BackgroundException(masterPtr->interp, TCL_ERROR);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkGetBitmapData --
+ *
+ * Given a file name or ASCII string, this procedure parses the file or
+ * string contents to produce binary data for a bitmap.
+ *
+ * Results:
+ * If the bitmap description was parsed successfully then the return
+ * value is a malloc-ed array containing the bitmap data. The dimensions
+ * of the data are stored in *widthPtr and *heightPtr. *hotXPtr and
+ * *hotYPtr are set to the bitmap hotspot if one is defined, otherwise
+ * they are set to -1, -1. If an error occurred, NULL is returned and an
+ * error message is left in the interp's result.
+ *
+ * Side effects:
+ * A bitmap is created.
+ *
+ *----------------------------------------------------------------------
+ */
+
+char *
+TkGetBitmapData(
+ Tcl_Interp *interp, /* For reporting errors, or NULL. */
+ const char *string, /* String describing bitmap. May be NULL. */
+ const char *fileName, /* Name of file containing bitmap description.
+ * Used only if string is NULL. Must not be
+ * NULL if string is NULL. */
+ int *widthPtr, int *heightPtr,
+ /* Dimensions of bitmap get returned here. */
+ int *hotXPtr, int *hotYPtr) /* Position of hot spot or -1,-1. */
+{
+ int width, height, numBytes, hotX, hotY;
+ const char *expandedFileName;
+ char *p, *end;
+ ParseInfo pi;
+ char *data = NULL;
+ Tcl_DString buffer;
+
+ pi.string = string;
+ if (string == NULL) {
+ if ((interp != NULL) && Tcl_IsSafe(interp)) {
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "can't get bitmap data from a file in a safe interpreter",
+ -1));
+ Tcl_SetErrorCode(interp, "TK", "SAFE", "BITMAP_FILE", NULL);
+ return NULL;
+ }
+ expandedFileName = Tcl_TranslateFileName(interp, fileName, &buffer);
+ if (expandedFileName == NULL) {
+ return NULL;
+ }
+ pi.chan = Tcl_OpenFileChannel(interp, expandedFileName, "r", 0);
+ Tcl_DStringFree(&buffer);
+ if (pi.chan == NULL) {
+ if (interp != NULL) {
+ Tcl_ResetResult(interp);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "couldn't read bitmap file \"%s\": %s",
+ fileName, Tcl_PosixError(interp)));
+ }
+ return NULL;
+ }
+
+ if (Tcl_SetChannelOption(interp, pi.chan, "-translation", "binary")
+ != TCL_OK) {
+ return NULL;
+ }
+ if (Tcl_SetChannelOption(interp, pi.chan, "-encoding", "binary")
+ != TCL_OK) {
+ return NULL;
+ }
+ } else {
+ pi.chan = NULL;
+ }
+
+ /*
+ * Parse the lines that define the dimensions of the bitmap, plus the
+ * first line that defines the bitmap data (it declares the name of a data
+ * variable but doesn't include any actual data). These lines look
+ * something like the following:
+ *
+ * #define foo_width 16
+ * #define foo_height 16
+ * #define foo_x_hot 3
+ * #define foo_y_hot 3
+ * static char foo_bits[] = {
+ *
+ * The x_hot and y_hot lines may or may not be present. It's important to
+ * check for "char" in the last line, in order to reject old X10-style
+ * bitmaps that used shorts.
+ */
+
+ width = 0;
+ height = 0;
+ hotX = -1;
+ hotY = -1;
+ while (1) {
+ if (NextBitmapWord(&pi) != TCL_OK) {
+ goto error;
+ }
+ if ((pi.wordLength >= 6) && (pi.word[pi.wordLength-6] == '_')
+ && (strcmp(pi.word+pi.wordLength-6, "_width") == 0)) {
+ if (NextBitmapWord(&pi) != TCL_OK) {
+ goto error;
+ }
+ width = strtol(pi.word, &end, 0);
+ if ((end == pi.word) || (*end != 0)) {
+ goto error;
+ }
+ } else if ((pi.wordLength >= 7) && (pi.word[pi.wordLength-7] == '_')
+ && (strcmp(pi.word+pi.wordLength-7, "_height") == 0)) {
+ if (NextBitmapWord(&pi) != TCL_OK) {
+ goto error;
+ }
+ height = strtol(pi.word, &end, 0);
+ if ((end == pi.word) || (*end != 0)) {
+ goto error;
+ }
+ } else if ((pi.wordLength >= 6) && (pi.word[pi.wordLength-6] == '_')
+ && (strcmp(pi.word+pi.wordLength-6, "_x_hot") == 0)) {
+ if (NextBitmapWord(&pi) != TCL_OK) {
+ goto error;
+ }
+ hotX = strtol(pi.word, &end, 0);
+ if ((end == pi.word) || (*end != 0)) {
+ goto error;
+ }
+ } else if ((pi.wordLength >= 6) && (pi.word[pi.wordLength-6] == '_')
+ && (strcmp(pi.word+pi.wordLength-6, "_y_hot") == 0)) {
+ if (NextBitmapWord(&pi) != TCL_OK) {
+ goto error;
+ }
+ hotY = strtol(pi.word, &end, 0);
+ if ((end == pi.word) || (*end != 0)) {
+ goto error;
+ }
+ } else if ((pi.word[0] == 'c') && (strcmp(pi.word, "char") == 0)) {
+ while (1) {
+ if (NextBitmapWord(&pi) != TCL_OK) {
+ goto error;
+ }
+ if ((pi.word[0] == '{') && (pi.word[1] == 0)) {
+ goto getData;
+ }
+ }
+ } else if ((pi.word[0] == '{') && (pi.word[1] == 0)) {
+ if (interp != NULL) {
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "format error in bitmap data; looks like it's an"
+ " obsolete X10 bitmap file", -1));
+ Tcl_SetErrorCode(interp, "TK", "IMAGE", "BITMAP", "OBSOLETE",
+ NULL);
+ }
+ goto errorCleanup;
+ }
+ }
+
+ /*
+ * Now we've read everything but the data. Allocate an array and read in
+ * the data.
+ */
+
+ getData:
+ if ((width <= 0) || (height <= 0)) {
+ goto error;
+ }
+ numBytes = ((width+7)/8) * height;
+ data = ckalloc(numBytes);
+ for (p = data; numBytes > 0; p++, numBytes--) {
+ if (NextBitmapWord(&pi) != TCL_OK) {
+ goto error;
+ }
+ *p = (char) strtol(pi.word, &end, 0);
+ if (end == pi.word) {
+ goto error;
+ }
+ }
+
+ /*
+ * All done. Clean up and return.
+ */
+
+ if (pi.chan != NULL) {
+ Tcl_Close(NULL, pi.chan);
+ }
+ *widthPtr = width;
+ *heightPtr = height;
+ *hotXPtr = hotX;
+ *hotYPtr = hotY;
+ return data;
+
+ error:
+ if (interp != NULL) {
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "format error in bitmap data", -1));
+ Tcl_SetErrorCode(interp, "TK", "IMAGE", "BITMAP", "FORMAT", NULL);
+ }
+
+ errorCleanup:
+ if (data != NULL) {
+ ckfree(data);
+ }
+ if (pi.chan != NULL) {
+ Tcl_Close(NULL, pi.chan);
+ }
+ return NULL;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * NextBitmapWord --
+ *
+ * This procedure retrieves the next word of information (stuff between
+ * commas or white space) from a bitmap description.
+ *
+ * Results:
+ * Returns TCL_OK if all went well. In this case the next word, and its
+ * length, will be availble in *parseInfoPtr. If the end of the bitmap
+ * description was reached then TCL_ERROR is returned.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+NextBitmapWord(
+ ParseInfo *parseInfoPtr) /* Describes what we're reading and where we
+ * are in it. */
+{
+ const char *src;
+ char *dst;
+ int c;
+
+ parseInfoPtr->wordLength = 0;
+ dst = parseInfoPtr->word;
+ if (parseInfoPtr->string != NULL) {
+ for (src = parseInfoPtr->string; isspace(UCHAR(*src)) || (*src == ',');
+ src++) {
+ if (*src == 0) {
+ return TCL_ERROR;
+ }
+ }
+ for ( ; !isspace(UCHAR(*src)) && (*src != ',') && (*src != 0); src++) {
+ *dst = *src;
+ dst++;
+ parseInfoPtr->wordLength++;
+ if (parseInfoPtr->wordLength > MAX_WORD_LENGTH) {
+ return TCL_ERROR;
+ }
+ }
+ parseInfoPtr->string = src;
+ } else {
+ for (c = GetByte(parseInfoPtr->chan); isspace(UCHAR(c)) || (c == ',');
+ c = GetByte(parseInfoPtr->chan)) {
+ if (c == EOF) {
+ return TCL_ERROR;
+ }
+ }
+ for ( ; !isspace(UCHAR(c)) && (c != ',') && (c != EOF);
+ c = GetByte(parseInfoPtr->chan)) {
+ *dst = c;
+ dst++;
+ parseInfoPtr->wordLength++;
+ if (parseInfoPtr->wordLength > MAX_WORD_LENGTH) {
+ return TCL_ERROR;
+ }
+ }
+ }
+ if (parseInfoPtr->wordLength == 0) {
+ return TCL_ERROR;
+ }
+ parseInfoPtr->word[parseInfoPtr->wordLength] = 0;
+ return TCL_OK;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * ImgBmapCmd --
+ *
+ * This procedure is invoked to process the Tcl command that corresponds
+ * to an image managed by this module. See the user documentation for
+ * details on what it does.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * See the user documentation.
+ *
+ *--------------------------------------------------------------
+ */
+
+static int
+ImgBmapCmd(
+ ClientData clientData, /* Information about the image master. */
+ Tcl_Interp *interp, /* Current interpreter. */
+ int objc, /* Number of arguments. */
+ Tcl_Obj *const objv[]) /* Argument objects. */
+{
+ static const char *const bmapOptions[] = {"cget", "configure", NULL};
+ BitmapMaster *masterPtr = clientData;
+ int index;
+
+ if (objc < 2) {
+ Tcl_WrongNumArgs(interp, 1, objv, "option ?arg ...?");
+ return TCL_ERROR;
+ }
+ if (Tcl_GetIndexFromObjStruct(interp, objv[1], bmapOptions,
+ sizeof(char *), "option", 0, &index) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ switch (index) {
+ case 0: /* cget */
+ if (objc != 3) {
+ Tcl_WrongNumArgs(interp, 2, objv, "option");
+ return TCL_ERROR;
+ }
+ return Tk_ConfigureValue(interp, Tk_MainWindow(interp), configSpecs,
+ (char *) masterPtr, Tcl_GetString(objv[2]), 0);
+ case 1: /* configure */
+ if (objc == 2) {
+ return Tk_ConfigureInfo(interp, Tk_MainWindow(interp),
+ configSpecs, (char *) masterPtr, NULL, 0);
+ } else if (objc == 3) {
+ return Tk_ConfigureInfo(interp, Tk_MainWindow(interp),
+ configSpecs, (char *) masterPtr,
+ Tcl_GetString(objv[2]), 0);
+ } else {
+ return ImgBmapConfigureMaster(masterPtr, objc-2, objv+2,
+ TK_CONFIG_ARGV_ONLY);
+ }
+ default:
+ Tcl_Panic("bad const entries to bmapOptions in ImgBmapCmd");
+ return TCL_OK;
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ImgBmapGet --
+ *
+ * This procedure is called for each use of a bitmap image in a widget.
+ *
+ * Results:
+ * The return value is a token for the instance, which is passed back to
+ * us in calls to ImgBmapDisplay and ImgBmapFree.
+ *
+ * Side effects:
+ * A data structure is set up for the instance (or, an existing instance
+ * is re-used for the new one).
+ *
+ *----------------------------------------------------------------------
+ */
+
+static ClientData
+ImgBmapGet(
+ Tk_Window tkwin, /* Window in which the instance will be
+ * used. */
+ ClientData masterData) /* Pointer to our master structure for the
+ * image. */
+{
+ BitmapMaster *masterPtr = masterData;
+ BitmapInstance *instancePtr;
+
+ /*
+ * See if there is already an instance for this window. If so then just
+ * re-use it.
+ */
+
+ for (instancePtr = masterPtr->instancePtr; instancePtr != NULL;
+ instancePtr = instancePtr->nextPtr) {
+ if (instancePtr->tkwin == tkwin) {
+ instancePtr->refCount++;
+ return instancePtr;
+ }
+ }
+
+ /*
+ * The image isn't already in use in this window. Make a new instance of
+ * the image.
+ */
+
+ instancePtr = ckalloc(sizeof(BitmapInstance));
+ instancePtr->refCount = 1;
+ instancePtr->masterPtr = masterPtr;
+ instancePtr->tkwin = tkwin;
+ instancePtr->fg = NULL;
+ instancePtr->bg = NULL;
+ instancePtr->bitmap = None;
+ instancePtr->mask = None;
+ instancePtr->gc = None;
+ instancePtr->nextPtr = masterPtr->instancePtr;
+ masterPtr->instancePtr = instancePtr;
+ ImgBmapConfigureInstance(instancePtr);
+
+ /*
+ * If this is the first instance, must set the size of the image.
+ */
+
+ if (instancePtr->nextPtr == NULL) {
+ Tk_ImageChanged(masterPtr->tkMaster, 0, 0, 0, 0, masterPtr->width,
+ masterPtr->height);
+ }
+
+ return instancePtr;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ImgBmapDisplay --
+ *
+ * This procedure is invoked to draw a bitmap image.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * A portion of the image gets rendered in a pixmap or window.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+ImgBmapDisplay(
+ ClientData clientData, /* Pointer to BitmapInstance structure for
+ * instance to be displayed. */
+ Display *display, /* Display on which to draw image. */
+ Drawable drawable, /* Pixmap or window in which to draw image. */
+ int imageX, int imageY, /* Upper-left corner of region within image to
+ * draw. */
+ int width, int height, /* Dimensions of region within image to draw. */
+ int drawableX, int drawableY)
+ /* Coordinates within drawable that correspond
+ * to imageX and imageY. */
+{
+ BitmapInstance *instancePtr = clientData;
+ int masking;
+
+ /*
+ * If there's no graphics context, it means that an error occurred while
+ * creating the image instance so it can't be displayed.
+ */
+
+ if (instancePtr->gc == None) {
+ return;
+ }
+
+ /*
+ * If masking is in effect, must modify the mask origin within the
+ * graphics context to line up with the image's origin. Then draw the
+ * image and reset the clip origin, if there's a mask.
+ */
+
+ masking = (instancePtr->mask != None) || (instancePtr->bg == NULL);
+ if (masking) {
+ XSetClipOrigin(display, instancePtr->gc, drawableX - imageX,
+ drawableY - imageY);
+ }
+ XCopyPlane(display, instancePtr->bitmap, drawable, instancePtr->gc,
+ imageX, imageY, (unsigned) width, (unsigned) height,
+ drawableX, drawableY, 1);
+ if (masking) {
+ XSetClipOrigin(display, instancePtr->gc, 0, 0);
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ImgBmapFree --
+ *
+ * This procedure is called when a widget ceases to use a particular
+ * instance of an image.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Internal data structures get cleaned up.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+ImgBmapFree(
+ ClientData clientData, /* Pointer to BitmapInstance structure for
+ * instance to be displayed. */
+ Display *display) /* Display containing window that used image. */
+{
+ BitmapInstance *instancePtr = clientData;
+ BitmapInstance *prevPtr;
+
+ instancePtr->refCount--;
+ if (instancePtr->refCount > 0) {
+ return;
+ }
+
+ /*
+ * There are no more uses of the image within this widget. Free the
+ * instance structure.
+ */
+
+ if (instancePtr->fg != NULL) {
+ Tk_FreeColor(instancePtr->fg);
+ }
+ if (instancePtr->bg != NULL) {
+ Tk_FreeColor(instancePtr->bg);
+ }
+ if (instancePtr->bitmap != None) {
+ Tk_FreePixmap(display, instancePtr->bitmap);
+ }
+ if (instancePtr->mask != None) {
+ Tk_FreePixmap(display, instancePtr->mask);
+ }
+ if (instancePtr->gc != None) {
+ Tk_FreeGC(display, instancePtr->gc);
+ }
+ if (instancePtr->masterPtr->instancePtr == instancePtr) {
+ instancePtr->masterPtr->instancePtr = instancePtr->nextPtr;
+ } else {
+ for (prevPtr = instancePtr->masterPtr->instancePtr;
+ prevPtr->nextPtr != instancePtr; prevPtr = prevPtr->nextPtr) {
+ /* Empty loop body */
+ }
+ prevPtr->nextPtr = instancePtr->nextPtr;
+ }
+ ckfree(instancePtr);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ImgBmapDelete --
+ *
+ * This procedure is called by the image code to delete the master
+ * structure for an image.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Resources associated with the image get freed.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+ImgBmapDelete(
+ ClientData masterData) /* Pointer to BitmapMaster structure for
+ * image. Must not have any more instances. */
+{
+ BitmapMaster *masterPtr = masterData;
+
+ if (masterPtr->instancePtr != NULL) {
+ Tcl_Panic("tried to delete bitmap image when instances still exist");
+ }
+ masterPtr->tkMaster = NULL;
+ if (masterPtr->imageCmd != NULL) {
+ Tcl_DeleteCommandFromToken(masterPtr->interp, masterPtr->imageCmd);
+ }
+ if (masterPtr->data != NULL) {
+ ckfree(masterPtr->data);
+ }
+ if (masterPtr->maskData != NULL) {
+ ckfree(masterPtr->maskData);
+ }
+ Tk_FreeOptions(configSpecs, (char *) masterPtr, NULL, 0);
+ ckfree(masterPtr);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ImgBmapCmdDeletedProc --
+ *
+ * This procedure is invoked when the image command for an image is
+ * deleted. It deletes the image.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The image is deleted.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+ImgBmapCmdDeletedProc(
+ ClientData clientData) /* Pointer to BitmapMaster structure for
+ * image. */
+{
+ BitmapMaster *masterPtr = clientData;
+
+ masterPtr->imageCmd = NULL;
+ if (masterPtr->tkMaster != NULL) {
+ Tk_DeleteImage(masterPtr->interp, Tk_NameOfImage(masterPtr->tkMaster));
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * GetByte --
+ *
+ * Get the next byte from the open channel.
+ *
+ * Results:
+ * The next byte or EOF.
+ *
+ * Side effects:
+ * We read from the channel.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+GetByte(
+ Tcl_Channel chan) /* The channel we read from. */
+{
+ char buffer;
+ int size;
+
+ size = Tcl_Read(chan, &buffer, 1);
+ if (size <= 0) {
+ return EOF;
+ } else {
+ return buffer;
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ImgBmapPsImagemask --
+ *
+ * This procedure generates postscript suitable for rendering a single
+ * bitmap of an image. A single bitmap image might contain both a
+ * foreground and a background bitmap. This routine is called once for
+ * each such bitmap in a bitmap image.
+ *
+ * Prior to invoking this routine, the following setup has occurred:
+ *
+ * 1. The postscript foreground color has been set to the color used
+ * to render the bitmap.
+ *
+ * 2. The origin of the postscript coordinate system is set to the
+ * lower left corner of the bitmap.
+ *
+ * 3. The postscript coordinate system has been scaled so that the
+ * entire bitmap is one unit squared.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Postscript code is appended to psObj.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+ImgBmapPsImagemask(
+ Tcl_Obj *psObj, /* Append postscript to this buffer. */
+ int width, int height, /* Width and height of the bitmap in pixels */
+ char *data) /* Data for the bitmap. */
+{
+ int i, j, nBytePerRow;
+
+ /*
+ * The bit order of bitmaps in Tk is the opposite of the bit order that
+ * postscript uses. (In Tk, the least significant bit is on the right side
+ * of the bitmap and in postscript the least significant bit is shown on
+ * the left.) The following array is used to reverse the order of bits
+ * within a byte so that the bits will be in the order postscript expects.
+ */
+
+ static const unsigned char bit_reverse[] = {
+ 0, 128, 64, 192, 32, 160, 96, 224, 16, 144, 80, 208, 48, 176, 112, 240,
+ 8, 136, 72, 200, 40, 168, 104, 232, 24, 152, 88, 216, 56, 184, 120, 248,
+ 4, 132, 68, 196, 36, 164, 100, 228, 20, 148, 84, 212, 52, 180, 116, 244,
+ 12, 140, 76, 204, 44, 172, 108, 236, 28, 156, 92, 220, 60, 188, 124, 252,
+ 2, 130, 66, 194, 34, 162, 98, 226, 18, 146, 82, 210, 50, 178, 114, 242,
+ 10, 138, 74, 202, 42, 170, 106, 234, 26, 154, 90, 218, 58, 186, 122, 250,
+ 6, 134, 70, 198, 38, 166, 102, 230, 22, 150, 86, 214, 54, 182, 118, 246,
+ 14, 142, 78, 206, 46, 174, 110, 238, 30, 158, 94, 222, 62, 190, 126, 254,
+ 1, 129, 65, 193, 33, 161, 97, 225, 17, 145, 81, 209, 49, 177, 113, 241,
+ 9, 137, 73, 201, 41, 169, 105, 233, 25, 153, 89, 217, 57, 185, 121, 249,
+ 5, 133, 69, 197, 37, 165, 101, 229, 21, 149, 85, 213, 53, 181, 117, 245,
+ 13, 141, 77, 205, 45, 173, 109, 237, 29, 157, 93, 221, 61, 189, 125, 253,
+ 3, 131, 67, 195, 35, 163, 99, 227, 19, 147, 83, 211, 51, 179, 115, 243,
+ 11, 139, 75, 203, 43, 171, 107, 235, 27, 155, 91, 219, 59, 187, 123, 251,
+ 7, 135, 71, 199, 39, 167, 103, 231, 23, 151, 87, 215, 55, 183, 119, 247,
+ 15, 143, 79, 207, 47, 175, 111, 239, 31, 159, 95, 223, 63, 191, 127, 255,
+ };
+
+ Tcl_AppendPrintfToObj(psObj,
+ "0 0 moveto %d %d true [%d 0 0 %d 0 %d] {<\n",
+ width, height, width, -height, height);
+
+ nBytePerRow = (width + 7) / 8;
+ for (i=0; i<height; i++) {
+ for (j=0; j<nBytePerRow; j++) {
+ Tcl_AppendPrintfToObj(psObj, " %02x",
+ bit_reverse[0xff & data[i*nBytePerRow + j]]);
+ }
+ Tcl_AppendToObj(psObj, "\n", -1);
+ }
+
+ Tcl_AppendToObj(psObj, ">} imagemask \n", -1);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ImgBmapPostscript --
+ *
+ * This procedure generates postscript for rendering a bitmap image.
+ *
+ * Results:
+ * On success, this routine writes postscript code into interp->result
+ * and returns TCL_OK TCL_ERROR is returned and an error message is left
+ * in interp->result if anything goes wrong.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+ImgBmapPostscript(
+ ClientData clientData,
+ Tcl_Interp *interp,
+ Tk_Window tkwin,
+ Tk_PostscriptInfo psinfo,
+ int x, int y, int width, int height,
+ int prepass)
+{
+ BitmapMaster *masterPtr = clientData;
+ Tcl_InterpState interpState;
+ Tcl_Obj *psObj;
+
+ if (prepass) {
+ return TCL_OK;
+ }
+
+ /*
+ * There is nothing to do for bitmaps with zero width or height.
+ */
+
+ if (width<=0 || height<=0 || masterPtr->width<=0 || masterPtr->height<=0){
+ return TCL_OK;
+ }
+
+ /*
+ * Some postscript implementations cannot handle bitmap strings longer
+ * than about 60k characters. If the bitmap data is that big or bigger,
+ * we bail out.
+ */
+
+ if (masterPtr->width*masterPtr->height > 60000) {
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "unable to generate postscript for bitmaps larger than 60000"
+ " pixels", -1));
+ Tcl_SetErrorCode(interp, "TK", "CANVAS", "PS", "MEMLIMIT", NULL);
+ return TCL_ERROR;
+ }
+
+ /*
+ * Make our working space.
+ */
+
+ psObj = Tcl_NewObj();
+ interpState = Tcl_SaveInterpState(interp, TCL_OK);
+
+ /*
+ * Translate the origin of the coordinate system to be the lower-left
+ * corner of the bitmap and adjust the scale of the coordinate system so
+ * that entire bitmap covers one square unit of the page. The calling
+ * function put a "gsave" into the postscript and will add a "grestore" at
+ * after this routine returns, so it is safe to make whatever changes are
+ * necessary here.
+ */
+
+ if (x != 0 || y != 0) {
+ Tcl_AppendPrintfToObj(psObj, "%d %d moveto\n", x, y);
+ }
+ if (width != 1 || height != 1) {
+ Tcl_AppendPrintfToObj(psObj, "%d %d scale\n", width, height);
+ }
+
+ /*
+ * Color the background, if there is one. This step is skipped if the
+ * background is transparent. If the background is not transparent and
+ * there is no background mask, then color the complete rectangle that
+ * encloses the bitmap. If there is a background mask, then only apply
+ * color to the bits specified by the mask.
+ */
+
+ if ((masterPtr->bgUid != NULL) && (masterPtr->bgUid[0] != '\000')) {
+ XColor color;
+
+ TkParseColor(Tk_Display(tkwin), Tk_Colormap(tkwin), masterPtr->bgUid,
+ &color);
+ Tcl_ResetResult(interp);
+ if (Tk_PostscriptColor(interp, psinfo, &color) != TCL_OK) {
+ goto error;
+ }
+ Tcl_AppendObjToObj(psObj, Tcl_GetObjResult(interp));
+
+ if (masterPtr->maskData == NULL) {
+ Tcl_AppendToObj(psObj,
+ "0 0 moveto 1 0 rlineto 0 1 rlineto -1 0 rlineto "
+ "closepath fill\n", -1);
+ } else {
+ ImgBmapPsImagemask(psObj, masterPtr->width, masterPtr->height,
+ masterPtr->maskData);
+ }
+ }
+
+ /*
+ * Draw the bitmap foreground, assuming there is one.
+ */
+
+ if ((masterPtr->fgUid != NULL) && (masterPtr->data != NULL)) {
+ XColor color;
+
+ TkParseColor(Tk_Display(tkwin), Tk_Colormap(tkwin), masterPtr->fgUid,
+ &color);
+ Tcl_ResetResult(interp);
+ if (Tk_PostscriptColor(interp, psinfo, &color) != TCL_OK) {
+ goto error;
+ }
+ Tcl_AppendObjToObj(psObj, Tcl_GetObjResult(interp));
+
+ ImgBmapPsImagemask(psObj, masterPtr->width, masterPtr->height,
+ masterPtr->data);
+ }
+
+ /*
+ * Plug the accumulated postscript back into the result.
+ */
+
+ (void) Tcl_RestoreInterpState(interp, interpState);
+ Tcl_AppendObjToObj(Tcl_GetObjResult(interp), psObj);
+ Tcl_DecrRefCount(psObj);
+ return TCL_OK;
+
+ error:
+ Tcl_DiscardInterpState(interpState);
+ Tcl_DecrRefCount(psObj);
+ return TCL_ERROR;
+}
+
+/*
+ * Local Variables:
+ * mode: c
+ * c-basic-offset: 4
+ * fill-column: 78
+ * End:
+ */
diff --git a/tk8.6/generic/tkImgGIF.c b/tk8.6/generic/tkImgGIF.c
new file mode 100644
index 0000000..1c28b54
--- /dev/null
+++ b/tk8.6/generic/tkImgGIF.c
@@ -0,0 +1,2239 @@
+/*
+ * tkImgGIF.c --
+ *
+ * A photo image file handler for GIF files. Reads 87a and 89a GIF files.
+ * At present, there only is a file write function. GIF images may be
+ * read using the -data option of the photo image. The data may be given
+ * as a binary string in a Tcl_Obj or by representing the data as BASE64
+ * encoded ascii. Derived from the giftoppm code found in the pbmplus
+ * package and tkImgFmtPPM.c in the tk4.0b2 distribution.
+ *
+ * Copyright (c) Reed Wade (wade@cs.utk.edu), University of Tennessee
+ * Copyright (c) 1995-1997 Sun Microsystems, Inc.
+ * Copyright (c) 1997 Australian National University
+ * Copyright (c) 2005-2010 Donal K. Fellows
+ *
+ * See the file "license.terms" for information on usage and redistribution of
+ * this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ * This file also contains code from the giftoppm program, which is
+ * copyrighted as follows:
+ *
+ * +--------------------------------------------------------------------+
+ * | Copyright 1990, David Koblas. |
+ * | Permission to use, copy, modify, and distribute this software |
+ * | and its documentation for any purpose and without fee is hereby |
+ * | granted, provided that the above copyright notice appear in all |
+ * | copies and that both that copyright notice and this permission |
+ * | notice appear in supporting documentation. This software is |
+ * | provided "as is" without express or implied warranty. |
+ * +--------------------------------------------------------------------+
+ */
+
+#include "tkInt.h"
+
+/*
+ * GIF's are represented as data in either binary or base64 format. base64
+ * strings consist of 4 6-bit characters -> 3 8 bit bytes. A-Z, a-z, 0-9, +
+ * and / represent the 64 values (in order). '=' is a trailing padding char
+ * when the un-encoded data is not a multiple of 3 bytes. We'll ignore white
+ * space when encountered. Any other invalid character is treated as an EOF
+ */
+
+#define GIF_SPECIAL (256)
+#define GIF_PAD (GIF_SPECIAL+1)
+#define GIF_SPACE (GIF_SPECIAL+2)
+#define GIF_BAD (GIF_SPECIAL+3)
+#define GIF_DONE (GIF_SPECIAL+4)
+
+/*
+ * structure to "mimic" FILE for Mread, so we can look like fread. The decoder
+ * state keeps track of which byte we are about to read, or EOF.
+ */
+
+typedef struct mFile {
+ unsigned char *data; /* mmencoded source string */
+ int c; /* bits left over from previous character */
+ int state; /* decoder state (0-4 or GIF_DONE) */
+ int length; /* Total amount of bytes in data */
+} MFile;
+
+/*
+ * Non-ASCII encoding support:
+ * Most data in a GIF image is binary and is treated as such. However, a few
+ * key bits are stashed in ASCII. If we try to compare those pieces to the
+ * char they represent, it will fail on any non-ASCII (eg, EBCDIC) system. To
+ * accomodate these systems, we test against the numeric value of the ASCII
+ * characters instead of the characters themselves. This is encoding
+ * independant.
+ */
+
+static const char GIF87a[] = { /* ASCII GIF87a */
+ 0x47, 0x49, 0x46, 0x38, 0x37, 0x61, 0x00
+};
+static const char GIF89a[] = { /* ASCII GIF89a */
+ 0x47, 0x49, 0x46, 0x38, 0x39, 0x61, 0x00
+};
+#define GIF_TERMINATOR 0x3b /* ASCII ; */
+#define GIF_EXTENSION 0x21 /* ASCII ! */
+#define GIF_START 0x2c /* ASCII , */
+
+/*
+ * Flags used to notify that we've got inline data instead of a file to read
+ * from. Note that we need to figure out which type of inline data we've got
+ * before handing off to the GIF reading code; this is done in StringReadGIF.
+ */
+
+#define INLINE_DATA_BINARY ((const char *) 0x01)
+#define INLINE_DATA_BASE64 ((const char *) 0x02)
+
+/*
+ * 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 {
+ const char *fromData;
+ unsigned char workingBuffer[280];
+ struct {
+ int bytes;
+ int done;
+ unsigned int window;
+ int bitsInWindow;
+ unsigned char *c;
+ } reader;
+} GIFImageConfig;
+
+/*
+ * Type of a function used to do the writing to a file or buffer when
+ * serializing in the GIF format.
+ */
+
+typedef int (WriteBytesFunc) (ClientData clientData, const char *bytes,
+ int byteCount);
+
+/*
+ * The format record for the GIF file format:
+ */
+
+static int FileMatchGIF(Tcl_Channel chan, const char *fileName,
+ Tcl_Obj *format, int *widthPtr, int *heightPtr,
+ Tcl_Interp *interp);
+static int FileReadGIF(Tcl_Interp *interp, Tcl_Channel chan,
+ const char *fileName, Tcl_Obj *format,
+ Tk_PhotoHandle imageHandle, int destX, int destY,
+ int width, int height, int srcX, int srcY);
+static int StringMatchGIF(Tcl_Obj *dataObj, Tcl_Obj *format,
+ int *widthPtr, int *heightPtr, Tcl_Interp *interp);
+static int StringReadGIF(Tcl_Interp *interp, Tcl_Obj *dataObj,
+ Tcl_Obj *format, Tk_PhotoHandle imageHandle,
+ int destX, int destY, int width, int height,
+ int srcX, int srcY);
+static int FileWriteGIF(Tcl_Interp *interp, const char *filename,
+ Tcl_Obj *format, Tk_PhotoImageBlock *blockPtr);
+static int StringWriteGIF(Tcl_Interp *interp, Tcl_Obj *format,
+ Tk_PhotoImageBlock *blockPtr);
+static int CommonWriteGIF(Tcl_Interp *interp, ClientData clientData,
+ WriteBytesFunc *writeProc, Tcl_Obj *format,
+ Tk_PhotoImageBlock *blockPtr);
+
+Tk_PhotoImageFormat tkImgFmtGIF = {
+ "gif", /* name */
+ FileMatchGIF, /* fileMatchProc */
+ StringMatchGIF, /* stringMatchProc */
+ FileReadGIF, /* fileReadProc */
+ StringReadGIF, /* stringReadProc */
+ FileWriteGIF, /* fileWriteProc */
+ StringWriteGIF, /* stringWriteProc */
+ NULL
+};
+
+#define INTERLACE 0x40
+#define LOCALCOLORMAP 0x80
+#define BitSet(byte, bit) (((byte) & (bit)) == (bit))
+#define MAXCOLORMAPSIZE 256
+#define CM_RED 0
+#define CM_GREEN 1
+#define CM_BLUE 2
+#define CM_ALPHA 3
+#define MAX_LWZ_BITS 12
+#define LM_to_uint(a,b) (((b)<<8)|(a))
+
+/*
+ * Prototypes for local functions defined in this file:
+ */
+
+static int DoExtension(GIFImageConfig *gifConfPtr,
+ Tcl_Channel chan, int label, unsigned char *buffer,
+ int *transparent);
+static int GetCode(Tcl_Channel chan, int code_size, int flag,
+ GIFImageConfig *gifConfPtr);
+static int GetDataBlock(GIFImageConfig *gifConfPtr,
+ Tcl_Channel chan, unsigned char *buf);
+static int ReadColorMap(GIFImageConfig *gifConfPtr,
+ Tcl_Channel chan, int number,
+ unsigned char buffer[MAXCOLORMAPSIZE][4]);
+static int ReadGIFHeader(GIFImageConfig *gifConfPtr,
+ Tcl_Channel chan, int *widthPtr, int *heightPtr);
+static int ReadImage(GIFImageConfig *gifConfPtr,
+ Tcl_Interp *interp, unsigned char *imagePtr,
+ Tcl_Channel chan, int len, int rows,
+ unsigned char cmap[MAXCOLORMAPSIZE][4], int srcX,
+ int srcY, int interlace, int transparent);
+
+/*
+ * these are for the BASE64 image reader code only
+ */
+
+static int Fread(GIFImageConfig *gifConfPtr, unsigned char *dst,
+ size_t size, size_t count, Tcl_Channel chan);
+static int Mread(unsigned char *dst, size_t size, size_t count,
+ MFile *handle);
+static int Mgetc(MFile *handle);
+static int char64(int c);
+static void mInit(unsigned char *string, MFile *handle,
+ int length);
+
+/*
+ * Types, defines and variables needed to write and compress a GIF.
+ */
+
+#define LSB(a) ((unsigned char) (((short)(a)) & 0x00FF))
+#define MSB(a) ((unsigned char) (((short)(a)) >> 8))
+
+#define GIFBITS 12
+#define HSIZE 5003 /* 80% occupancy */
+
+#define DEFAULT_BACKGROUND_VALUE 0xD9
+
+typedef struct {
+ int ssize;
+ int csize;
+ int rsize;
+ unsigned char *pixelOffset;
+ int pixelSize;
+ int pixelPitch;
+ int greenOffset;
+ int blueOffset;
+ int alphaOffset;
+ int num;
+ unsigned char mapa[MAXCOLORMAPSIZE][3];
+} GifWriterState;
+
+typedef int (* ifunptr) (GifWriterState *statePtr);
+
+/*
+ * Support for compression of GIFs.
+ */
+
+#define MAXCODE(numBits) (((long) 1 << (numBits)) - 1)
+
+#ifdef SIGNED_COMPARE_SLOW
+#define U(x) ((unsigned) (x))
+#else
+#define U(x) (x)
+#endif
+
+typedef struct {
+ int numBits; /* Number of bits/code. */
+ long maxCode; /* Maximum code, given numBits. */
+ int hashTable[HSIZE];
+ unsigned int codeTable[HSIZE];
+ long hSize; /* For dynamic table sizing. */
+
+ /*
+ * To save much memory, we overlay the table used by compress() with those
+ * used by decompress(). The tab_prefix table is the same size and type as
+ * the codeTable. The tab_suffix table needs 2**GIFBITS characters. We get
+ * this from the beginning of hashTable. The output stack uses the rest of
+ * hashTable, and contains characters. There is plenty of room for any
+ * possible stack (stack used to be 8000 characters).
+ */
+
+ int freeEntry; /* First unused entry. */
+
+ /*
+ * Block compression parameters. After all codes are used up, and
+ * compression rate changes, start over.
+ */
+
+ int clearFlag;
+
+ int offset;
+ unsigned int inCount; /* Length of input */
+ unsigned int outCount; /* # of codes output (for debugging) */
+
+ /*
+ * Algorithm: use open addressing double hashing (no chaining) on the
+ * prefix code / next character combination. We do a variant of Knuth's
+ * algorithm D (vol. 3, sec. 6.4) along with G. Knott's relatively-prime
+ * secondary probe. Here, the modular division first probe is gives way to
+ * a faster exclusive-or manipulation. Also do block compression with an
+ * adaptive reset, whereby the code table is cleared when the compression
+ * ratio decreases, but after the table fills. The variable-length output
+ * codes are re-sized at this point, and a special CLEAR code is generated
+ * for the decompressor. Late addition: construct the table according to
+ * file size for noticeable speed improvement on small files. Please
+ * direct questions about this implementation to ames!jaw.
+ */
+
+ int initialBits;
+ ClientData destination;
+ WriteBytesFunc *writeProc;
+
+ int clearCode;
+ int eofCode;
+
+ unsigned long currentAccumulated;
+ int currentBits;
+
+ /*
+ * Number of characters so far in this 'packet'
+ */
+
+ int accumulatedByteCount;
+
+ /*
+ * Define the storage for the packet accumulator
+ */
+
+ unsigned char packetAccumulator[256];
+} GIFState_t;
+
+/*
+ * Definition of new functions to write GIFs
+ */
+
+static int ColorNumber(GifWriterState *statePtr,
+ int red, int green, int blue);
+static void Compress(int initBits, ClientData handle,
+ WriteBytesFunc *writeProc, ifunptr readValue,
+ GifWriterState *statePtr);
+static int IsNewColor(GifWriterState *statePtr,
+ int red, int green, int blue);
+static void SaveMap(GifWriterState *statePtr,
+ Tk_PhotoImageBlock *blockPtr);
+static int ReadValue(GifWriterState *statePtr);
+static WriteBytesFunc WriteToChannel;
+static WriteBytesFunc WriteToByteArray;
+static void Output(GIFState_t *statePtr, long code);
+static void ClearForBlock(GIFState_t *statePtr);
+static void ClearHashTable(GIFState_t *statePtr, int hSize);
+static void CharInit(GIFState_t *statePtr);
+static void CharOut(GIFState_t *statePtr, int c);
+static void FlushChar(GIFState_t *statePtr);
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * FileMatchGIF --
+ *
+ * This function is invoked by the photo image type to see if a file
+ * contains image data in GIF format.
+ *
+ * Results:
+ * The return value is 1 if the first characters in file f look like GIF
+ * data, and 0 otherwise.
+ *
+ * Side effects:
+ * The access position in f may change.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+FileMatchGIF(
+ Tcl_Channel chan, /* The image file, open for reading. */
+ const char *fileName, /* The name of the image file. */
+ Tcl_Obj *format, /* User-specified format object, or NULL. */
+ int *widthPtr, int *heightPtr,
+ /* The dimensions of the image are returned
+ * here if the file is a valid raw GIF file. */
+ Tcl_Interp *interp) /* not used */
+{
+ GIFImageConfig gifConf;
+
+ memset(&gifConf, 0, sizeof(GIFImageConfig));
+ return ReadGIFHeader(&gifConf, chan, widthPtr, heightPtr);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * FileReadGIF --
+ *
+ * This function is called by the photo image type to read GIF format
+ * data from a file and write it into a given photo image.
+ *
+ * Results:
+ * A standard TCL completion code. If TCL_ERROR is returned then an error
+ * message is left in the interp's result.
+ *
+ * Side effects:
+ * The access position in file f is changed, and new data is added to the
+ * image given by imageHandle.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+FileReadGIF(
+ Tcl_Interp *interp, /* Interpreter to use for reporting errors. */
+ Tcl_Channel chan, /* The image file, open for reading. */
+ const char *fileName, /* The name of the image file. */
+ Tcl_Obj *format, /* User-specified format object, or NULL. */
+ Tk_PhotoHandle imageHandle, /* The photo image to write into. */
+ int destX, int destY, /* Coordinates of top-left pixel in photo
+ * image to be written to. */
+ int width, int height, /* Dimensions of block of photo image to be
+ * written to. */
+ int srcX, int srcY) /* Coordinates of top-left pixel to be used in
+ * image being read. */
+{
+ int fileWidth, fileHeight, imageWidth, imageHeight;
+ unsigned int nBytes;
+ int index = 0, argc = 0, i, result = TCL_ERROR;
+ Tcl_Obj **objv;
+ unsigned char buf[100];
+ unsigned char *trashBuffer = NULL;
+ int bitPixel;
+ unsigned char colorMap[MAXCOLORMAPSIZE][4];
+ int transparent = -1;
+ static const char *const optionStrings[] = {
+ "-index", NULL
+ };
+ GIFImageConfig gifConf, *gifConfPtr = &gifConf;
+
+ /*
+ * Decode the magic used to convey when we're sourcing data from a string
+ * source and not a file.
+ */
+
+ memset(colorMap, 0, MAXCOLORMAPSIZE*4);
+ memset(gifConfPtr, 0, sizeof(GIFImageConfig));
+ if (fileName == INLINE_DATA_BINARY || fileName == INLINE_DATA_BASE64) {
+ gifConfPtr->fromData = fileName;
+ fileName = "inline data";
+ }
+
+ /*
+ * Parse the format string to get options.
+ */
+
+ if (format && Tcl_ListObjGetElements(interp, format,
+ &argc, &objv) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ for (i = 1; i < argc; i++) {
+ int optionIdx;
+ if (Tcl_GetIndexFromObjStruct(interp, objv[i], optionStrings,
+ sizeof(char *), "option name", 0, &optionIdx) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (i == (argc-1)) {
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "no value given for \"%s\" option",
+ Tcl_GetString(objv[i])));
+ Tcl_SetErrorCode(interp, "TK", "IMAGE", "GIF", "OPT_VALUE", NULL);
+ return TCL_ERROR;
+ }
+ if (Tcl_GetIntFromObj(interp, objv[++i], &index) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ }
+
+ /*
+ * Read the GIF file header and check for some sanity.
+ */
+
+ if (!ReadGIFHeader(gifConfPtr, chan, &fileWidth, &fileHeight)) {
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "couldn't read GIF header from file \"%s\"", fileName));
+ Tcl_SetErrorCode(interp, "TK", "IMAGE", "GIF", "HEADER", NULL);
+ return TCL_ERROR;
+ }
+ if ((fileWidth <= 0) || (fileHeight <= 0)) {
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "GIF image file \"%s\" has dimension(s) <= 0", fileName));
+ Tcl_SetErrorCode(interp, "TK", "IMAGE", "GIF", "BOGUS_SIZE", NULL);
+ return TCL_ERROR;
+ }
+
+ /*
+ * Get the general colormap information.
+ */
+
+ if (Fread(gifConfPtr, buf, 1, 3, chan) != 3) {
+ return TCL_OK;
+ }
+ bitPixel = 2 << (buf[0] & 0x07);
+
+ if (BitSet(buf[0], LOCALCOLORMAP)) { /* Global Colormap */
+ if (!ReadColorMap(gifConfPtr, chan, bitPixel, colorMap)) {
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "error reading color map", -1));
+ Tcl_SetErrorCode(interp, "TK", "IMAGE", "GIF", "COLOR_MAP", NULL);
+ return TCL_ERROR;
+ }
+ }
+
+ if ((srcX + width) > fileWidth) {
+ width = fileWidth - srcX;
+ }
+ if ((srcY + height) > fileHeight) {
+ height = fileHeight - srcY;
+ }
+ if ((width <= 0) || (height <= 0)
+ || (srcX >= fileWidth) || (srcY >= fileHeight)) {
+ return TCL_OK;
+ }
+
+ /*
+ * Make sure we have enough space in the photo image to hold the data from
+ * the GIF.
+ */
+
+ if (Tk_PhotoExpand(interp, imageHandle,
+ destX + width, destY + height) != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ /*
+ * Search for the frame from the GIF to display.
+ */
+
+ while (1) {
+ if (Fread(gifConfPtr, buf, 1, 1, chan) != 1) {
+ /*
+ * Premature end of image.
+ */
+
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "premature end of image data for this index", -1));
+ Tcl_SetErrorCode(interp, "TK", "IMAGE", "GIF", "PREMATURE_END",
+ NULL);
+ goto error;
+ }
+
+ switch (buf[0]) {
+ case GIF_TERMINATOR:
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "no image data for this index", -1));
+ Tcl_SetErrorCode(interp, "TK", "IMAGE", "GIF", "NO_DATA", NULL);
+ goto error;
+
+ case GIF_EXTENSION:
+ /*
+ * This is a GIF extension.
+ */
+
+ if (Fread(gifConfPtr, buf, 1, 1, chan) != 1) {
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "error reading extension function code in GIF image",
+ -1));
+ Tcl_SetErrorCode(interp, "TK", "IMAGE", "GIF", "BAD_EXT",
+ NULL);
+ goto error;
+ }
+ if (DoExtension(gifConfPtr, chan, buf[0],
+ gifConfPtr->workingBuffer, &transparent) < 0) {
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "error reading extension in GIF image", -1));
+ Tcl_SetErrorCode(interp, "TK", "IMAGE", "GIF", "BAD_EXT",
+ NULL);
+ goto error;
+ }
+ continue;
+ case GIF_START:
+ if (Fread(gifConfPtr, buf, 1, 9, chan) != 9) {
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "couldn't read left/top/width/height in GIF image",
+ -1));
+ Tcl_SetErrorCode(interp, "TK", "IMAGE", "GIF", "DIMENSIONS",
+ NULL);
+ goto error;
+ }
+ break;
+ default:
+ /*
+ * Not a valid start character; ignore it.
+ */
+
+ continue;
+ }
+
+ /*
+ * We've read the header for a GIF frame. Work out what we are going
+ * to do about it.
+ */
+
+ imageWidth = LM_to_uint(buf[4], buf[5]);
+ imageHeight = LM_to_uint(buf[6], buf[7]);
+ bitPixel = 1 << ((buf[8] & 0x07) + 1);
+
+ if (index--) {
+ /*
+ * This is not the GIF frame we want to read: skip it.
+ */
+
+ if (BitSet(buf[8], LOCALCOLORMAP)) {
+ if (!ReadColorMap(gifConfPtr, chan, bitPixel, colorMap)) {
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "error reading color map", -1));
+ Tcl_SetErrorCode(interp, "TK", "IMAGE", "GIF",
+ "COLOR_MAP", NULL);
+ goto error;
+ }
+ }
+
+ /*
+ * If we've not yet allocated a trash buffer, do so now.
+ */
+
+ if (trashBuffer == NULL) {
+ if (fileWidth > (int)((UINT_MAX/3)/fileHeight)) {
+ goto error;
+ }
+ nBytes = fileWidth * fileHeight * 3;
+ trashBuffer = ckalloc(nBytes);
+ if (trashBuffer) {
+ memset(trashBuffer, 0, 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(gifConfPtr, interp, trashBuffer, chan, imageWidth,
+ imageHeight, colorMap, 0, 0, 0, -1) != TCL_OK) {
+ goto error;
+ }
+ continue;
+ }
+ break;
+ }
+
+ /*
+ * Found the frame we want to read. Next, check for a local color map for
+ * this frame.
+ */
+
+ if (BitSet(buf[8], LOCALCOLORMAP)) {
+ if (!ReadColorMap(gifConfPtr, chan, bitPixel, colorMap)) {
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "error reading color map", -1));
+ Tcl_SetErrorCode(interp, "TK", "IMAGE", "GIF", "COLOR_MAP", NULL);
+ goto error;
+ }
+ }
+
+ /*
+ * Extract the location within the overall visible image to put the data
+ * in this frame, together with the size of this frame.
+ */
+
+ index = LM_to_uint(buf[0], buf[1]);
+ srcX -= index;
+ if (srcX<0) {
+ destX -= srcX; width += srcX;
+ srcX = 0;
+ }
+
+ if (width > imageWidth) {
+ width = imageWidth;
+ }
+
+ index = LM_to_uint(buf[2], buf[3]);
+ srcY -= index;
+ if (index > srcY) {
+ destY -= srcY; height += srcY;
+ srcY = 0;
+ }
+ if (height > imageHeight) {
+ height = imageHeight;
+ }
+
+ if ((width > 0) && (height > 0)) {
+ Tk_PhotoImageBlock block;
+
+ /*
+ * Read the data and put it into the photo buffer for display by the
+ * general image machinery.
+ */
+
+ block.width = width;
+ block.height = height;
+ block.pixelSize = (transparent>=0) ? 4 : 3;
+ block.offset[0] = 0;
+ block.offset[1] = 1;
+ block.offset[2] = 2;
+ block.offset[3] = (transparent>=0) ? 3 : 0;
+ if (imageWidth > INT_MAX/block.pixelSize) {
+ goto error;
+ }
+ block.pitch = block.pixelSize * imageWidth;
+ if (imageHeight > (int)(UINT_MAX/block.pitch)) {
+ goto error;
+ }
+ nBytes = block.pitch * imageHeight;
+ block.pixelPtr = ckalloc(nBytes);
+ if (block.pixelPtr) {
+ memset(block.pixelPtr, 0, nBytes);
+ }
+
+ if (ReadImage(gifConfPtr, interp, block.pixelPtr, chan, imageWidth,
+ imageHeight, colorMap, srcX, srcY, BitSet(buf[8], INTERLACE),
+ transparent) != TCL_OK) {
+ ckfree(block.pixelPtr);
+ goto error;
+ }
+ if (Tk_PhotoPutBlock(interp, imageHandle, &block, destX, destY,
+ width, height, TK_PHOTO_COMPOSITE_SET) != TCL_OK) {
+ ckfree(block.pixelPtr);
+ goto error;
+ }
+ ckfree(block.pixelPtr);
+ }
+
+ /*
+ * We've successfully read the GIF frame (or there was nothing to read,
+ * which suits as well). We're done.
+ */
+
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(tkImgFmtGIF.name, -1));
+ result = TCL_OK;
+
+ error:
+ /*
+ * If a trash buffer has been allocated, free it now.
+ */
+
+ if (trashBuffer != NULL) {
+ ckfree(trashBuffer);
+ }
+ return result;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * StringMatchGIF --
+ *
+ * This function is invoked by the photo image type to see if an object
+ * contains image data in GIF format.
+ *
+ * Results:
+ * The return value is 1 if the first characters in the data are like GIF
+ * data, and 0 otherwise.
+ *
+ * Side effects:
+ * The size of the image is placed in widthPtr and heightPtr.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+StringMatchGIF(
+ Tcl_Obj *dataObj, /* the object containing the image data */
+ Tcl_Obj *format, /* the image format object, or NULL */
+ int *widthPtr, /* where to put the string width */
+ int *heightPtr, /* where to put the string height */
+ Tcl_Interp *interp) /* not used */
+{
+ unsigned char *data, header[10];
+ int got, length;
+ MFile handle;
+
+ data = Tcl_GetByteArrayFromObj(dataObj, &length);
+
+ /*
+ * Header is a minimum of 10 bytes.
+ */
+
+ if (length < 10) {
+ return 0;
+ }
+
+ /*
+ * Check whether the data is Base64 encoded.
+ */
+
+ if ((strncmp(GIF87a, (char *) data, 6) != 0) &&
+ (strncmp(GIF89a, (char *) data, 6) != 0)) {
+ /*
+ * Try interpreting the data as Base64 encoded
+ */
+
+ mInit((unsigned char *) data, &handle, length);
+ got = Mread(header, 10, 1, &handle);
+ if (got != 10 ||
+ ((strncmp(GIF87a, (char *) header, 6) != 0)
+ && (strncmp(GIF89a, (char *) header, 6) != 0))) {
+ return 0;
+ }
+ } else {
+ memcpy(header, data, 10);
+ }
+ *widthPtr = LM_to_uint(header[6], header[7]);
+ *heightPtr = LM_to_uint(header[8], header[9]);
+ return 1;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * StringReadGIF --
+ *
+ * This function is called by the photo image type to read GIF format
+ * data from an object, optionally base64 encoded, and give it to the
+ * photo image.
+ *
+ * Results:
+ * A standard TCL completion code. If TCL_ERROR is returned then an error
+ * message is left in the interp's result.
+ *
+ * Side effects:
+ * New data is added to the image given by imageHandle. This function
+ * calls FileReadGIF by redefining the operation of fprintf temporarily.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+StringReadGIF(
+ Tcl_Interp *interp, /* interpreter for reporting errors in */
+ Tcl_Obj *dataObj, /* object containing the image */
+ Tcl_Obj *format, /* format object, or NULL */
+ Tk_PhotoHandle imageHandle, /* the image to write this data into */
+ int destX, int destY, /* The rectangular region of the */
+ int width, int height, /* image to copy */
+ int srcX, int srcY)
+{
+ MFile handle, *hdlPtr = &handle;
+ int length;
+ const char *xferFormat;
+ unsigned char *data = Tcl_GetByteArrayFromObj(dataObj, &length);
+
+ mInit(data, hdlPtr, length);
+
+ /*
+ * Check whether the data is Base64 encoded by doing a character-by-
+ * charcter comparison with the binary-format headers; BASE64-encoded
+ * never matches (matching the other way is harder because of potential
+ * padding of the BASE64 data).
+ */
+
+ if (strncmp(GIF87a, (char *) data, 6)
+ && strncmp(GIF89a, (char *) data, 6)) {
+ xferFormat = INLINE_DATA_BASE64;
+ } else {
+ xferFormat = INLINE_DATA_BINARY;
+ }
+
+ /*
+ * Fall through to the file reader now that we have a correctly-configured
+ * pseudo-channel to pull the data from.
+ */
+
+ return FileReadGIF(interp, (Tcl_Channel) hdlPtr, xferFormat, format,
+ imageHandle, destX, destY, width, height, srcX, srcY);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ReadGIFHeader --
+ *
+ * This function reads the GIF header from the beginning of a GIF file
+ * and returns the dimensions of the image.
+ *
+ * Results:
+ * The return value is 1 if file "f" appears to start with a valid GIF
+ * header, 0 otherwise. If the header is valid, then *widthPtr and
+ * *heightPtr are modified to hold the dimensions of the image.
+ *
+ * Side effects:
+ * The access position in f advances.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+ReadGIFHeader(
+ GIFImageConfig *gifConfPtr,
+ Tcl_Channel chan, /* Image file to read the header from */
+ int *widthPtr, int *heightPtr)
+ /* The dimensions of the image are returned
+ * here. */
+{
+ unsigned char buf[7];
+
+ if ((Fread(gifConfPtr, buf, 1, 6, chan) != 6)
+ || ((strncmp(GIF87a, (char *) buf, 6) != 0)
+ && (strncmp(GIF89a, (char *) buf, 6) != 0))) {
+ return 0;
+ }
+
+ if (Fread(gifConfPtr, buf, 1, 4, chan) != 4) {
+ return 0;
+ }
+
+ *widthPtr = LM_to_uint(buf[0], buf[1]);
+ *heightPtr = LM_to_uint(buf[2], buf[3]);
+ return 1;
+}
+
+/*
+ *-----------------------------------------------------------------
+ * The code below is copied from the giftoppm program and modified just
+ * slightly.
+ *-----------------------------------------------------------------
+ */
+
+static int
+ReadColorMap(
+ GIFImageConfig *gifConfPtr,
+ Tcl_Channel chan,
+ int number,
+ unsigned char buffer[MAXCOLORMAPSIZE][4])
+{
+ int i;
+ unsigned char rgb[3];
+
+ for (i = 0; i < number; ++i) {
+ if (Fread(gifConfPtr, rgb, sizeof(rgb), 1, chan) <= 0) {
+ return 0;
+ }
+
+ if (buffer) {
+ buffer[i][CM_RED] = rgb[0];
+ buffer[i][CM_GREEN] = rgb[1];
+ buffer[i][CM_BLUE] = rgb[2];
+ buffer[i][CM_ALPHA] = 255;
+ }
+ }
+ return 1;
+}
+
+static int
+DoExtension(
+ GIFImageConfig *gifConfPtr,
+ Tcl_Channel chan,
+ int label,
+ unsigned char *buf,
+ int *transparent)
+{
+ int count;
+
+ switch (label) {
+ case 0x01: /* Plain Text Extension */
+ break;
+
+ case 0xff: /* Application Extension */
+ break;
+
+ case 0xfe: /* Comment Extension */
+ do {
+ count = GetDataBlock(gifConfPtr, chan, buf);
+ } while (count > 0);
+ return count;
+
+ case 0xf9: /* Graphic Control Extension */
+ count = GetDataBlock(gifConfPtr, chan, buf);
+ if (count < 0) {
+ return 1;
+ }
+ if ((buf[0] & 0x1) != 0) {
+ *transparent = buf[3];
+ }
+
+ do {
+ count = GetDataBlock(gifConfPtr, chan, buf);
+ } while (count > 0);
+ return count;
+ }
+
+ do {
+ count = GetDataBlock(gifConfPtr, chan, buf);
+ } while (count > 0);
+ return count;
+}
+
+static int
+GetDataBlock(
+ GIFImageConfig *gifConfPtr,
+ Tcl_Channel chan,
+ unsigned char *buf)
+{
+ unsigned char count;
+
+ if (Fread(gifConfPtr, &count, 1, 1, chan) <= 0) {
+ return -1;
+ }
+
+ if ((count != 0) && (Fread(gifConfPtr, buf, count, 1, chan) <= 0)) {
+ return -1;
+ }
+
+ return count;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ReadImage --
+ *
+ * Process a GIF image from a given source, with a given height, width,
+ * transparency, etc.
+ *
+ * This code is based on the code found in the ImageMagick GIF decoder,
+ * which is (c) 2000 ImageMagick Studio.
+ *
+ * Some thoughts on our implementation:
+ * It sure would be nice if ReadImage didn't take 11 parameters! I think
+ * that if we were smarter, we could avoid doing that.
+ *
+ * Possible further optimizations: we could pull the GetCode function
+ * directly into ReadImage, which would improve our speed.
+ *
+ * Results:
+ * Processes a GIF image and loads the pixel data into a memory array.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+ReadImage(
+ GIFImageConfig *gifConfPtr,
+ Tcl_Interp *interp,
+ unsigned char *imagePtr,
+ Tcl_Channel chan,
+ int len, int rows,
+ unsigned char cmap[MAXCOLORMAPSIZE][4],
+ int srcX, int srcY,
+ int interlace,
+ int transparent)
+{
+ unsigned char initialCodeSize;
+ int xpos = 0, ypos = 0, pass = 0, i;
+ register unsigned char *pixelPtr;
+ static const int interlaceStep[] = { 8, 8, 4, 2 };
+ static const int interlaceStart[] = { 0, 4, 2, 1 };
+ unsigned short prefix[(1 << MAX_LWZ_BITS)];
+ unsigned char append[(1 << MAX_LWZ_BITS)];
+ unsigned char stack[(1 << MAX_LWZ_BITS)*2];
+ register unsigned char *top;
+ int codeSize, clearCode, inCode, endCode, oldCode, maxCode;
+ int code, firstCode, v;
+
+ /*
+ * Initialize the decoder
+ */
+
+ if (Fread(gifConfPtr, &initialCodeSize, 1, 1, chan) <= 0) {
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "error reading GIF image: %s", Tcl_PosixError(interp)));
+ return TCL_ERROR;
+ }
+
+ if (initialCodeSize > MAX_LWZ_BITS) {
+ Tcl_SetObjResult(interp, Tcl_NewStringObj("malformed image", -1));
+ Tcl_SetErrorCode(interp, "TK", "IMAGE", "GIF", "MALFORMED", NULL);
+ return TCL_ERROR;
+ }
+
+ if (transparent != -1) {
+ cmap[transparent][CM_RED] = 0;
+ cmap[transparent][CM_GREEN] = 0;
+ cmap[transparent][CM_BLUE] = 0;
+ cmap[transparent][CM_ALPHA] = 0;
+ }
+
+ pixelPtr = imagePtr;
+
+ /*
+ * Initialize the decoder.
+ *
+ * Set values for "special" numbers:
+ * clear code reset the decoder
+ * end code stop decoding
+ * code size size of the next code to retrieve
+ * max code next available table position
+ */
+
+ clearCode = 1 << (int) initialCodeSize;
+ endCode = clearCode + 1;
+ codeSize = (int) initialCodeSize + 1;
+ maxCode = clearCode + 2;
+ oldCode = -1;
+ firstCode = -1;
+
+ memset(prefix, 0, (1 << MAX_LWZ_BITS) * sizeof(short));
+ memset(append, 0, (1 << MAX_LWZ_BITS) * sizeof(char));
+ for (i = 0; i < clearCode; i++) {
+ append[i] = i;
+ }
+ top = stack;
+
+ GetCode(chan, 0, 1, gifConfPtr);
+
+ /*
+ * Read until we finish the image
+ */
+
+ for (i = 0, ypos = 0; i < rows; i++) {
+ for (xpos = 0; xpos < len; ) {
+ if (top == stack) {
+ /*
+ * Bummer - our stack is empty. Now we have to work!
+ */
+
+ code = GetCode(chan, codeSize, 0, gifConfPtr);
+ if (code < 0) {
+ return TCL_OK;
+ }
+
+ if (code > maxCode || code == endCode) {
+ /*
+ * If we're doing things right, we should never receive a
+ * code that is greater than our current maximum code. If
+ * we do, bail, because our decoder does not yet have that
+ * code set up.
+ *
+ * If the code is the magic endCode value, quit.
+ */
+
+ return TCL_OK;
+ }
+
+ if (code == clearCode) {
+ /*
+ * Reset the decoder.
+ */
+
+ codeSize = initialCodeSize + 1;
+ maxCode = clearCode + 2;
+ oldCode = -1;
+ continue;
+ }
+
+ if (oldCode == -1) {
+ /*
+ * Last pass reset the decoder, so the first code we see
+ * must be a singleton. Seed the stack with it, and set up
+ * the old/first code pointers for insertion into the
+ * string table. We can't just roll this into the
+ * clearCode test above, because at that point we have not
+ * yet read the next code.
+ */
+
+ *top++ = append[code];
+ oldCode = code;
+ firstCode = code;
+ continue;
+ }
+
+ inCode = code;
+
+ if (code == maxCode) {
+ /*
+ * maxCode is always one bigger than our highest assigned
+ * code. If the code we see is equal to maxCode, then we
+ * are about to add a new string to the table. ???
+ */
+
+ *top++ = firstCode;
+ code = oldCode;
+ }
+
+ while (code > clearCode) {
+ /*
+ * Populate the stack by tracing the string in the string
+ * table from its tail to its head
+ */
+
+ *top++ = append[code];
+ code = prefix[code];
+ }
+ firstCode = append[code];
+
+ /*
+ * If there's no more room in our string table, quit.
+ * Otherwise, add a new string to the table
+ */
+
+ if (maxCode >= (1 << MAX_LWZ_BITS)) {
+ return TCL_OK;
+ }
+
+ /*
+ * Push the head of the string onto the stack.
+ */
+
+ *top++ = firstCode;
+
+ /*
+ * Add a new string to the string table
+ */
+
+ prefix[maxCode] = oldCode;
+ append[maxCode] = firstCode;
+ maxCode++;
+
+ /*
+ * maxCode tells us the maximum code value we can accept. If
+ * we see that we need more bits to represent it than we are
+ * requesting from the unpacker, we need to increase the
+ * number we ask for.
+ */
+
+ if ((maxCode >= (1 << codeSize))
+ && (maxCode < (1<<MAX_LWZ_BITS))) {
+ codeSize++;
+ }
+ oldCode = inCode;
+ }
+
+ /*
+ * Pop the next color index off the stack.
+ */
+
+ v = *(--top);
+ if (v < 0) {
+ return TCL_OK;
+ }
+
+ /*
+ * If pixelPtr is null, we're skipping this image (presumably
+ * there are more in the file and we will be called to read one of
+ * them later)
+ */
+
+ *pixelPtr++ = cmap[v][CM_RED];
+ *pixelPtr++ = cmap[v][CM_GREEN];
+ *pixelPtr++ = cmap[v][CM_BLUE];
+ if (transparent >= 0) {
+ *pixelPtr++ = cmap[v][CM_ALPHA];
+ }
+ xpos++;
+
+ }
+
+ /*
+ * If interlacing, the next ypos is not just +1.
+ */
+
+ if (interlace) {
+ ypos += interlaceStep[pass];
+ while (ypos >= rows) {
+ pass++;
+ if (pass > 3) {
+ return TCL_OK;
+ }
+ ypos = interlaceStart[pass];
+ }
+ } else {
+ ypos++;
+ }
+ pixelPtr = imagePtr + (ypos) * len * ((transparent>=0)?4:3);
+ }
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * GetCode --
+ *
+ * Extract the next compression code from the file. In GIF's, the
+ * compression codes are between 3 and 12 bits long and are then packed
+ * into 8 bit bytes, left to right, for example:
+ * bbbaaaaa
+ * dcccccbb
+ * eeeedddd
+ * ...
+ * We use a byte buffer read from the file and a sliding window to unpack
+ * the bytes. Thanks to ImageMagick for the sliding window idea.
+ * args: chan the channel to read from
+ * code_size size of the code to extract
+ * flag boolean indicating whether the extractor should be
+ * reset or not
+ *
+ * Results:
+ * code the next compression code
+ *
+ * Side effects:
+ * May consume more input from chan.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+GetCode(
+ Tcl_Channel chan,
+ int code_size,
+ int flag,
+ GIFImageConfig *gifConfPtr)
+{
+ int ret;
+
+ if (flag) {
+ /*
+ * Initialize the decoder.
+ */
+
+ gifConfPtr->reader.bitsInWindow = 0;
+ gifConfPtr->reader.bytes = 0;
+ gifConfPtr->reader.window = 0;
+ gifConfPtr->reader.done = 0;
+ gifConfPtr->reader.c = NULL;
+ return 0;
+ }
+
+ while (gifConfPtr->reader.bitsInWindow < code_size) {
+ /*
+ * Not enough bits in our window to cover the request.
+ */
+
+ if (gifConfPtr->reader.done) {
+ return -1;
+ }
+ if (gifConfPtr->reader.bytes == 0) {
+ /*
+ * Not enough bytes in our buffer to add to the window.
+ */
+
+ gifConfPtr->reader.bytes =
+ GetDataBlock(gifConfPtr, chan, gifConfPtr->workingBuffer);
+ gifConfPtr->reader.c = gifConfPtr->workingBuffer;
+ if (gifConfPtr->reader.bytes <= 0) {
+ gifConfPtr->reader.done = 1;
+ break;
+ }
+ }
+
+ /*
+ * Tack another byte onto the window, see if that's enough.
+ */
+
+ gifConfPtr->reader.window +=
+ (*gifConfPtr->reader.c) << gifConfPtr->reader.bitsInWindow;
+ gifConfPtr->reader.c++;
+ gifConfPtr->reader.bitsInWindow += 8;
+ gifConfPtr->reader.bytes--;
+ }
+
+ /*
+ * The next code will always be the last code_size bits of the window.
+ */
+
+ ret = gifConfPtr->reader.window & ((1 << code_size) - 1);
+
+ /*
+ * Shift data in the window to put the next code at the end.
+ */
+
+ gifConfPtr->reader.window >>= code_size;
+ gifConfPtr->reader.bitsInWindow -= code_size;
+ return ret;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Minit -- --
+ *
+ * This function initializes a base64 decoder handle
+ *
+ * Results:
+ * None
+ *
+ * Side effects:
+ * The base64 handle is initialized
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+mInit(
+ unsigned char *string, /* string containing initial mmencoded data */
+ MFile *handle, /* mmdecode "file" handle */
+ int length) /* Number of bytes in string */
+{
+ handle->data = string;
+ handle->state = 0;
+ handle->c = 0;
+ handle->length = length;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Mread --
+ *
+ * This function is invoked by the GIF file reader as a temporary
+ * replacement for "fread", to get GIF data out of a string (using
+ * Mgetc).
+ *
+ * Results:
+ * The return value is the number of characters "read"
+ *
+ * Side effects:
+ * The base64 handle will change state.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+Mread(
+ unsigned char *dst, /* where to put the result */
+ size_t chunkSize, /* size of each transfer */
+ size_t numChunks, /* number of chunks */
+ MFile *handle) /* mmdecode "file" handle */
+{
+ register int i, c;
+ int count = chunkSize * numChunks;
+
+ for (i=0; i<count && (c=Mgetc(handle)) != GIF_DONE; i++) {
+ *dst++ = c;
+ }
+ return i;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Mgetc --
+ *
+ * This function gets the next decoded character from an mmencode handle.
+ * This causes at least 1 character to be "read" from the encoded string.
+ *
+ * Results:
+ * The next byte (or GIF_DONE) is returned.
+ *
+ * Side effects:
+ * The base64 handle will change state.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+Mgetc(
+ MFile *handle) /* Handle containing decoder data and state */
+{
+ int c;
+ int result = 0; /* Initialization needed only to prevent gcc
+ * compiler warning. */
+
+ if (handle->state == GIF_DONE) {
+ return GIF_DONE;
+ }
+
+ do {
+ if (handle->length-- <= 0) {
+ return GIF_DONE;
+ }
+ c = char64(*handle->data);
+ handle->data++;
+ } while (c == GIF_SPACE);
+
+ if (c > GIF_SPECIAL) {
+ handle->state = GIF_DONE;
+ return handle->c;
+ }
+
+ switch (handle->state++) {
+ case 0:
+ handle->c = c<<2;
+ result = Mgetc(handle);
+ break;
+ case 1:
+ result = handle->c | (c>>4);
+ handle->c = (c&0xF)<<4;
+ break;
+ case 2:
+ result = handle->c | (c>>2);
+ handle->c = (c&0x3) << 6;
+ break;
+ case 3:
+ result = handle->c | c;
+ handle->state = 0;
+ break;
+ }
+ return result;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * char64 --
+ *
+ * This function converts a base64 ascii character into its binary
+ * equivalent. This code is a slightly modified version of the char64
+ * function in N. Borenstein's metamail decoder.
+ *
+ * Results:
+ * The binary value, or an error code.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+char64(
+ int c)
+{
+ switch(c) {
+ case 'A': return 0; case 'B': return 1; case 'C': return 2;
+ case 'D': return 3; case 'E': return 4; case 'F': return 5;
+ case 'G': return 6; case 'H': return 7; case 'I': return 8;
+ case 'J': return 9; case 'K': return 10; case 'L': return 11;
+ case 'M': return 12; case 'N': return 13; case 'O': return 14;
+ case 'P': return 15; case 'Q': return 16; case 'R': return 17;
+ case 'S': return 18; case 'T': return 19; case 'U': return 20;
+ case 'V': return 21; case 'W': return 22; case 'X': return 23;
+ case 'Y': return 24; case 'Z': return 25; case 'a': return 26;
+ case 'b': return 27; case 'c': return 28; case 'd': return 29;
+ case 'e': return 30; case 'f': return 31; case 'g': return 32;
+ case 'h': return 33; case 'i': return 34; case 'j': return 35;
+ case 'k': return 36; case 'l': return 37; case 'm': return 38;
+ case 'n': return 39; case 'o': return 40; case 'p': return 41;
+ case 'q': return 42; case 'r': return 43; case 's': return 44;
+ case 't': return 45; case 'u': return 46; case 'v': return 47;
+ case 'w': return 48; case 'x': return 49; case 'y': return 50;
+ case 'z': return 51; case '0': return 52; case '1': return 53;
+ case '2': return 54; case '3': return 55; case '4': return 56;
+ case '5': return 57; case '6': return 58; case '7': return 59;
+ case '8': return 60; case '9': return 61; case '+': return 62;
+ case '/': return 63;
+
+ case ' ': case '\t': case '\n': case '\r': case '\f':
+ return GIF_SPACE;
+ case '=':
+ return GIF_PAD;
+ case '\0':
+ return GIF_DONE;
+ default:
+ return GIF_BAD;
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Fread --
+ *
+ * This function calls either fread or Mread to read data from a file or
+ * a base64 encoded string.
+ *
+ * Results: - same as POSIX fread() or Tcl Tcl_Read()
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+Fread(
+ GIFImageConfig *gifConfPtr,
+ unsigned char *dst, /* where to put the result */
+ size_t hunk, size_t count, /* how many */
+ Tcl_Channel chan)
+{
+ if (gifConfPtr->fromData == INLINE_DATA_BASE64) {
+ return Mread(dst, hunk, count, (MFile *) chan);
+ }
+
+ if (gifConfPtr->fromData == INLINE_DATA_BINARY) {
+ MFile *handle = (MFile *) chan;
+
+ if (handle->length <= 0 || (size_t) handle->length < hunk*count) {
+ return -1;
+ }
+ memcpy(dst, handle->data, (size_t) (hunk * count));
+ handle->data += hunk * count;
+ return (int)(hunk * count);
+ }
+
+ /*
+ * Otherwise we've got a real file to read.
+ */
+
+ 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)
+ * by Jan Nijtmans <nijtmans@users.sourceforge.net>
+ *
+ *----------------------------------------------------------------------
+ * FileWriteGIF-
+ *
+ * This function 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 the interp's result.
+ *
+ *----------------------------------------------------------------------
+ */
+
+
+static int
+FileWriteGIF(
+ Tcl_Interp *interp, /* Interpreter to use for reporting errors. */
+ const char *filename,
+ Tcl_Obj *format,
+ Tk_PhotoImageBlock *blockPtr)
+{
+ Tcl_Channel chan = NULL;
+ int result;
+
+ chan = Tcl_OpenFileChannel(interp, (char *) filename, "w", 0644);
+ if (!chan) {
+ return TCL_ERROR;
+ }
+ if (Tcl_SetChannelOption(interp, chan, "-translation",
+ "binary") != TCL_OK) {
+ Tcl_Close(NULL, chan);
+ return TCL_ERROR;
+ }
+
+ result = CommonWriteGIF(interp, chan, WriteToChannel, format, blockPtr);
+
+ if (Tcl_Close(interp, chan) == TCL_ERROR) {
+ return TCL_ERROR;
+ }
+ return result;
+}
+
+static int
+StringWriteGIF(
+ Tcl_Interp *interp, /* Interpreter to use for reporting errors and
+ * returning the GIF data. */
+ Tcl_Obj *format,
+ Tk_PhotoImageBlock *blockPtr)
+{
+ int result;
+ Tcl_Obj *objPtr = Tcl_NewObj();
+
+ Tcl_IncrRefCount(objPtr);
+ result = CommonWriteGIF(interp, objPtr, WriteToByteArray, format,
+ blockPtr);
+ if (result == TCL_OK) {
+ Tcl_SetObjResult(interp, objPtr);
+ }
+ Tcl_DecrRefCount(objPtr);
+ return result;
+}
+
+static int
+WriteToChannel(
+ ClientData clientData,
+ const char *bytes,
+ int byteCount)
+{
+ Tcl_Channel handle = clientData;
+
+ return Tcl_Write(handle, bytes, byteCount);
+}
+
+static int
+WriteToByteArray(
+ ClientData clientData,
+ const char *bytes,
+ int byteCount)
+{
+ Tcl_Obj *objPtr = clientData;
+ Tcl_Obj *tmpObj = Tcl_NewByteArrayObj((unsigned char *) bytes, byteCount);
+
+ Tcl_IncrRefCount(tmpObj);
+ Tcl_AppendObjToObj(objPtr, tmpObj);
+ Tcl_DecrRefCount(tmpObj);
+ return byteCount;
+}
+
+static int
+CommonWriteGIF(
+ Tcl_Interp *interp,
+ ClientData handle,
+ WriteBytesFunc *writeProc,
+ Tcl_Obj *format,
+ Tk_PhotoImageBlock *blockPtr)
+{
+ GifWriterState state;
+ int resolution;
+ long width, height, x;
+ unsigned char c;
+ unsigned int top, left;
+
+ top = 0;
+ left = 0;
+
+ memset(&state, 0, sizeof(state));
+
+ state.pixelSize = blockPtr->pixelSize;
+ state.greenOffset = blockPtr->offset[1]-blockPtr->offset[0];
+ state.blueOffset = blockPtr->offset[2]-blockPtr->offset[0];
+ state.alphaOffset = blockPtr->offset[0];
+ if (state.alphaOffset < blockPtr->offset[2]) {
+ state.alphaOffset = blockPtr->offset[2];
+ }
+ if (++state.alphaOffset < state.pixelSize) {
+ state.alphaOffset -= blockPtr->offset[0];
+ } else {
+ state.alphaOffset = 0;
+ }
+
+ writeProc(handle, (char *) (state.alphaOffset ? GIF89a : GIF87a), 6);
+
+ for (x = 0; x < MAXCOLORMAPSIZE ;x++) {
+ state.mapa[x][CM_RED] = 255;
+ state.mapa[x][CM_GREEN] = 255;
+ state.mapa[x][CM_BLUE] = 255;
+ }
+
+ width = blockPtr->width;
+ height = blockPtr->height;
+ state.pixelOffset = blockPtr->pixelPtr + blockPtr->offset[0];
+ state.pixelPitch = blockPtr->pitch;
+ SaveMap(&state, blockPtr);
+ if (state.num >= MAXCOLORMAPSIZE) {
+ Tcl_SetObjResult(interp, Tcl_NewStringObj("too many colors", -1));
+ Tcl_SetErrorCode(interp, "TK", "IMAGE", "GIF", "COLORFUL", NULL);
+ return TCL_ERROR;
+ }
+ if (state.num<2) {
+ state.num = 2;
+ }
+ c = LSB(width);
+ writeProc(handle, (char *) &c, 1);
+ c = MSB(width);
+ writeProc(handle, (char *) &c, 1);
+ c = LSB(height);
+ writeProc(handle, (char *) &c, 1);
+ c = MSB(height);
+ writeProc(handle, (char *) &c, 1);
+
+ resolution = 0;
+ while (state.num >> resolution) {
+ resolution++;
+ }
+ c = 111 + resolution * 17;
+ writeProc(handle, (char *) &c, 1);
+
+ state.num = 1 << resolution;
+
+ /*
+ * Background color
+ */
+
+ c = 0;
+ writeProc(handle, (char *) &c, 1);
+
+ /*
+ * Zero for future expansion.
+ */
+
+ writeProc(handle, (char *) &c, 1);
+
+ for (x = 0; x < state.num; x++) {
+ c = state.mapa[x][CM_RED];
+ writeProc(handle, (char *) &c, 1);
+ c = state.mapa[x][CM_GREEN];
+ writeProc(handle, (char *) &c, 1);
+ c = state.mapa[x][CM_BLUE];
+ writeProc(handle, (char *) &c, 1);
+ }
+
+ /*
+ * Write out extension for transparent colour index, if necessary.
+ */
+
+ if (state.alphaOffset) {
+ c = GIF_EXTENSION;
+ writeProc(handle, (char *) &c, 1);
+ writeProc(handle, "\371\4\1\0\0\0", 7);
+ }
+
+ c = GIF_START;
+ writeProc(handle, (char *) &c, 1);
+ c = LSB(top);
+ writeProc(handle, (char *) &c, 1);
+ c = MSB(top);
+ writeProc(handle, (char *) &c, 1);
+ c = LSB(left);
+ writeProc(handle, (char *) &c, 1);
+ c = MSB(left);
+ writeProc(handle, (char *) &c, 1);
+
+ c = LSB(width);
+ writeProc(handle, (char *) &c, 1);
+ c = MSB(width);
+ writeProc(handle, (char *) &c, 1);
+
+ c = LSB(height);
+ writeProc(handle, (char *) &c, 1);
+ c = MSB(height);
+ writeProc(handle, (char *) &c, 1);
+
+ c = 0;
+ writeProc(handle, (char *) &c, 1);
+ c = resolution;
+ writeProc(handle, (char *) &c, 1);
+
+ state.ssize = state.rsize = blockPtr->width;
+ state.csize = blockPtr->height;
+ Compress(resolution+1, handle, writeProc, ReadValue, &state);
+
+ c = 0;
+ writeProc(handle, (char *) &c, 1);
+ c = GIF_TERMINATOR;
+ writeProc(handle, (char *) &c, 1);
+
+ return TCL_OK;
+}
+
+static int
+ColorNumber(
+ GifWriterState *statePtr,
+ int red, int green, int blue)
+{
+ int x = (statePtr->alphaOffset != 0);
+
+ for (; x <= MAXCOLORMAPSIZE; x++) {
+ if ((statePtr->mapa[x][CM_RED] == red) &&
+ (statePtr->mapa[x][CM_GREEN] == green) &&
+ (statePtr->mapa[x][CM_BLUE] == blue)) {
+ return x;
+ }
+ }
+ return -1;
+}
+
+static int
+IsNewColor(
+ GifWriterState *statePtr,
+ int red, int green, int blue)
+{
+ int x = (statePtr->alphaOffset != 0);
+
+ for (; x<=statePtr->num ; x++) {
+ if ((statePtr->mapa[x][CM_RED] == red) &&
+ (statePtr->mapa[x][CM_GREEN] == green) &&
+ (statePtr->mapa[x][CM_BLUE] == blue)) {
+ return 0;
+ }
+ }
+ return 1;
+}
+
+static void
+SaveMap(
+ GifWriterState *statePtr,
+ Tk_PhotoImageBlock *blockPtr)
+{
+ unsigned char *colores;
+ int x, y;
+ unsigned char red, green, blue;
+
+ if (statePtr->alphaOffset) {
+ statePtr->num = 0;
+ statePtr->mapa[0][CM_RED] = DEFAULT_BACKGROUND_VALUE;
+ statePtr->mapa[0][CM_GREEN] = DEFAULT_BACKGROUND_VALUE;
+ statePtr->mapa[0][CM_BLUE] = DEFAULT_BACKGROUND_VALUE;
+ } else {
+ statePtr->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 (!statePtr->alphaOffset || colores[statePtr->alphaOffset]!=0) {
+ red = colores[0];
+ green = colores[statePtr->greenOffset];
+ blue = colores[statePtr->blueOffset];
+ if (IsNewColor(statePtr, red, green, blue)) {
+ statePtr->num++;
+ if (statePtr->num >= MAXCOLORMAPSIZE) {
+ return;
+ }
+ statePtr->mapa[statePtr->num][CM_RED] = red;
+ statePtr->mapa[statePtr->num][CM_GREEN] = green;
+ statePtr->mapa[statePtr->num][CM_BLUE] = blue;
+ }
+ }
+ colores += statePtr->pixelSize;
+ }
+ }
+}
+
+static int
+ReadValue(
+ GifWriterState *statePtr)
+{
+ unsigned int col;
+
+ if (statePtr->csize == 0) {
+ return EOF;
+ }
+ if (statePtr->alphaOffset
+ && (statePtr->pixelOffset[statePtr->alphaOffset]==0)) {
+ col = 0;
+ } else {
+ col = ColorNumber(statePtr, statePtr->pixelOffset[0],
+ statePtr->pixelOffset[statePtr->greenOffset],
+ statePtr->pixelOffset[statePtr->blueOffset]);
+ }
+ statePtr->pixelOffset += statePtr->pixelSize;
+ if (--statePtr->ssize <= 0) {
+ statePtr->ssize = statePtr->rsize;
+ statePtr->csize--;
+ statePtr->pixelOffset += statePtr->pixelPitch
+ - (statePtr->rsize * statePtr->pixelSize);
+ }
+
+ return col;
+}
+
+/*
+ * GIF Image compression - modified 'Compress'
+ *
+ * Based on: compress.c - File compression ala IEEE Computer, June 1984.
+ *
+ * By Authors: Spencer W. Thomas (decvax!harpo!utah-cs!utah-gr!thomas)
+ * Jim McKie (decvax!mcvax!jim)
+ * Steve Davies (decvax!vax135!petsd!peora!srd)
+ * Ken Turkowski (decvax!decwrl!turtlevax!ken)
+ * James A. Woods (decvax!ihnp4!ames!jaw)
+ * Joe Orost (decvax!vax135!petsd!joe)
+ */
+
+static void
+Compress(
+ int initialBits,
+ ClientData handle,
+ WriteBytesFunc *writeProc,
+ ifunptr readValue,
+ GifWriterState *statePtr)
+{
+ long fcode, ent, disp, hSize, i = 0;
+ int c, hshift;
+ GIFState_t state;
+
+ memset(&state, 0, sizeof(state));
+
+ /*
+ * Set up the globals: initialBits - initial number of bits
+ * outChannel - pointer to output file
+ */
+
+ state.initialBits = initialBits;
+ state.destination = handle;
+ state.writeProc = writeProc;
+
+ /*
+ * Set up the necessary values.
+ */
+
+ state.offset = 0;
+ state.hSize = HSIZE;
+ state.outCount = 0;
+ state.clearFlag = 0;
+ state.inCount = 1;
+ state.maxCode = MAXCODE(state.numBits = state.initialBits);
+ state.clearCode = 1 << (initialBits - 1);
+ state.eofCode = state.clearCode + 1;
+ state.freeEntry = state.clearCode + 2;
+ CharInit(&state);
+
+ ent = readValue(statePtr);
+
+ hshift = 0;
+ for (fcode = (long) state.hSize; fcode < 65536L; fcode *= 2L) {
+ hshift++;
+ }
+ hshift = 8 - hshift; /* Set hash code range bound */
+
+ hSize = state.hSize;
+ ClearHashTable(&state, (int) hSize); /* Clear hash table */
+
+ Output(&state, (long) state.clearCode);
+
+ while (U(c = readValue(statePtr)) != U(EOF)) {
+ state.inCount++;
+
+ fcode = (long) (((long) c << GIFBITS) + ent);
+ i = ((long)c << hshift) ^ ent; /* XOR hashing */
+
+ if (state.hashTable[i] == fcode) {
+ ent = state.codeTable[i];
+ continue;
+ } else if ((long) state.hashTable[i] < 0) { /* Empty slot */
+ goto nomatch;
+ }
+
+ disp = hSize - i; /* Secondary hash (after G. Knott) */
+ if (i == 0) {
+ disp = 1;
+ }
+
+ probe:
+ if ((i -= disp) < 0) {
+ i += hSize;
+ }
+
+ if (state.hashTable[i] == fcode) {
+ ent = state.codeTable[i];
+ continue;
+ }
+ if ((long) state.hashTable[i] > 0) {
+ goto probe;
+ }
+
+ nomatch:
+ Output(&state, (long) ent);
+ state.outCount++;
+ ent = c;
+ if (U(state.freeEntry) < U((long)1 << GIFBITS)) {
+ state.codeTable[i] = state.freeEntry++; /* code -> hashtable */
+ state.hashTable[i] = fcode;
+ } else {
+ ClearForBlock(&state);
+ }
+ }
+
+ /*
+ * Put out the final code.
+ */
+
+ Output(&state, (long) ent);
+ state.outCount++;
+ Output(&state, (long) state.eofCode);
+}
+
+/*****************************************************************
+ * Output --
+ * Output the given code.
+ *
+ * Inputs:
+ * code: A numBits-bit integer. If == -1, then EOF. This assumes that
+ * numBits =< (long) wordsize - 1.
+ * Outputs:
+ * Outputs code to the file.
+ * Assumptions:
+ * Chars are 8 bits long.
+ * Algorithm:
+ * Maintain a GIFBITS character long buffer (so that 8 codes will fit in
+ * it exactly). Use the VAX insv instruction to insert each code in turn.
+ * When the buffer fills up empty it and start over.
+ */
+
+static void
+Output(
+ GIFState_t *statePtr,
+ long code)
+{
+ static const unsigned long masks[] = {
+ 0x0000,
+ 0x0001, 0x0003, 0x0007, 0x000F,
+ 0x001F, 0x003F, 0x007F, 0x00FF,
+ 0x01FF, 0x03FF, 0x07FF, 0x0FFF,
+ 0x1FFF, 0x3FFF, 0x7FFF, 0xFFFF
+ };
+
+ statePtr->currentAccumulated &= masks[statePtr->currentBits];
+ if (statePtr->currentBits > 0) {
+ statePtr->currentAccumulated |= ((long) code << statePtr->currentBits);
+ } else {
+ statePtr->currentAccumulated = code;
+ }
+ statePtr->currentBits += statePtr->numBits;
+
+ while (statePtr->currentBits >= 8) {
+ CharOut(statePtr, (unsigned) (statePtr->currentAccumulated & 0xff));
+ statePtr->currentAccumulated >>= 8;
+ statePtr->currentBits -= 8;
+ }
+
+ /*
+ * If the next entry is going to be too big for the code size, then
+ * increase it, if possible.
+ */
+
+ if ((statePtr->freeEntry > statePtr->maxCode) || statePtr->clearFlag) {
+ if (statePtr->clearFlag) {
+ statePtr->maxCode = MAXCODE(
+ statePtr->numBits = statePtr->initialBits);
+ statePtr->clearFlag = 0;
+ } else {
+ statePtr->numBits++;
+ if (statePtr->numBits == GIFBITS) {
+ statePtr->maxCode = (long)1 << GIFBITS;
+ } else {
+ statePtr->maxCode = MAXCODE(statePtr->numBits);
+ }
+ }
+ }
+
+ if (code == statePtr->eofCode) {
+ /*
+ * At EOF, write the rest of the buffer.
+ */
+
+ while (statePtr->currentBits > 0) {
+ CharOut(statePtr,
+ (unsigned) (statePtr->currentAccumulated & 0xff));
+ statePtr->currentAccumulated >>= 8;
+ statePtr->currentBits -= 8;
+ }
+ FlushChar(statePtr);
+ }
+}
+
+/*
+ * Clear out the hash table
+ */
+
+static void
+ClearForBlock( /* Table clear for block compress. */
+ GIFState_t *statePtr)
+{
+ ClearHashTable(statePtr, (int) statePtr->hSize);
+ statePtr->freeEntry = statePtr->clearCode + 2;
+ statePtr->clearFlag = 1;
+
+ Output(statePtr, (long) statePtr->clearCode);
+}
+
+static void
+ClearHashTable( /* Reset code table. */
+ GIFState_t *statePtr,
+ int hSize)
+{
+ register int *hashTablePtr = statePtr->hashTable + hSize;
+ register long i;
+ register long m1 = -1;
+
+ i = hSize - 16;
+ do { /* might use Sys V memset(3) here */
+ *(hashTablePtr-16) = m1;
+ *(hashTablePtr-15) = m1;
+ *(hashTablePtr-14) = m1;
+ *(hashTablePtr-13) = m1;
+ *(hashTablePtr-12) = m1;
+ *(hashTablePtr-11) = m1;
+ *(hashTablePtr-10) = m1;
+ *(hashTablePtr-9) = m1;
+ *(hashTablePtr-8) = m1;
+ *(hashTablePtr-7) = m1;
+ *(hashTablePtr-6) = m1;
+ *(hashTablePtr-5) = m1;
+ *(hashTablePtr-4) = m1;
+ *(hashTablePtr-3) = m1;
+ *(hashTablePtr-2) = m1;
+ *(hashTablePtr-1) = m1;
+ hashTablePtr -= 16;
+ } while ((i -= 16) >= 0);
+
+ for (i += 16; i > 0; i--) {
+ *--hashTablePtr = m1;
+ }
+}
+
+/*
+ *****************************************************************************
+ *
+ * GIF Specific routines
+ *
+ *****************************************************************************
+ */
+
+/*
+ * Set up the 'byte output' routine
+ */
+
+static void
+CharInit(
+ GIFState_t *statePtr)
+{
+ statePtr->accumulatedByteCount = 0;
+ statePtr->currentAccumulated = 0;
+ statePtr->currentBits = 0;
+}
+
+/*
+ * Add a character to the end of the current packet, and if it is 254
+ * characters, flush the packet to disk.
+ */
+
+static void
+CharOut(
+ GIFState_t *statePtr,
+ int c)
+{
+ statePtr->packetAccumulator[statePtr->accumulatedByteCount++] = c;
+ if (statePtr->accumulatedByteCount >= 254) {
+ FlushChar(statePtr);
+ }
+}
+
+/*
+ * Flush the packet to disk, and reset the accumulator
+ */
+
+static void
+FlushChar(
+ GIFState_t *statePtr)
+{
+ unsigned char c;
+
+ if (statePtr->accumulatedByteCount > 0) {
+ c = statePtr->accumulatedByteCount;
+ statePtr->writeProc(statePtr->destination, (const char *) &c, 1);
+ statePtr->writeProc(statePtr->destination,
+ (const char *) statePtr->packetAccumulator,
+ statePtr->accumulatedByteCount);
+ statePtr->accumulatedByteCount = 0;
+ }
+}
+
+/* The End */
+
+/*
+ * Local Variables:
+ * mode: c
+ * c-basic-offset: 4
+ * fill-column: 78
+ * End:
+ */
diff --git a/tk8.6/generic/tkImgPNG.c b/tk8.6/generic/tkImgPNG.c
new file mode 100644
index 0000000..c6e3029
--- /dev/null
+++ b/tk8.6/generic/tkImgPNG.c
@@ -0,0 +1,3563 @@
+/*
+ * tkImgPNG.c --
+ *
+ * A Tk photo image file handler for PNG files.
+ *
+ * Copyright (c) 2006-2008 Muonics, Inc.
+ * Copyright (c) 2008 Donal K. Fellows
+ *
+ * See the file "license.terms" for information on usage and redistribution of
+ * this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ */
+
+#include "assert.h"
+#include "tkInt.h"
+
+#define PNG_INT32(a,b,c,d) \
+ (((long)(a) << 24) | ((long)(b) << 16) | ((long)(c) << 8) | (long)(d))
+#define PNG_BLOCK_SZ 1024 /* Process up to 1k at a time. */
+#define PNG_MIN(a, b) (((a) < (b)) ? (a) : (b))
+
+/*
+ * Every PNG image starts with the following 8-byte signature.
+ */
+
+#define PNG_SIG_SZ 8
+static const unsigned char pngSignature[] = {
+ 137, 80, 78, 71, 13, 10, 26, 10
+};
+
+static const int startLine[8] = {
+ 0, 0, 0, 4, 0, 2, 0, 1
+};
+
+/*
+ * Chunk type flags.
+ */
+
+#define PNG_CF_ANCILLARY 0x10000000L /* Non-critical chunk (can ignore). */
+#define PNG_CF_PRIVATE 0x00100000L /* Application-specific chunk. */
+#define PNG_CF_RESERVED 0x00001000L /* Not used. */
+#define PNG_CF_COPYSAFE 0x00000010L /* Opaque data safe for copying. */
+
+/*
+ * Chunk types, not all of which have support implemented. Note that there are
+ * others in the official extension set which we will never support (as they
+ * are officially deprecated).
+ */
+
+#define CHUNK_IDAT PNG_INT32('I','D','A','T') /* Pixel data. */
+#define CHUNK_IEND PNG_INT32('I','E','N','D') /* End of Image. */
+#define CHUNK_IHDR PNG_INT32('I','H','D','R') /* Header. */
+#define CHUNK_PLTE PNG_INT32('P','L','T','E') /* Palette. */
+
+#define CHUNK_bKGD PNG_INT32('b','K','G','D') /* Background Color */
+#define CHUNK_cHRM PNG_INT32('c','H','R','M') /* Chroma values. */
+#define CHUNK_gAMA PNG_INT32('g','A','M','A') /* Gamma. */
+#define CHUNK_hIST PNG_INT32('h','I','S','T') /* Histogram. */
+#define CHUNK_iCCP PNG_INT32('i','C','C','P') /* Color profile. */
+#define CHUNK_iTXt PNG_INT32('i','T','X','t') /* Internationalized
+ * text (comments,
+ * etc.) */
+#define CHUNK_oFFs PNG_INT32('o','F','F','s') /* Image offset. */
+#define CHUNK_pCAL PNG_INT32('p','C','A','L') /* Pixel calibration
+ * data. */
+#define CHUNK_pHYs PNG_INT32('p','H','Y','s') /* Physical pixel
+ * dimensions. */
+#define CHUNK_sBIT PNG_INT32('s','B','I','T') /* Significant bits */
+#define CHUNK_sCAL PNG_INT32('s','C','A','L') /* Physical scale. */
+#define CHUNK_sPLT PNG_INT32('s','P','L','T') /* Suggested
+ * palette. */
+#define CHUNK_sRGB PNG_INT32('s','R','G','B') /* Standard RGB space
+ * declaration. */
+#define CHUNK_tEXt PNG_INT32('t','E','X','t') /* Plain Latin-1
+ * text. */
+#define CHUNK_tIME PNG_INT32('t','I','M','E') /* Time stamp. */
+#define CHUNK_tRNS PNG_INT32('t','R','N','S') /* Transparency. */
+#define CHUNK_zTXt PNG_INT32('z','T','X','t') /* Compressed Latin-1
+ * text. */
+
+/*
+ * Color flags.
+ */
+
+#define PNG_COLOR_INDEXED 1
+#define PNG_COLOR_USED 2
+#define PNG_COLOR_ALPHA 4
+
+/*
+ * Actual color types.
+ */
+
+#define PNG_COLOR_GRAY 0
+#define PNG_COLOR_RGB (PNG_COLOR_USED)
+#define PNG_COLOR_PLTE (PNG_COLOR_USED | PNG_COLOR_INDEXED)
+#define PNG_COLOR_GRAYALPHA (PNG_COLOR_GRAY | PNG_COLOR_ALPHA)
+#define PNG_COLOR_RGBA (PNG_COLOR_USED | PNG_COLOR_ALPHA)
+
+/*
+ * Compression Methods.
+ */
+
+#define PNG_COMPRESS_DEFLATE 0
+
+/*
+ * Filter Methods.
+ */
+
+#define PNG_FILTMETH_STANDARD 0
+
+/*
+ * Interlacing Methods.
+ */
+
+#define PNG_INTERLACE_NONE 0
+#define PNG_INTERLACE_ADAM7 1
+
+/*
+ * State information, used to store everything about the PNG image being
+ * currently parsed or created.
+ */
+
+typedef struct {
+ /*
+ * PNG data source/destination channel/object/byte array.
+ */
+
+ Tcl_Channel channel; /* Channel for from-file reads. */
+ Tcl_Obj *objDataPtr;
+ unsigned char *strDataBuf; /* Raw source data for from-string reads. */
+ int strDataLen; /* Length of source data. */
+ unsigned char *base64Data; /* base64 encoded string data. */
+ unsigned char base64Bits; /* Remaining bits from last base64 read. */
+ unsigned char base64State; /* Current state of base64 decoder. */
+ double alpha; /* Alpha from -format option. */
+
+ /*
+ * Image header information.
+ */
+
+ unsigned char bitDepth; /* Number of bits per pixel. */
+ unsigned char colorType; /* Grayscale, TrueColor, etc. */
+ unsigned char compression; /* Compression Mode (always zlib). */
+ unsigned char filter; /* Filter mode (0 - 3). */
+ unsigned char interlace; /* Type of interlacing (if any). */
+ unsigned char numChannels; /* Number of channels per pixel. */
+ unsigned char bytesPerPixel;/* Bytes per pixel in scan line. */
+ int bitScale; /* Scale factor for RGB/Gray depths < 8. */
+ int currentLine; /* Current line being unfiltered. */
+ unsigned char phase; /* Interlacing phase (0..6). */
+ Tk_PhotoImageBlock block;
+ int blockLen; /* Number of bytes in Tk image pixels. */
+
+ /*
+ * For containing data read from PLTE (palette) and tRNS (transparency)
+ * chunks.
+ */
+
+ int paletteLen; /* Number of PLTE entries (1..256). */
+ int useTRNS; /* Flag to indicate whether there was a
+ * palette given. */
+ struct {
+ unsigned char red;
+ unsigned char green;
+ unsigned char blue;
+ unsigned char alpha;
+ } palette[256]; /* Palette RGB/Transparency table. */
+ unsigned char transVal[6]; /* Fully-transparent RGB/Gray Value. */
+
+ /*
+ * For compressing and decompressing IDAT chunks.
+ */
+
+ Tcl_ZlibStream stream; /* Inflating or deflating stream; this one is
+ * not bound to a Tcl command. */
+ Tcl_Obj *lastLineObj; /* Last line of pixels, for unfiltering. */
+ Tcl_Obj *thisLineObj; /* Current line of pixels to process. */
+ int lineSize; /* Number of bytes in a PNG line. */
+ int phaseSize; /* Number of bytes/line in current phase. */
+} PNGImage;
+
+/*
+ * Maximum size of various chunks.
+ */
+
+#define PNG_PLTE_MAXSZ 768 /* 3 bytes/RGB entry, 256 entries max */
+#define PNG_TRNS_MAXSZ 256 /* 1-byte alpha, 256 entries max */
+
+/*
+ * Forward declarations of non-global functions defined in this file:
+ */
+
+static void ApplyAlpha(PNGImage *pngPtr);
+static int CheckColor(Tcl_Interp *interp, PNGImage *pngPtr);
+static inline int CheckCRC(Tcl_Interp *interp, PNGImage *pngPtr,
+ unsigned long calculated);
+static void CleanupPNGImage(PNGImage *pngPtr);
+static int DecodeLine(Tcl_Interp *interp, PNGImage *pngPtr);
+static int DecodePNG(Tcl_Interp *interp, PNGImage *pngPtr,
+ Tcl_Obj *fmtObj, Tk_PhotoHandle imageHandle,
+ int destX, int destY);
+static int EncodePNG(Tcl_Interp *interp,
+ Tk_PhotoImageBlock *blockPtr, PNGImage *pngPtr);
+static int FileMatchPNG(Tcl_Channel chan, const char *fileName,
+ Tcl_Obj *fmtObj, int *widthPtr, int *heightPtr,
+ Tcl_Interp *interp);
+static int FileReadPNG(Tcl_Interp *interp, Tcl_Channel chan,
+ const char *fileName, Tcl_Obj *fmtObj,
+ Tk_PhotoHandle imageHandle, int destX, int destY,
+ int width, int height, int srcX, int srcY);
+static int FileWritePNG(Tcl_Interp *interp, const char *filename,
+ Tcl_Obj *fmtObj, Tk_PhotoImageBlock *blockPtr);
+static int InitPNGImage(Tcl_Interp *interp, PNGImage *pngPtr,
+ Tcl_Channel chan, Tcl_Obj *objPtr, int dir);
+static inline unsigned char Paeth(int a, int b, int c);
+static int ParseFormat(Tcl_Interp *interp, Tcl_Obj *fmtObj,
+ PNGImage *pngPtr);
+static int ReadBase64(Tcl_Interp *interp, PNGImage *pngPtr,
+ unsigned char *destPtr, int destSz,
+ unsigned long *crcPtr);
+static int ReadByteArray(Tcl_Interp *interp, PNGImage *pngPtr,
+ unsigned char *destPtr, int destSz,
+ unsigned long *crcPtr);
+static int ReadData(Tcl_Interp *interp, PNGImage *pngPtr,
+ unsigned char *destPtr, int destSz,
+ unsigned long *crcPtr);
+static int ReadChunkHeader(Tcl_Interp *interp, PNGImage *pngPtr,
+ int *sizePtr, unsigned long *typePtr,
+ unsigned long *crcPtr);
+static int ReadIDAT(Tcl_Interp *interp, PNGImage *pngPtr,
+ int chunkSz, unsigned long crc);
+static int ReadIHDR(Tcl_Interp *interp, PNGImage *pngPtr);
+static inline int ReadInt32(Tcl_Interp *interp, PNGImage *pngPtr,
+ unsigned long *resultPtr, unsigned long *crcPtr);
+static int ReadPLTE(Tcl_Interp *interp, PNGImage *pngPtr,
+ int chunkSz, unsigned long crc);
+static int ReadTRNS(Tcl_Interp *interp, PNGImage *pngPtr,
+ int chunkSz, unsigned long crc);
+static int SkipChunk(Tcl_Interp *interp, PNGImage *pngPtr,
+ int chunkSz, unsigned long crc);
+static int StringMatchPNG(Tcl_Obj *dataObj, Tcl_Obj *fmtObj,
+ int *widthPtr, int *heightPtr,
+ Tcl_Interp *interp);
+static int StringReadPNG(Tcl_Interp *interp, Tcl_Obj *dataObj,
+ Tcl_Obj *fmtObj, Tk_PhotoHandle imageHandle,
+ int destX, int destY, int width, int height,
+ int srcX, int srcY);
+static int StringWritePNG(Tcl_Interp *interp, Tcl_Obj *fmtObj,
+ Tk_PhotoImageBlock *blockPtr);
+static int UnfilterLine(Tcl_Interp *interp, PNGImage *pngPtr);
+static inline int WriteByte(Tcl_Interp *interp, PNGImage *pngPtr,
+ unsigned char c, unsigned long *crcPtr);
+static inline int WriteChunk(Tcl_Interp *interp, PNGImage *pngPtr,
+ unsigned long chunkType,
+ const unsigned char *dataPtr, int dataSize);
+static int WriteData(Tcl_Interp *interp, PNGImage *pngPtr,
+ const unsigned char *srcPtr, int srcSz,
+ unsigned long *crcPtr);
+static int WriteExtraChunks(Tcl_Interp *interp,
+ PNGImage *pngPtr);
+static int WriteIHDR(Tcl_Interp *interp, PNGImage *pngPtr,
+ Tk_PhotoImageBlock *blockPtr);
+static int WriteIDAT(Tcl_Interp *interp, PNGImage *pngPtr,
+ Tk_PhotoImageBlock *blockPtr);
+static inline int WriteInt32(Tcl_Interp *interp, PNGImage *pngPtr,
+ unsigned long l, unsigned long *crcPtr);
+
+/*
+ * The format record for the PNG file format:
+ */
+
+Tk_PhotoImageFormat tkImgFmtPNG = {
+ "png", /* name */
+ FileMatchPNG, /* fileMatchProc */
+ StringMatchPNG, /* stringMatchProc */
+ FileReadPNG, /* fileReadProc */
+ StringReadPNG, /* stringReadProc */
+ FileWritePNG, /* fileWriteProc */
+ StringWritePNG, /* stringWriteProc */
+ NULL
+};
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * InitPNGImage --
+ *
+ * This function is invoked by each of the Tk image handler procs
+ * (MatchStringProc, etc.) to initialize state information used during
+ * the course of encoding or decoding a PNG image.
+ *
+ * Results:
+ * TCL_OK, or TCL_ERROR if initialization failed.
+ *
+ * Side effects:
+ * The reference count of the -data Tcl_Obj*, if any, is incremented.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+InitPNGImage(
+ Tcl_Interp *interp,
+ PNGImage *pngPtr,
+ Tcl_Channel chan,
+ Tcl_Obj *objPtr,
+ int dir)
+{
+ memset(pngPtr, 0, sizeof(PNGImage));
+
+ pngPtr->channel = chan;
+ pngPtr->alpha = 1.0;
+
+ /*
+ * If decoding from a -data string object, increment its reference count
+ * for the duration of the decode and get its length and byte array for
+ * reading with ReadData().
+ */
+
+ if (objPtr) {
+ Tcl_IncrRefCount(objPtr);
+ pngPtr->objDataPtr = objPtr;
+ pngPtr->strDataBuf =
+ Tcl_GetByteArrayFromObj(objPtr, &pngPtr->strDataLen);
+ }
+
+ /*
+ * Initialize the palette transparency table to fully opaque.
+ */
+
+ memset(pngPtr->palette, 255, sizeof(pngPtr->palette));
+
+ /*
+ * Initialize Zlib inflate/deflate stream.
+ */
+
+ if (Tcl_ZlibStreamInit(NULL, dir, TCL_ZLIB_FORMAT_ZLIB,
+ TCL_ZLIB_COMPRESS_DEFAULT, NULL, &pngPtr->stream) != TCL_OK) {
+ if (interp) {
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "zlib initialization failed", -1));
+ Tcl_SetErrorCode(interp, "TK", "IMAGE", "PNG", "ZLIB_INIT", NULL);
+ }
+ if (objPtr) {
+ Tcl_DecrRefCount(objPtr);
+ }
+ return TCL_ERROR;
+ }
+
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * CleanupPNGImage --
+ *
+ * This function is invoked by each of the Tk image handler procs
+ * (MatchStringProc, etc.) prior to returning to Tcl in order to clean up
+ * any allocated memory and call other cleanup handlers such as zlib's
+ * inflateEnd/deflateEnd.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The reference count of the -data Tcl_Obj*, if any, is decremented.
+ * Buffers are freed, streams are closed. The PNGImage should not be used
+ * for any purpose without being reinitialized post-cleanup.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+CleanupPNGImage(
+ PNGImage *pngPtr)
+{
+ /*
+ * Don't need the object containing the -data value anymore.
+ */
+
+ if (pngPtr->objDataPtr) {
+ Tcl_DecrRefCount(pngPtr->objDataPtr);
+ }
+
+ /*
+ * Discard pixel buffer.
+ */
+
+ if (pngPtr->stream) {
+ Tcl_ZlibStreamClose(pngPtr->stream);
+ }
+
+ if (pngPtr->block.pixelPtr) {
+ ckfree(pngPtr->block.pixelPtr);
+ }
+ if (pngPtr->thisLineObj) {
+ Tcl_DecrRefCount(pngPtr->thisLineObj);
+ }
+ if (pngPtr->lastLineObj) {
+ Tcl_DecrRefCount(pngPtr->lastLineObj);
+ }
+
+ memset(pngPtr, 0, sizeof(PNGImage));
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ReadBase64 --
+ *
+ * This function is invoked to read the specified number of bytes from
+ * base-64 encoded image data.
+ *
+ * Note: It would be better if the Tk_PhotoImage stuff handled this by
+ * creating a channel from the -data value, which would take care of
+ * base64 decoding and made the data readable as if it were coming from a
+ * file.
+ *
+ * Results:
+ * TCL_OK, or TCL_ERROR if an I/O error occurs.
+ *
+ * Side effects:
+ * The file position will change. The running CRC is updated if a pointer
+ * to it is provided.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+ReadBase64(
+ Tcl_Interp *interp,
+ PNGImage *pngPtr,
+ unsigned char *destPtr,
+ int destSz,
+ unsigned long *crcPtr)
+{
+ static const unsigned char from64[] = {
+ 0x82, 0x83, 0x83, 0x83, 0x83, 0x83, 0x83, 0x83, 0x83, 0x80, 0x80,
+ 0x83, 0x80, 0x80, 0x83, 0x83, 0x83, 0x83, 0x83, 0x83, 0x83, 0x83,
+ 0x83, 0x83, 0x83, 0x83, 0x83, 0x83, 0x83, 0x83, 0x83, 0x83, 0x80,
+ 0x83, 0x83, 0x83, 0x83, 0x83, 0x83, 0x83, 0x83, 0x83, 0x83, 0x3e,
+ 0x83, 0x83, 0x83, 0x3f, 0x34, 0x35, 0x36, 0x37, 0x38, 0x39, 0x3a,
+ 0x3b, 0x3c, 0x3d, 0x83, 0x83, 0x83, 0x81, 0x83, 0x83, 0x83, 0x00,
+ 0x01, 0x02, 0x03, 0x04, 0x05, 0x06, 0x07, 0x08, 0x09, 0x0a, 0x0b,
+ 0x0c, 0x0d, 0x0e, 0x0f, 0x10, 0x11, 0x12, 0x13, 0x14, 0x15, 0x16,
+ 0x17, 0x18, 0x19, 0x83, 0x83, 0x83, 0x83, 0x83, 0x83, 0x1a, 0x1b,
+ 0x1c, 0x1d, 0x1e, 0x1f, 0x20, 0x21, 0x22, 0x23, 0x24, 0x25, 0x26,
+ 0x27, 0x28, 0x29, 0x2a, 0x2b, 0x2c, 0x2d, 0x2e, 0x2f, 0x30, 0x31,
+ 0x32, 0x33, 0x83, 0x83, 0x83, 0x83, 0x83, 0x83, 0x83, 0x83, 0x83,
+ 0x83, 0x83, 0x83, 0x83, 0x83, 0x83, 0x83, 0x83, 0x83, 0x83, 0x83,
+ 0x83, 0x83, 0x83, 0x83, 0x83, 0x83, 0x83, 0x83, 0x83, 0x83, 0x83,
+ 0x83, 0x83, 0x83, 0x83, 0x83, 0x83, 0x83, 0x83, 0x83, 0x83, 0x83,
+ 0x83, 0x83, 0x83, 0x83, 0x83, 0x83, 0x83, 0x83, 0x83, 0x83, 0x83,
+ 0x83, 0x83, 0x83, 0x83, 0x83, 0x83, 0x83, 0x83, 0x83, 0x83, 0x83,
+ 0x83, 0x83, 0x83, 0x83, 0x83, 0x83, 0x83, 0x83, 0x83, 0x83, 0x83,
+ 0x83, 0x83, 0x83, 0x83, 0x83, 0x83, 0x83, 0x83, 0x83, 0x83, 0x83,
+ 0x83, 0x83, 0x83, 0x83, 0x83, 0x83, 0x83, 0x83, 0x83, 0x83, 0x83,
+ 0x83, 0x83, 0x83, 0x83, 0x83, 0x83, 0x83, 0x83, 0x83, 0x83, 0x83,
+ 0x83, 0x83, 0x83, 0x83, 0x83, 0x83, 0x83, 0x83, 0x83, 0x83, 0x83,
+ 0x83, 0x83, 0x83, 0x83, 0x83, 0x83, 0x83, 0x83, 0x83, 0x83, 0x83,
+ 0x83, 0x83
+ };
+
+ /*
+ * Definitions for the base-64 decoder.
+ */
+
+#define PNG64_SPECIAL 0x80 /* Flag bit */
+#define PNG64_SPACE 0x80 /* Whitespace */
+#define PNG64_PAD 0x81 /* Padding */
+#define PNG64_DONE 0x82 /* End of data */
+#define PNG64_BAD 0x83 /* Ooooh, naughty! */
+
+ while (destSz && pngPtr->strDataLen) {
+ unsigned char c = 0;
+ unsigned char c64 = from64[*pngPtr->strDataBuf++];
+
+ pngPtr->strDataLen--;
+
+ if (PNG64_SPACE == c64) {
+ continue;
+ }
+
+ if (c64 & PNG64_SPECIAL) {
+ c = (unsigned char) pngPtr->base64Bits;
+ } else {
+ switch (pngPtr->base64State++) {
+ case 0:
+ pngPtr->base64Bits = c64 << 2;
+ continue;
+ case 1:
+ c = (unsigned char) (pngPtr->base64Bits | (c64 >> 4));
+ pngPtr->base64Bits = (c64 & 0xF) << 4;
+ break;
+ case 2:
+ c = (unsigned char) (pngPtr->base64Bits | (c64 >> 2));
+ pngPtr->base64Bits = (c64 & 0x3) << 6;
+ break;
+ case 3:
+ c = (unsigned char) (pngPtr->base64Bits | c64);
+ pngPtr->base64State = 0;
+ pngPtr->base64Bits = 0;
+ break;
+ }
+ }
+
+ if (crcPtr) {
+ *crcPtr = Tcl_ZlibCRC32(*crcPtr, &c, 1);
+ }
+
+ if (destPtr) {
+ *destPtr++ = c;
+ }
+
+ destSz--;
+
+ if (c64 & PNG64_SPECIAL) {
+ break;
+ }
+ }
+
+ if (destSz) {
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "unexpected end of image data", -1));
+ Tcl_SetErrorCode(interp, "TK", "IMAGE", "PNG", "EARLY_END", NULL);
+ return TCL_ERROR;
+ }
+
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ReadByteArray --
+ *
+ * This function is invoked to read the specified number of bytes from a
+ * non-base64-encoded byte array provided via the -data option.
+ *
+ * Note: It would be better if the Tk_PhotoImage stuff handled this by
+ * creating a channel from the -data value and made the data readable as
+ * if it were coming from a file.
+ *
+ * Results:
+ * TCL_OK, or TCL_ERROR if an I/O error occurs.
+ *
+ * Side effects:
+ * The file position will change. The running CRC is updated if a pointer
+ * to it is provided.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+ReadByteArray(
+ Tcl_Interp *interp,
+ PNGImage *pngPtr,
+ unsigned char *destPtr,
+ int destSz,
+ unsigned long *crcPtr)
+{
+ /*
+ * Check to make sure the number of requested bytes are available.
+ */
+
+ if (pngPtr->strDataLen < destSz) {
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "unexpected end of image data", -1));
+ Tcl_SetErrorCode(interp, "TK", "IMAGE", "PNG", "EARLY_END", NULL);
+ return TCL_ERROR;
+ }
+
+ while (destSz) {
+ int blockSz = PNG_MIN(destSz, PNG_BLOCK_SZ);
+
+ memcpy(destPtr, pngPtr->strDataBuf, blockSz);
+
+ pngPtr->strDataBuf += blockSz;
+ pngPtr->strDataLen -= blockSz;
+
+ if (crcPtr) {
+ *crcPtr = Tcl_ZlibCRC32(*crcPtr, destPtr, blockSz);
+ }
+
+ destPtr += blockSz;
+ destSz -= blockSz;
+ }
+
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ReadData --
+ *
+ * This function is invoked to read the specified number of bytes from
+ * the image file or data. It is a wrapper around the choice of byte
+ * array Tcl_Obj or Tcl_Channel which depends on whether the image data
+ * is coming from a file or -data.
+ *
+ * Results:
+ * TCL_OK, or TCL_ERROR if an I/O error occurs.
+ *
+ * Side effects:
+ * The file position will change. The running CRC is updated if a pointer
+ * to it is provided.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+ReadData(
+ Tcl_Interp *interp,
+ PNGImage *pngPtr,
+ unsigned char *destPtr,
+ int destSz,
+ unsigned long *crcPtr)
+{
+ if (pngPtr->base64Data) {
+ return ReadBase64(interp, pngPtr, destPtr, destSz, crcPtr);
+ } else if (pngPtr->strDataBuf) {
+ return ReadByteArray(interp, pngPtr, destPtr, destSz, crcPtr);
+ }
+
+ while (destSz) {
+ int blockSz = PNG_MIN(destSz, PNG_BLOCK_SZ);
+
+ blockSz = Tcl_Read(pngPtr->channel, (char *)destPtr, blockSz);
+ if (blockSz < 0) {
+ /* TODO: failure info... */
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "channel read failed: %s", Tcl_PosixError(interp)));
+ return TCL_ERROR;
+ }
+
+ /*
+ * Update CRC, pointer, and remaining count if anything was read.
+ */
+
+ if (blockSz) {
+ if (crcPtr) {
+ *crcPtr = Tcl_ZlibCRC32(*crcPtr, destPtr, blockSz);
+ }
+
+ destPtr += blockSz;
+ destSz -= blockSz;
+ }
+
+ /*
+ * Check for EOF before all desired data was read.
+ */
+
+ if (destSz && Tcl_Eof(pngPtr->channel)) {
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "unexpected end of file", -1));
+ Tcl_SetErrorCode(interp, "TK", "IMAGE", "PNG", "EOF", NULL);
+ return TCL_ERROR;
+ }
+ }
+
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ReadInt32 --
+ *
+ * This function is invoked to read a 32-bit integer in network byte
+ * order from the image data and return the value in host byte order.
+ * This is used, for example, to read the 32-bit CRC value for a chunk
+ * stored in the image file for comparison with the calculated CRC value.
+ *
+ * Results:
+ * TCL_OK, or TCL_ERROR if an I/O error occurs.
+ *
+ * Side effects:
+ * The file position will change. The running CRC is updated if a pointer
+ * to it is provided.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static inline int
+ReadInt32(
+ Tcl_Interp *interp,
+ PNGImage *pngPtr,
+ unsigned long *resultPtr,
+ unsigned long *crcPtr)
+{
+ unsigned char p[4];
+
+ if (ReadData(interp, pngPtr, p, 4, crcPtr) == TCL_ERROR) {
+ return TCL_ERROR;
+ }
+
+ *resultPtr = PNG_INT32(p[0], p[1], p[2], p[3]);
+
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * CheckCRC --
+ *
+ * This function is reads the final 4-byte integer CRC from a chunk and
+ * compares it to the running CRC calculated over the chunk type and data
+ * fields.
+ *
+ * Results:
+ * TCL_OK, or TCL_ERROR if an I/O error or CRC mismatch occurs.
+ *
+ * Side effects:
+ * The file position will change.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static inline int
+CheckCRC(
+ Tcl_Interp *interp,
+ PNGImage *pngPtr,
+ unsigned long calculated)
+{
+ unsigned long chunked;
+
+ /*
+ * Read the CRC field at the end of the chunk.
+ */
+
+ if (ReadInt32(interp, pngPtr, &chunked, NULL) == TCL_ERROR) {
+ return TCL_ERROR;
+ }
+
+ /*
+ * Compare the read CRC to what we calculate to make sure they match.
+ */
+
+ if (calculated != chunked) {
+ Tcl_SetObjResult(interp, Tcl_NewStringObj("CRC check failed", -1));
+ Tcl_SetErrorCode(interp, "TK", "IMAGE", "PNG", "CRC", NULL);
+ return TCL_ERROR;
+ }
+
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * SkipChunk --
+ *
+ * This function is used to skip a PNG chunk that is not used by this
+ * implementation. Given the input stream has had the chunk length and
+ * chunk type fields already read, this function will read the number of
+ * bytes indicated by the chunk length, plus four for the CRC, and will
+ * verify that CRC is correct for the skipped data.
+ *
+ * Results:
+ * TCL_OK, or TCL_ERROR if an I/O error or CRC mismatch occurs.
+ *
+ * Side effects:
+ * The file position will change.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+SkipChunk(
+ Tcl_Interp *interp,
+ PNGImage *pngPtr,
+ int chunkSz,
+ unsigned long crc)
+{
+ unsigned char buffer[PNG_BLOCK_SZ];
+
+ /*
+ * Skip data in blocks until none is left. Read up to PNG_BLOCK_SZ bytes
+ * at a time, rather than trusting the claimed chunk size, which may not
+ * be trustworthy.
+ */
+
+ while (chunkSz) {
+ int blockSz = PNG_MIN(chunkSz, PNG_BLOCK_SZ);
+
+ if (ReadData(interp, pngPtr, buffer, blockSz, &crc) == TCL_ERROR) {
+ return TCL_ERROR;
+ }
+
+ chunkSz -= blockSz;
+ }
+
+ if (CheckCRC(interp, pngPtr, crc) == TCL_ERROR) {
+ return TCL_ERROR;
+ }
+
+ return TCL_OK;
+}
+
+/*
+ * 4.3. Summary of standard chunks
+ *
+ * This table summarizes some properties of the standard chunk types.
+ *
+ * Critical chunks (must appear in this order, except PLTE is optional):
+ *
+ * Name Multiple Ordering constraints OK?
+ *
+ * IHDR No Must be first
+ * PLTE No Before IDAT
+ * IDAT Yes Multiple IDATs must be consecutive
+ * IEND No Must be last
+ *
+ * Ancillary chunks (need not appear in this order):
+ *
+ * Name Multiple Ordering constraints OK?
+ *
+ * cHRM No Before PLTE and IDAT
+ * gAMA No Before PLTE and IDAT
+ * iCCP No Before PLTE and IDAT
+ * sBIT No Before PLTE and IDAT
+ * sRGB No Before PLTE and IDAT
+ * bKGD No After PLTE; before IDAT
+ * hIST No After PLTE; before IDAT
+ * tRNS No After PLTE; before IDAT
+ * pHYs No Before IDAT
+ * sPLT Yes Before IDAT
+ * tIME No None
+ * iTXt Yes None
+ * tEXt Yes None
+ * zTXt Yes None
+ *
+ * [From the PNG specification.]
+ */
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ReadChunkHeader --
+ *
+ * This function is used at the start of each chunk to extract the
+ * four-byte chunk length and four-byte chunk type fields. It will
+ * continue reading until it finds a chunk type that is handled by this
+ * implementation, checking the CRC of any chunks it skips.
+ *
+ * Results:
+ * TCL_OK, or TCL_ERROR if an I/O error occurs or an unknown critical
+ * chunk type is encountered.
+ *
+ * Side effects:
+ * The file position will change. The running CRC is updated.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+ReadChunkHeader(
+ Tcl_Interp *interp,
+ PNGImage *pngPtr,
+ int *sizePtr,
+ unsigned long *typePtr,
+ unsigned long *crcPtr)
+{
+ unsigned long chunkType = 0;
+ int chunkSz = 0;
+ unsigned long crc = 0;
+
+ /*
+ * Continue until finding a chunk type that is handled.
+ */
+
+ while (!chunkType) {
+ unsigned long temp;
+ unsigned char pc[4];
+ int i;
+
+ /*
+ * Read the 4-byte length field for the chunk. The length field is not
+ * included in the CRC calculation, so the running CRC must be reset
+ * afterward. Limit chunk lengths to INT_MAX, to align with the
+ * maximum size for Tcl_Read, Tcl_GetByteArrayFromObj, etc.
+ */
+
+ if (ReadData(interp, pngPtr, pc, 4, NULL) == TCL_ERROR) {
+ return TCL_ERROR;
+ }
+
+ temp = PNG_INT32(pc[0], pc[1], pc[2], pc[3]);
+
+ if (temp > INT_MAX) {
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "chunk size is out of supported range on this architecture",
+ -1));
+ Tcl_SetErrorCode(interp, "TK", "IMAGE", "PNG", "OUTSIZE", NULL);
+ return TCL_ERROR;
+ }
+
+ chunkSz = (int) temp;
+ crc = Tcl_ZlibCRC32(0, NULL, 0);
+
+ /*
+ * Read the 4-byte chunk type.
+ */
+
+ if (ReadData(interp, pngPtr, pc, 4, &crc) == TCL_ERROR) {
+ return TCL_ERROR;
+ }
+
+ /*
+ * Convert it to a host-order integer for simple comparison.
+ */
+
+ chunkType = PNG_INT32(pc[0], pc[1], pc[2], pc[3]);
+
+ /*
+ * Check to see if this is a known/supported chunk type. Note that the
+ * PNG specs require non-critical (i.e., ancillary) chunk types that
+ * are not recognized to be ignored, rather than be treated as an
+ * error. It does, however, recommend that an unknown critical chunk
+ * type be treated as a failure.
+ *
+ * This switch/loop acts as a filter of sorts for undesired chunk
+ * types. The chunk type should still be checked elsewhere for
+ * determining it is in the correct order.
+ */
+
+ switch (chunkType) {
+ /*
+ * These chunk types are required and/or supported.
+ */
+
+ case CHUNK_IDAT:
+ case CHUNK_IEND:
+ case CHUNK_IHDR:
+ case CHUNK_PLTE:
+ case CHUNK_tRNS:
+ break;
+
+ /*
+ * These chunk types are part of the standard, but are not used by
+ * this implementation (at least not yet). Note that these are all
+ * ancillary chunks (lowercase first letter).
+ */
+
+ case CHUNK_bKGD:
+ case CHUNK_cHRM:
+ case CHUNK_gAMA:
+ case CHUNK_hIST:
+ case CHUNK_iCCP:
+ case CHUNK_iTXt:
+ case CHUNK_oFFs:
+ case CHUNK_pCAL:
+ case CHUNK_pHYs:
+ case CHUNK_sBIT:
+ case CHUNK_sCAL:
+ case CHUNK_sPLT:
+ case CHUNK_sRGB:
+ case CHUNK_tEXt:
+ case CHUNK_tIME:
+ case CHUNK_zTXt:
+ /*
+ * TODO: might want to check order here.
+ */
+
+ if (SkipChunk(interp, pngPtr, chunkSz, crc) == TCL_ERROR) {
+ return TCL_ERROR;
+ }
+
+ chunkType = 0;
+ break;
+
+ default:
+ /*
+ * Unknown chunk type. If it's critical, we can't continue.
+ */
+
+ if (!(chunkType & PNG_CF_ANCILLARY)) {
+ if (chunkType & PNG_INT32(128,128,128,128)) {
+ /*
+ * No nice ASCII conversion; shouldn't happen either, but
+ * we'll be doubly careful.
+ */
+
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "encountered an unsupported criticial chunk type",
+ -1));
+ } else {
+ char typeString[5];
+
+ typeString[0] = (char) ((chunkType >> 24) & 255);
+ typeString[1] = (char) ((chunkType >> 16) & 255);
+ typeString[2] = (char) ((chunkType >> 8) & 255);
+ typeString[3] = (char) (chunkType & 255);
+ typeString[4] = '\0';
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "encountered an unsupported criticial chunk type"
+ " \"%s\"", typeString));
+ }
+ Tcl_SetErrorCode(interp, "TK", "IMAGE", "PNG",
+ "UNSUPPORTED_CRITICAL", NULL);
+ return TCL_ERROR;
+ }
+
+ /*
+ * Check to see if the chunk type has legal bytes.
+ */
+
+ for (i=0 ; i<4 ; i++) {
+ if ((pc[i] < 65) || (pc[i] > 122) ||
+ ((pc[i] > 90) && (pc[i] < 97))) {
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "invalid chunk type", -1));
+ Tcl_SetErrorCode(interp, "TK", "IMAGE", "PNG",
+ "INVALID_CHUNK", NULL);
+ return TCL_ERROR;
+ }
+ }
+
+ /*
+ * It seems to be an otherwise legally labelled ancillary chunk
+ * that we don't want, so skip it after at least checking its CRC.
+ */
+
+ if (SkipChunk(interp, pngPtr, chunkSz, crc) == TCL_ERROR) {
+ return TCL_ERROR;
+ }
+
+ chunkType = 0;
+ }
+ }
+
+ /*
+ * Found a known chunk type that's handled, albiet possibly not in the
+ * right order. Send back the chunk type (for further checking or
+ * handling), the chunk size and the current CRC for the rest of the
+ * calculation.
+ */
+
+ *typePtr = chunkType;
+ *sizePtr = chunkSz;
+ *crcPtr = crc;
+
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * CheckColor --
+ *
+ * Do validation on color type, depth, and related information, and
+ * calculates storage requirements and offsets based on image dimensions
+ * and color.
+ *
+ * Results:
+ * TCL_OK, or TCL_ERROR if color information is invalid or some other
+ * failure occurs.
+ *
+ * Side effects:
+ * None
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+CheckColor(
+ Tcl_Interp *interp,
+ PNGImage *pngPtr)
+{
+ int offset;
+
+ /*
+ * Verify the color type is valid and the bit depth is allowed.
+ */
+
+ switch (pngPtr->colorType) {
+ case PNG_COLOR_GRAY:
+ pngPtr->numChannels = 1;
+ if ((1 != pngPtr->bitDepth) && (2 != pngPtr->bitDepth) &&
+ (4 != pngPtr->bitDepth) && (8 != pngPtr->bitDepth) &&
+ (16 != pngPtr->bitDepth)) {
+ goto unsupportedDepth;
+ }
+ break;
+
+ case PNG_COLOR_RGB:
+ pngPtr->numChannels = 3;
+ if ((8 != pngPtr->bitDepth) && (16 != pngPtr->bitDepth)) {
+ goto unsupportedDepth;
+ }
+ break;
+
+ case PNG_COLOR_PLTE:
+ pngPtr->numChannels = 1;
+ if ((1 != pngPtr->bitDepth) && (2 != pngPtr->bitDepth) &&
+ (4 != pngPtr->bitDepth) && (8 != pngPtr->bitDepth)) {
+ goto unsupportedDepth;
+ }
+ break;
+
+ case PNG_COLOR_GRAYALPHA:
+ pngPtr->numChannels = 2;
+ if ((8 != pngPtr->bitDepth) && (16 != pngPtr->bitDepth)) {
+ goto unsupportedDepth;
+ }
+ break;
+
+ case PNG_COLOR_RGBA:
+ pngPtr->numChannels = 4;
+ if ((8 != pngPtr->bitDepth) && (16 != pngPtr->bitDepth)) {
+ unsupportedDepth:
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "bit depth is not allowed for given color type", -1));
+ Tcl_SetErrorCode(interp, "TK", "IMAGE", "PNG", "BAD_DEPTH", NULL);
+ return TCL_ERROR;
+ }
+ break;
+
+ default:
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "unknown color type field %d", pngPtr->colorType));
+ Tcl_SetErrorCode(interp, "TK", "IMAGE", "PNG", "UNKNOWN_COLOR", NULL);
+ return TCL_ERROR;
+ }
+
+ /*
+ * Set up the Tk photo block's pixel size and channel offsets. offset
+ * array elements should already be 0 from the memset during InitPNGImage.
+ */
+
+ offset = (pngPtr->bitDepth > 8) ? 2 : 1;
+
+ if (pngPtr->colorType & PNG_COLOR_USED) {
+ pngPtr->block.pixelSize = offset * 4;
+ pngPtr->block.offset[1] = offset;
+ pngPtr->block.offset[2] = offset * 2;
+ pngPtr->block.offset[3] = offset * 3;
+ } else {
+ pngPtr->block.pixelSize = offset * 2;
+ pngPtr->block.offset[3] = offset;
+ }
+
+ /*
+ * Calculate the block pitch, which is the number of bytes per line in the
+ * image, given image width and depth of color. Make sure that it it isn't
+ * larger than Tk can handle.
+ */
+
+ if (pngPtr->block.width > INT_MAX / pngPtr->block.pixelSize) {
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "image pitch is out of supported range on this architecture",
+ -1));
+ Tcl_SetErrorCode(interp, "TK", "IMAGE", "PNG", "PITCH", NULL);
+ return TCL_ERROR;
+ }
+
+ pngPtr->block.pitch = pngPtr->block.pixelSize * pngPtr->block.width;
+
+ /*
+ * Calculate the total size of the image as represented to Tk given pitch
+ * and image height. Make sure that it isn't larger than Tk can handle.
+ */
+
+ if (pngPtr->block.height > INT_MAX / pngPtr->block.pitch) {
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "image total size is out of supported range on this architecture",
+ -1));
+ Tcl_SetErrorCode(interp, "TK", "IMAGE", "PNG", "SIZE", NULL);
+ return TCL_ERROR;
+ }
+
+ pngPtr->blockLen = pngPtr->block.height * pngPtr->block.pitch;
+
+ /*
+ * Determine number of bytes per pixel in the source for later use.
+ */
+
+ switch (pngPtr->colorType) {
+ case PNG_COLOR_GRAY:
+ pngPtr->bytesPerPixel = (pngPtr->bitDepth > 8) ? 2 : 1;
+ break;
+ case PNG_COLOR_RGB:
+ pngPtr->bytesPerPixel = (pngPtr->bitDepth > 8) ? 6 : 3;
+ break;
+ case PNG_COLOR_PLTE:
+ pngPtr->bytesPerPixel = 1;
+ break;
+ case PNG_COLOR_GRAYALPHA:
+ pngPtr->bytesPerPixel = (pngPtr->bitDepth > 8) ? 4 : 2;
+ break;
+ case PNG_COLOR_RGBA:
+ pngPtr->bytesPerPixel = (pngPtr->bitDepth > 8) ? 8 : 4;
+ break;
+ default:
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "unknown color type %d", pngPtr->colorType));
+ Tcl_SetErrorCode(interp, "TK", "IMAGE", "PNG", "UNKNOWN_COLOR", NULL);
+ return TCL_ERROR;
+ }
+
+ /*
+ * Calculate scale factor for bit depths less than 8, in order to adjust
+ * them to a minimum of 8 bits per pixel in the Tk image.
+ */
+
+ if (pngPtr->bitDepth < 8) {
+ pngPtr->bitScale = 255 / (int)(pow(2, pngPtr->bitDepth) - 1);
+ } else {
+ pngPtr->bitScale = 1;
+ }
+
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ReadIHDR --
+ *
+ * This function reads the PNG header from the beginning of a PNG file
+ * and returns the dimensions of the image.
+ *
+ * Results:
+ * The return value is 1 if file "f" appears to start with a valid PNG
+ * header, 0 otherwise. If the header is valid, then *widthPtr and
+ * *heightPtr are modified to hold the dimensions of the image.
+ *
+ * Side effects:
+ * The access position in f advances.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+ReadIHDR(
+ Tcl_Interp *interp,
+ PNGImage *pngPtr)
+{
+ unsigned char sigBuf[PNG_SIG_SZ];
+ unsigned long chunkType;
+ int chunkSz;
+ unsigned long crc;
+ unsigned long width, height;
+ int mismatch;
+
+ /*
+ * Read the appropriate number of bytes for the PNG signature.
+ */
+
+ if (ReadData(interp, pngPtr, sigBuf, PNG_SIG_SZ, NULL) == TCL_ERROR) {
+ return TCL_ERROR;
+ }
+
+ /*
+ * Compare the read bytes to the expected signature.
+ */
+
+ mismatch = memcmp(sigBuf, pngSignature, PNG_SIG_SZ);
+
+ /*
+ * If reading from string, reset position and try base64 decode.
+ */
+
+ if (mismatch && pngPtr->strDataBuf) {
+ pngPtr->strDataBuf = Tcl_GetByteArrayFromObj(pngPtr->objDataPtr,
+ &pngPtr->strDataLen);
+ pngPtr->base64Data = pngPtr->strDataBuf;
+
+ if (ReadData(interp, pngPtr, sigBuf, PNG_SIG_SZ, NULL) == TCL_ERROR) {
+ return TCL_ERROR;
+ }
+
+ mismatch = memcmp(sigBuf, pngSignature, PNG_SIG_SZ);
+ }
+
+ if (mismatch) {
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "data stream does not have a PNG signature", -1));
+ Tcl_SetErrorCode(interp, "TK", "IMAGE", "PNG", "NO_SIG", NULL);
+ return TCL_ERROR;
+ }
+
+ if (ReadChunkHeader(interp, pngPtr, &chunkSz, &chunkType,
+ &crc) == TCL_ERROR) {
+ return TCL_ERROR;
+ }
+
+ /*
+ * Read in the IHDR (header) chunk for width, height, etc.
+ *
+ * The first chunk in the file must be the IHDR (headr) chunk.
+ */
+
+ if (chunkType != CHUNK_IHDR) {
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "expected IHDR chunk type", -1));
+ Tcl_SetErrorCode(interp, "TK", "IMAGE", "PNG", "NO_IHDR", NULL);
+ return TCL_ERROR;
+ }
+
+ if (chunkSz != 13) {
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "invalid IHDR chunk size", -1));
+ Tcl_SetErrorCode(interp, "TK", "IMAGE", "PNG", "BAD_IHDR", NULL);
+ return TCL_ERROR;
+ }
+
+ /*
+ * Read and verify the image width and height to be sure Tk can handle its
+ * dimensions. The PNG specification does not permit zero-width or
+ * zero-height images.
+ */
+
+ if (ReadInt32(interp, pngPtr, &width, &crc) == TCL_ERROR) {
+ return TCL_ERROR;
+ }
+
+ if (ReadInt32(interp, pngPtr, &height, &crc) == TCL_ERROR) {
+ return TCL_ERROR;
+ }
+
+ if (!width || !height || (width > INT_MAX) || (height > INT_MAX)) {
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "image dimensions are invalid or beyond architecture limits",
+ -1));
+ Tcl_SetErrorCode(interp, "TK", "IMAGE", "PNG", "DIMENSIONS", NULL);
+ return TCL_ERROR;
+ }
+
+ /*
+ * Set height and width for the Tk photo block.
+ */
+
+ pngPtr->block.width = (int) width;
+ pngPtr->block.height = (int) height;
+
+ /*
+ * Read and the Bit Depth and Color Type.
+ */
+
+ if (ReadData(interp, pngPtr, &pngPtr->bitDepth, 1, &crc) == TCL_ERROR) {
+ return TCL_ERROR;
+ }
+
+ if (ReadData(interp, pngPtr, &pngPtr->colorType, 1, &crc) == TCL_ERROR) {
+ return TCL_ERROR;
+ }
+
+ /*
+ * Verify that the color type is valid, the bit depth is allowed for the
+ * color type, and calculate the number of channels and pixel depth (bits
+ * per pixel * channels). Also set up offsets and sizes in the Tk photo
+ * block for the pixel data.
+ */
+
+ if (CheckColor(interp, pngPtr) == TCL_ERROR) {
+ return TCL_ERROR;
+ }
+
+ /*
+ * Only one compression method is currently defined by the standard.
+ */
+
+ if (ReadData(interp, pngPtr, &pngPtr->compression, 1, &crc) == TCL_ERROR) {
+ return TCL_ERROR;
+ }
+
+ if (pngPtr->compression != PNG_COMPRESS_DEFLATE) {
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "unknown compression method %d", pngPtr->compression));
+ Tcl_SetErrorCode(interp, "TK", "IMAGE", "PNG", "BAD_COMPRESS", NULL);
+ return TCL_ERROR;
+ }
+
+ /*
+ * Only one filter method is currently defined by the standard; the method
+ * has five actual filter types associated with it.
+ */
+
+ if (ReadData(interp, pngPtr, &pngPtr->filter, 1, &crc) == TCL_ERROR) {
+ return TCL_ERROR;
+ }
+
+ if (pngPtr->filter != PNG_FILTMETH_STANDARD) {
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "unknown filter method %d", pngPtr->filter));
+ Tcl_SetErrorCode(interp, "TK", "IMAGE", "PNG", "BAD_FILTER", NULL);
+ return TCL_ERROR;
+ }
+
+ if (ReadData(interp, pngPtr, &pngPtr->interlace, 1, &crc) == TCL_ERROR) {
+ return TCL_ERROR;
+ }
+
+ switch (pngPtr->interlace) {
+ case PNG_INTERLACE_NONE:
+ case PNG_INTERLACE_ADAM7:
+ break;
+
+ default:
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "unknown interlace method %d", pngPtr->interlace));
+ Tcl_SetErrorCode(interp, "TK", "IMAGE", "PNG", "BAD_INTERLACE", NULL);
+ return TCL_ERROR;
+ }
+
+ return CheckCRC(interp, pngPtr, crc);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ReadPLTE --
+ *
+ * This function reads the PLTE (indexed color palette) chunk data from
+ * the PNG file and populates the palette table in the PNGImage
+ * structure.
+ *
+ * Results:
+ * TCL_OK, or TCL_ERROR if an I/O error occurs or the PLTE chunk is
+ * invalid.
+ *
+ * Side effects:
+ * The access position in f advances.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+ReadPLTE(
+ Tcl_Interp *interp,
+ PNGImage *pngPtr,
+ int chunkSz,
+ unsigned long crc)
+{
+ unsigned char buffer[PNG_PLTE_MAXSZ];
+ int i, c;
+
+ /*
+ * This chunk is mandatory for color type 3 and forbidden for 2 and 6.
+ */
+
+ switch (pngPtr->colorType) {
+ case PNG_COLOR_GRAY:
+ case PNG_COLOR_GRAYALPHA:
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "PLTE chunk type forbidden for grayscale", -1));
+ Tcl_SetErrorCode(interp, "TK", "IMAGE", "PNG", "PLTE_UNEXPECTED",
+ NULL);
+ return TCL_ERROR;
+
+ default:
+ break;
+ }
+
+ /*
+ * The palette chunk contains from 1 to 256 palette entries. Each entry
+ * consists of a 3-byte RGB value. It must therefore contain a non-zero
+ * multiple of 3 bytes, up to 768.
+ */
+
+ if (!chunkSz || (chunkSz > PNG_PLTE_MAXSZ) || (chunkSz % 3)) {
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "invalid palette chunk size", -1));
+ Tcl_SetErrorCode(interp, "TK", "IMAGE", "PNG", "BAD_PLTE", NULL);
+ return TCL_ERROR;
+ }
+
+ /*
+ * Read the palette contents and stash them for later, possibly.
+ */
+
+ if (ReadData(interp, pngPtr, buffer, chunkSz, &crc) == TCL_ERROR) {
+ return TCL_ERROR;
+ }
+
+ if (CheckCRC(interp, pngPtr, crc) == TCL_ERROR) {
+ return TCL_ERROR;
+ }
+
+ /*
+ * Stash away the palette entries and entry count for later mapping each
+ * pixel's palette index to its color.
+ */
+
+ for (i=0, c=0 ; c<chunkSz ; i++) {
+ pngPtr->palette[i].red = buffer[c++];
+ pngPtr->palette[i].green = buffer[c++];
+ pngPtr->palette[i].blue = buffer[c++];
+ }
+
+ pngPtr->paletteLen = i;
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ReadTRNS --
+ *
+ * This function reads the tRNS (transparency) chunk data from the PNG
+ * file and populates the alpha field of the palette table in the
+ * PNGImage structure or the single color transparency, as appropriate
+ * for the color type.
+ *
+ * Results:
+ * TCL_OK, or TCL_ERROR if an I/O error occurs or the tRNS chunk is
+ * invalid.
+ *
+ * Side effects:
+ * The access position in f advances.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+ReadTRNS(
+ Tcl_Interp *interp,
+ PNGImage *pngPtr,
+ int chunkSz,
+ unsigned long crc)
+{
+ unsigned char buffer[PNG_TRNS_MAXSZ];
+ int i;
+
+ if (pngPtr->colorType & PNG_COLOR_ALPHA) {
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "tRNS chunk not allowed color types with a full alpha channel",
+ -1));
+ Tcl_SetErrorCode(interp, "TK", "IMAGE", "PNG", "INVALID_TRNS", NULL);
+ return TCL_ERROR;
+ }
+
+ /*
+ * For indexed color, there is up to one single-byte transparency value
+ * per palette entry (thus a max of 256).
+ */
+
+ if (chunkSz > PNG_TRNS_MAXSZ) {
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "invalid tRNS chunk size", -1));
+ Tcl_SetErrorCode(interp, "TK", "IMAGE", "PNG", "BAD_TRNS", NULL);
+ return TCL_ERROR;
+ }
+
+ /*
+ * Read in the raw transparency information.
+ */
+
+ if (ReadData(interp, pngPtr, buffer, chunkSz, &crc) == TCL_ERROR) {
+ return TCL_ERROR;
+ }
+
+ if (CheckCRC(interp, pngPtr, crc) == TCL_ERROR) {
+ return TCL_ERROR;
+ }
+
+ switch (pngPtr->colorType) {
+ case PNG_COLOR_GRAYALPHA:
+ case PNG_COLOR_RGBA:
+ break;
+
+ case PNG_COLOR_PLTE:
+ /*
+ * The number of tRNS entries must be less than or equal to the number
+ * of PLTE entries, and consists of a single-byte alpha level for the
+ * corresponding PLTE entry.
+ */
+
+ if (chunkSz > pngPtr->paletteLen) {
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "size of tRNS chunk is too large for the palette", -1));
+ Tcl_SetErrorCode(interp, "TK", "IMAGE", "PNG", "TRNS_SIZE", NULL);
+ return TCL_ERROR;
+ }
+
+ for (i=0 ; i<chunkSz ; i++) {
+ pngPtr->palette[i].alpha = buffer[i];
+ }
+ break;
+
+ case PNG_COLOR_GRAY:
+ /*
+ * Grayscale uses a single 2-byte gray level, which we'll store in
+ * palette index 0, since we're not using the palette.
+ */
+
+ if (chunkSz != 2) {
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "invalid tRNS chunk size - must 2 bytes for grayscale",
+ -1));
+ Tcl_SetErrorCode(interp, "TK", "IMAGE", "PNG", "BAD_TRNS", NULL);
+ return TCL_ERROR;
+ }
+
+ /*
+ * According to the PNG specs, if the bit depth is less than 16, then
+ * only the lower byte is used.
+ */
+
+ if (16 == pngPtr->bitDepth) {
+ pngPtr->transVal[0] = buffer[0];
+ pngPtr->transVal[1] = buffer[1];
+ } else {
+ pngPtr->transVal[0] = buffer[1];
+ }
+ pngPtr->useTRNS = 1;
+ break;
+
+ case PNG_COLOR_RGB:
+ /*
+ * TrueColor uses a single RRGGBB triplet.
+ */
+
+ if (chunkSz != 6) {
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "invalid tRNS chunk size - must 6 bytes for RGB", -1));
+ Tcl_SetErrorCode(interp, "TK", "IMAGE", "PNG", "BAD_TRNS", NULL);
+ return TCL_ERROR;
+ }
+
+ /*
+ * According to the PNG specs, if the bit depth is less than 16, then
+ * only the lower byte is used. But the tRNS chunk still contains two
+ * bytes per channel.
+ */
+
+ if (16 == pngPtr->bitDepth) {
+ memcpy(pngPtr->transVal, buffer, 6);
+ } else {
+ pngPtr->transVal[0] = buffer[1];
+ pngPtr->transVal[1] = buffer[3];
+ pngPtr->transVal[2] = buffer[5];
+ }
+ pngPtr->useTRNS = 1;
+ break;
+ }
+
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Paeth --
+ *
+ * Utility function for applying the Paeth filter to a pixel. The Paeth
+ * filter is a linear function of the pixel to be filtered and the pixels
+ * to the left, above, and above-left of the pixel to be unfiltered.
+ *
+ * Results:
+ * Result of the Paeth function for the left, above, and above-left
+ * pixels.
+ *
+ * Side effects:
+ * None
+ *
+ *----------------------------------------------------------------------
+ */
+
+static inline unsigned char
+Paeth(
+ int a,
+ int b,
+ int c)
+{
+ int pa = abs(b - c);
+ int pb = abs(a - c);
+ int pc = abs(a + b - c - c);
+
+ if ((pa <= pb) && (pa <= pc)) {
+ return (unsigned char) a;
+ }
+
+ if (pb <= pc) {
+ return (unsigned char) b;
+ }
+
+ return (unsigned char) c;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * UnfilterLine --
+ *
+ * Applies the filter algorithm specified in first byte of a line to the
+ * line of pixels being read from a PNG image.
+ *
+ * PNG specifies four filter algorithms (Sub, Up, Average, and Paeth)
+ * that combine a pixel's value with those of other pixels in the same
+ * and/or previous lines. Filtering is intended to make an image more
+ * compressible.
+ *
+ * Results:
+ * TCL_OK, or TCL_ERROR if the filter type is not recognized.
+ *
+ * Side effects:
+ * Pixel data in thisLineObj are modified.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+UnfilterLine(
+ Tcl_Interp *interp,
+ PNGImage *pngPtr)
+{
+ unsigned char *thisLine =
+ Tcl_GetByteArrayFromObj(pngPtr->thisLineObj, NULL);
+ unsigned char *lastLine =
+ Tcl_GetByteArrayFromObj(pngPtr->lastLineObj, NULL);
+
+#define PNG_FILTER_NONE 0
+#define PNG_FILTER_SUB 1
+#define PNG_FILTER_UP 2
+#define PNG_FILTER_AVG 3
+#define PNG_FILTER_PAETH 4
+
+ switch (*thisLine) {
+ case PNG_FILTER_NONE: /* Nothing to do */
+ break;
+ case PNG_FILTER_SUB: { /* Sub(x) = Raw(x) - Raw(x-bpp) */
+ unsigned char *rawBpp = thisLine + 1;
+ unsigned char *raw = rawBpp + pngPtr->bytesPerPixel;
+ unsigned char *end = thisLine + pngPtr->phaseSize;
+
+ while (raw < end) {
+ *raw++ += *rawBpp++;
+ }
+ break;
+ }
+ case PNG_FILTER_UP: /* Up(x) = Raw(x) - Prior(x) */
+ if (pngPtr->currentLine > startLine[pngPtr->phase]) {
+ unsigned char *prior = lastLine + 1;
+ unsigned char *raw = thisLine + 1;
+ unsigned char *end = thisLine + pngPtr->phaseSize;
+
+ while (raw < end) {
+ *raw++ += *prior++;
+ }
+ }
+ break;
+ case PNG_FILTER_AVG:
+ /* Avg(x) = Raw(x) - floor((Raw(x-bpp)+Prior(x))/2) */
+ if (pngPtr->currentLine > startLine[pngPtr->phase]) {
+ unsigned char *prior = lastLine + 1;
+ unsigned char *rawBpp = thisLine + 1;
+ unsigned char *raw = rawBpp;
+ unsigned char *end = thisLine + pngPtr->phaseSize;
+ unsigned char *end2 = raw + pngPtr->bytesPerPixel;
+
+ while ((raw < end2) && (raw < end)) {
+ *raw++ += *prior++ / 2;
+ }
+
+ while (raw < end) {
+ *raw++ += (unsigned char)
+ (((int) *rawBpp++ + (int) *prior++) / 2);
+ }
+ } else {
+ unsigned char *rawBpp = thisLine + 1;
+ unsigned char *raw = rawBpp + pngPtr->bytesPerPixel;
+ unsigned char *end = thisLine + pngPtr->phaseSize;
+
+ while (raw < end) {
+ *raw++ += *rawBpp++ / 2;
+ }
+ }
+ break;
+ case PNG_FILTER_PAETH:
+ /* Paeth(x) = Raw(x) - PaethPredictor(Raw(x-bpp), Prior(x), Prior(x-bpp)) */
+ if (pngPtr->currentLine > startLine[pngPtr->phase]) {
+ unsigned char *priorBpp = lastLine + 1;
+ unsigned char *prior = priorBpp;
+ unsigned char *rawBpp = thisLine + 1;
+ unsigned char *raw = rawBpp;
+ unsigned char *end = thisLine + pngPtr->phaseSize;
+ unsigned char *end2 = rawBpp + pngPtr->bytesPerPixel;
+
+ while ((raw < end) && (raw < end2)) {
+ *raw++ += *prior++;
+ }
+
+ while (raw < end) {
+ *raw++ += Paeth(*rawBpp++, *prior++, *priorBpp++);
+ }
+ } else {
+ unsigned char *rawBpp = thisLine + 1;
+ unsigned char *raw = rawBpp + pngPtr->bytesPerPixel;
+ unsigned char *end = thisLine + pngPtr->phaseSize;
+
+ while (raw < end) {
+ *raw++ += *rawBpp++;
+ }
+ }
+ break;
+ default:
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "invalid filter type %d", *thisLine));
+ Tcl_SetErrorCode(interp, "TK", "IMAGE", "PNG", "BAD_FILTER", NULL);
+ return TCL_ERROR;
+ }
+
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * DecodeLine --
+ *
+ * Unfilters a line of pixels from the PNG source data and decodes the
+ * data into the Tk_PhotoImageBlock for later copying into the Tk image.
+ *
+ * Results:
+ * TCL_OK, or TCL_ERROR if the filter type is not recognized.
+ *
+ * Side effects:
+ * Pixel data in thisLine and block are modified and state information
+ * updated.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+DecodeLine(
+ Tcl_Interp *interp,
+ PNGImage *pngPtr)
+{
+ unsigned char *pixelPtr = pngPtr->block.pixelPtr;
+ int colNum = 0; /* Current pixel column */
+ unsigned char chan = 0; /* Current channel (0..3) = (R, G, B, A) */
+ unsigned char readByte = 0; /* Current scan line byte */
+ int haveBits = 0; /* Number of bits remaining in current byte */
+ unsigned char pixBits = 0; /* Extracted bits for current channel */
+ int shifts = 0; /* Number of channels extracted from byte */
+ int offset = 0; /* Current offset into pixelPtr */
+ int colStep = 1; /* Column increment each pass */
+ int pixStep = 0; /* extra pixelPtr increment each pass */
+ unsigned char lastPixel[6];
+ unsigned char *p = Tcl_GetByteArrayFromObj(pngPtr->thisLineObj, NULL);
+
+ p++;
+ if (UnfilterLine(interp, pngPtr) == TCL_ERROR) {
+ return TCL_ERROR;
+ }
+ if (pngPtr->currentLine >= pngPtr->block.height) {
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "PNG image data overflow"));
+ Tcl_SetErrorCode(interp, "TK", "IMAGE", "PNG", "DATA_OVERFLOW", NULL);
+ return TCL_ERROR;
+ }
+
+
+ if (pngPtr->interlace) {
+ switch (pngPtr->phase) {
+ case 1: /* Phase 1: */
+ colStep = 8; /* 1 pixel per block of 8 per line */
+ break; /* Start at column 0 */
+ case 2: /* Phase 2: */
+ colStep = 8; /* 1 pixels per block of 8 per line */
+ colNum = 4; /* Start at column 4 */
+ break;
+ case 3: /* Phase 3: */
+ colStep = 4; /* 2 pixels per block of 8 per line */
+ break; /* Start at column 0 */
+ case 4: /* Phase 4: */
+ colStep = 4; /* 2 pixels per block of 8 per line */
+ colNum = 2; /* Start at column 2 */
+ break;
+ case 5: /* Phase 5: */
+ colStep = 2; /* 4 pixels per block of 8 per line */
+ break; /* Start at column 0 */
+ case 6: /* Phase 6: */
+ colStep = 2; /* 4 pixels per block of 8 per line */
+ colNum = 1; /* Start at column 1 */
+ break;
+ /* Phase 7: */
+ /* 8 pixels per block of 8 per line */
+ /* Start at column 0 */
+ }
+ }
+
+ /*
+ * Calculate offset into pixelPtr for the first pixel of the line.
+ */
+
+ offset = pngPtr->currentLine * pngPtr->block.pitch;
+
+ /*
+ * Adjust up for the starting pixel of the line.
+ */
+
+ offset += colNum * pngPtr->block.pixelSize;
+
+ /*
+ * Calculate the extra number of bytes to skip between columns.
+ */
+
+ pixStep = (colStep - 1) * pngPtr->block.pixelSize;
+
+ for ( ; colNum < pngPtr->block.width ; colNum += colStep) {
+ if (haveBits < (pngPtr->bitDepth * pngPtr->numChannels)) {
+ haveBits = 0;
+ }
+
+ for (chan = 0 ; chan < pngPtr->numChannels ; chan++) {
+ if (!haveBits) {
+ shifts = 0;
+ readByte = *p++;
+ haveBits += 8;
+ }
+
+ if (16 == pngPtr->bitDepth) {
+ pngPtr->block.pixelPtr[offset++] = readByte;
+
+ if (pngPtr->useTRNS) {
+ lastPixel[chan * 2] = readByte;
+ }
+
+ readByte = *p++;
+
+ if (pngPtr->useTRNS) {
+ lastPixel[(chan * 2) + 1] = readByte;
+ }
+
+ pngPtr->block.pixelPtr[offset++] = readByte;
+
+ haveBits = 0;
+ continue;
+ }
+
+ switch (pngPtr->bitDepth) {
+ case 1:
+ pixBits = (unsigned char)((readByte >> (7-shifts)) & 0x01);
+ break;
+ case 2:
+ pixBits = (unsigned char)((readByte >> (6-shifts*2)) & 0x03);
+ break;
+ case 4:
+ pixBits = (unsigned char)((readByte >> (4-shifts*4)) & 0x0f);
+ break;
+ case 8:
+ pixBits = readByte;
+ break;
+ }
+
+ if (PNG_COLOR_PLTE == pngPtr->colorType) {
+ pixelPtr[offset++] = pngPtr->palette[pixBits].red;
+ pixelPtr[offset++] = pngPtr->palette[pixBits].green;
+ pixelPtr[offset++] = pngPtr->palette[pixBits].blue;
+ pixelPtr[offset++] = pngPtr->palette[pixBits].alpha;
+ chan += 2;
+ } else {
+ pixelPtr[offset++] = (unsigned char)
+ (pixBits * pngPtr->bitScale);
+
+ if (pngPtr->useTRNS) {
+ lastPixel[chan] = pixBits;
+ }
+ }
+
+ haveBits -= pngPtr->bitDepth;
+ shifts++;
+ }
+
+ /*
+ * Apply boolean transparency via tRNS data if necessary (where
+ * necessary means a tRNS chunk was provided and we're not using an
+ * alpha channel or indexed alpha).
+ */
+
+ if ((PNG_COLOR_PLTE != pngPtr->colorType) &&
+ !(pngPtr->colorType & PNG_COLOR_ALPHA)) {
+ unsigned char alpha;
+
+ if (pngPtr->useTRNS) {
+ if (memcmp(lastPixel, pngPtr->transVal,
+ pngPtr->bytesPerPixel) == 0) {
+ alpha = 0x00;
+ } else {
+ alpha = 0xff;
+ }
+ } else {
+ alpha = 0xff;
+ }
+
+ pixelPtr[offset++] = alpha;
+
+ if (16 == pngPtr->bitDepth) {
+ pixelPtr[offset++] = alpha;
+ }
+ }
+
+ offset += pixStep;
+ }
+
+ if (pngPtr->interlace) {
+ /* Skip lines */
+
+ switch (pngPtr->phase) {
+ case 1: case 2: case 3:
+ pngPtr->currentLine += 8;
+ break;
+ case 4: case 5:
+ pngPtr->currentLine += 4;
+ break;
+ case 6: case 7:
+ pngPtr->currentLine += 2;
+ break;
+ }
+
+ /*
+ * Start the next phase if there are no more lines to do.
+ */
+
+ if (pngPtr->currentLine >= pngPtr->block.height) {
+ unsigned long pixels = 0;
+
+ while ((!pixels || (pngPtr->currentLine >= pngPtr->block.height))
+ && (pngPtr->phase < 7)) {
+ pngPtr->phase++;
+
+ switch (pngPtr->phase) {
+ case 2:
+ pixels = (pngPtr->block.width + 3) >> 3;
+ pngPtr->currentLine = 0;
+ break;
+ case 3:
+ pixels = (pngPtr->block.width + 3) >> 2;
+ pngPtr->currentLine = 4;
+ break;
+ case 4:
+ pixels = (pngPtr->block.width + 1) >> 2;
+ pngPtr->currentLine = 0;
+ break;
+ case 5:
+ pixels = (pngPtr->block.width + 1) >> 1;
+ pngPtr->currentLine = 2;
+ break;
+ case 6:
+ pixels = pngPtr->block.width >> 1;
+ pngPtr->currentLine = 0;
+ break;
+ case 7:
+ pngPtr->currentLine = 1;
+ pixels = pngPtr->block.width;
+ break;
+ }
+ }
+
+ if (16 == pngPtr->bitDepth) {
+ pngPtr->phaseSize = 1 + (pngPtr->numChannels * pixels * 2);
+ } else {
+ pngPtr->phaseSize = 1 + ((pngPtr->numChannels * pixels *
+ pngPtr->bitDepth + 7) >> 3);
+ }
+ }
+ } else {
+ pngPtr->currentLine++;
+ }
+
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ReadIDAT --
+ *
+ * This function reads the IDAT (pixel data) chunk from the PNG file to
+ * build the image. It will continue reading until all IDAT chunks have
+ * been processed or an error occurs.
+ *
+ * Results:
+ * TCL_OK, or TCL_ERROR if an I/O error occurs or an IDAT chunk is
+ * invalid.
+ *
+ * Side effects:
+ * The access position in f advances. Memory may be allocated by zlib
+ * through PNGZAlloc.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+ReadIDAT(
+ Tcl_Interp *interp,
+ PNGImage *pngPtr,
+ int chunkSz,
+ unsigned long crc)
+{
+ /*
+ * Process IDAT contents until there is no more in this chunk.
+ */
+
+ while (chunkSz && !Tcl_ZlibStreamEof(pngPtr->stream)) {
+ int len1, len2;
+
+ /*
+ * Read another block of input into the zlib stream if data remains.
+ */
+
+ if (chunkSz) {
+ Tcl_Obj *inputObj = NULL;
+ int blockSz = PNG_MIN(chunkSz, PNG_BLOCK_SZ);
+ unsigned char *inputPtr = NULL;
+
+ /*
+ * Check for end of zlib stream.
+ */
+
+ if (Tcl_ZlibStreamEof(pngPtr->stream)) {
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "extra data after end of zlib stream", -1));
+ Tcl_SetErrorCode(interp, "TK", "IMAGE", "PNG", "EXTRA_DATA",
+ NULL);
+ return TCL_ERROR;
+ }
+
+ inputObj = Tcl_NewObj();
+ Tcl_IncrRefCount(inputObj);
+ inputPtr = Tcl_SetByteArrayLength(inputObj, blockSz);
+
+ /*
+ * Read the next bit of IDAT chunk data, up to read buffer size.
+ */
+
+ if (ReadData(interp, pngPtr, inputPtr, blockSz,
+ &crc) == TCL_ERROR) {
+ Tcl_DecrRefCount(inputObj);
+ return TCL_ERROR;
+ }
+
+ chunkSz -= blockSz;
+
+ Tcl_ZlibStreamPut(pngPtr->stream, inputObj, TCL_ZLIB_NO_FLUSH);
+ Tcl_DecrRefCount(inputObj);
+ }
+
+ /*
+ * Inflate, processing each output buffer's worth as a line of pixels,
+ * until we cannot fill the buffer any more.
+ */
+
+ getNextLine:
+ Tcl_GetByteArrayFromObj(pngPtr->thisLineObj, &len1);
+ if (Tcl_ZlibStreamGet(pngPtr->stream, pngPtr->thisLineObj,
+ pngPtr->phaseSize - len1) == TCL_ERROR) {
+ return TCL_ERROR;
+ }
+ Tcl_GetByteArrayFromObj(pngPtr->thisLineObj, &len2);
+
+ if (len2 == pngPtr->phaseSize) {
+ if (pngPtr->phase > 7) {
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "extra data after final scan line of final phase",
+ -1));
+ Tcl_SetErrorCode(interp, "TK", "IMAGE", "PNG", "EXTRA_DATA",
+ NULL);
+ return TCL_ERROR;
+ }
+
+ if (DecodeLine(interp, pngPtr) == TCL_ERROR) {
+ return TCL_ERROR;
+ }
+
+ /*
+ * Swap the current/last lines so that we always have the last
+ * line processed available, which is necessary for filtering.
+ */
+
+ {
+ Tcl_Obj *temp = pngPtr->lastLineObj;
+
+ pngPtr->lastLineObj = pngPtr->thisLineObj;
+ pngPtr->thisLineObj = temp;
+ }
+ Tcl_SetByteArrayLength(pngPtr->thisLineObj, 0);
+
+ /*
+ * Try to read another line of pixels out of the buffer
+ * immediately, but don't allow write past end of block.
+ */
+
+ if (pngPtr->currentLine < pngPtr->block.height) {
+ goto getNextLine;
+ }
+
+ }
+
+ /*
+ * Got less than a whole buffer-load of pixels. Either we're going to
+ * be getting more data from the next IDAT, or we've done what we can
+ * here.
+ */
+ }
+
+ /*
+ * Ensure that if we've got to the end of the compressed data, we've
+ * also got to the end of the compressed stream. This sanity check is
+ * enforced by most PNG readers.
+ */
+
+ if (chunkSz != 0) {
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "compressed data after stream finalize in PNG data", -1));
+ Tcl_SetErrorCode(interp, "TK", "IMAGE", "PNG", "EXTRA_DATA", NULL);
+ return TCL_ERROR;
+ }
+
+ return CheckCRC(interp, pngPtr, crc);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ApplyAlpha --
+ *
+ * Applies an overall alpha value to a complete image that has been read.
+ * This alpha value is specified using the -format option to [image
+ * create photo].
+ *
+ * Results:
+ * N/A
+ *
+ * Side effects:
+ * The access position in f may change.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+ApplyAlpha(
+ PNGImage *pngPtr)
+{
+ if (pngPtr->alpha != 1.0) {
+ register unsigned char *p = pngPtr->block.pixelPtr;
+ unsigned char *endPtr = p + pngPtr->blockLen;
+ int offset = pngPtr->block.offset[3];
+
+ p += offset;
+
+ if (16 == pngPtr->bitDepth) {
+ register int channel;
+
+ while (p < endPtr) {
+ channel = (unsigned char)
+ (((p[0] << 8) | p[1]) * pngPtr->alpha);
+
+ *p++ = (unsigned char) (channel >> 8);
+ *p++ = (unsigned char) (channel & 0xff);
+
+ p += offset;
+ }
+ } else {
+ while (p < endPtr) {
+ p[0] = (unsigned char) (pngPtr->alpha * p[0]);
+ p += 1 + offset;
+ }
+ }
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ParseFormat --
+ *
+ * This function parses the -format string that can be specified to the
+ * [image create photo] command to extract options for postprocessing of
+ * loaded images. Currently, this just allows specifying and applying an
+ * overall alpha value to the loaded image (for example, to make it
+ * entirely 50% as transparent as the actual image file).
+ *
+ * Results:
+ * TCL_OK, or TCL_ERROR if the format specification is invalid.
+ *
+ * Side effects:
+ * None
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+ParseFormat(
+ Tcl_Interp *interp,
+ Tcl_Obj *fmtObj,
+ PNGImage *pngPtr)
+{
+ Tcl_Obj **objv = NULL;
+ int objc = 0;
+ static const char *const fmtOptions[] = {
+ "-alpha", NULL
+ };
+ enum fmtOptions {
+ OPT_ALPHA
+ };
+
+ /*
+ * Extract elements of format specification as a list.
+ */
+
+ if (fmtObj &&
+ Tcl_ListObjGetElements(interp, fmtObj, &objc, &objv) != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ for (; objc>0 ; objc--, objv++) {
+ int optIndex;
+
+ /*
+ * Ignore the "png" part of the format specification.
+ */
+
+ if (!strcasecmp(Tcl_GetString(objv[0]), "png")) {
+ continue;
+ }
+
+ if (Tcl_GetIndexFromObjStruct(interp, objv[0], fmtOptions,
+ sizeof(char *), "option", 0, &optIndex) == TCL_ERROR) {
+ return TCL_ERROR;
+ }
+
+ if (objc < 2) {
+ Tcl_WrongNumArgs(interp, 1, objv, "value");
+ return TCL_ERROR;
+ }
+
+ objc--;
+ objv++;
+
+ switch ((enum fmtOptions) optIndex) {
+ case OPT_ALPHA:
+ if (Tcl_GetDoubleFromObj(interp, objv[0],
+ &pngPtr->alpha) == TCL_ERROR) {
+ return TCL_ERROR;
+ }
+
+ if ((pngPtr->alpha < 0.0) || (pngPtr->alpha > 1.0)) {
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "-alpha value must be between 0.0 and 1.0", -1));
+ Tcl_SetErrorCode(interp, "TK", "IMAGE", "PNG", "BAD_ALPHA",
+ NULL);
+ return TCL_ERROR;
+ }
+ break;
+ }
+ }
+
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * DecodePNG --
+ *
+ * This function handles the entirety of reading a PNG file (or data)
+ * from the first byte to the last.
+ *
+ * Results:
+ * TCL_OK, or TCL_ERROR if an I/O error occurs or any problems are
+ * detected in the PNG file.
+ *
+ * Side effects:
+ * The access position in f advances. Memory may be allocated and image
+ * dimensions and contents may change.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+DecodePNG(
+ Tcl_Interp *interp,
+ PNGImage *pngPtr,
+ Tcl_Obj *fmtObj,
+ Tk_PhotoHandle imageHandle,
+ int destX,
+ int destY)
+{
+ unsigned long chunkType;
+ int chunkSz;
+ unsigned long crc;
+
+ /*
+ * Parse the PNG signature and IHDR (header) chunk.
+ */
+
+ if (ReadIHDR(interp, pngPtr) == TCL_ERROR) {
+ return TCL_ERROR;
+ }
+
+ /*
+ * Extract alpha value from -format object, if specified.
+ */
+
+ if (ParseFormat(interp, fmtObj, pngPtr) == TCL_ERROR) {
+ return TCL_ERROR;
+ }
+
+ /*
+ * The next chunk may either be a PLTE (Palette) chunk or the first of at
+ * least one IDAT (data) chunks. It could also be one of a number of
+ * ancillary chunks, but those are skipped for us by the switch in
+ * ReadChunkHeader().
+ *
+ * PLTE is mandatory for color type 3 and forbidden for 2 and 6
+ */
+
+ if (ReadChunkHeader(interp, pngPtr, &chunkSz, &chunkType,
+ &crc) == TCL_ERROR) {
+ return TCL_ERROR;
+ }
+
+ if (CHUNK_PLTE == chunkType) {
+ /*
+ * Finish parsing the PLTE chunk.
+ */
+
+ if (ReadPLTE(interp, pngPtr, chunkSz, crc) == TCL_ERROR) {
+ return TCL_ERROR;
+ }
+
+ /*
+ * Begin the next chunk.
+ */
+
+ if (ReadChunkHeader(interp, pngPtr, &chunkSz, &chunkType,
+ &crc) == TCL_ERROR) {
+ return TCL_ERROR;
+ }
+ } else if (PNG_COLOR_PLTE == pngPtr->colorType) {
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "PLTE chunk required for indexed color", -1));
+ Tcl_SetErrorCode(interp, "TK", "IMAGE", "PNG", "NEED_PLTE", NULL);
+ return TCL_ERROR;
+ }
+
+ /*
+ * The next chunk may be a tRNS (palette transparency) chunk, depending on
+ * the color type. It must come after the PLTE chunk and before the IDAT
+ * chunk, but can be present if there is no PLTE chunk because it can be
+ * used for Grayscale and TrueColor in lieu of an alpha channel.
+ */
+
+ if (CHUNK_tRNS == chunkType) {
+ /*
+ * Finish parsing the tRNS chunk.
+ */
+
+ if (ReadTRNS(interp, pngPtr, chunkSz, crc) == TCL_ERROR) {
+ return TCL_ERROR;
+ }
+
+ /*
+ * Begin the next chunk.
+ */
+
+ if (ReadChunkHeader(interp, pngPtr, &chunkSz, &chunkType,
+ &crc) == TCL_ERROR) {
+ return TCL_ERROR;
+ }
+ }
+
+ /*
+ * Other ancillary chunk types could appear here, but for now we're only
+ * interested in IDAT. The others should have been skipped.
+ */
+
+ if (chunkType != CHUNK_IDAT) {
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "at least one IDAT chunk is required", -1));
+ Tcl_SetErrorCode(interp, "TK", "IMAGE", "PNG", "NEED_IDAT", NULL);
+ return TCL_ERROR;
+ }
+
+ /*
+ * Expand the photo size (if not set by the user) to provide enough space
+ * for the image being parsed. It does not matter if width or height wrap
+ * to negative here: Tk will not shrink the image.
+ */
+
+ if (Tk_PhotoExpand(interp, imageHandle, destX + pngPtr->block.width,
+ destY + pngPtr->block.height) == TCL_ERROR) {
+ return TCL_ERROR;
+ }
+
+ /*
+ * A scan line consists of one byte for a filter type, plus the number of
+ * bits per color sample times the number of color samples per pixel.
+ */
+
+ if (pngPtr->block.width > ((INT_MAX - 1) / (pngPtr->numChannels * 2))) {
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "line size is out of supported range on this architecture",
+ -1));
+ Tcl_SetErrorCode(interp, "TK", "IMAGE", "PNG", "LINE_SIZE", NULL);
+ return TCL_ERROR;
+ }
+
+ if (16 == pngPtr->bitDepth) {
+ pngPtr->lineSize = 1 + (pngPtr->numChannels * pngPtr->block.width*2);
+ } else {
+ pngPtr->lineSize = 1 + ((pngPtr->numChannels * pngPtr->block.width) /
+ (8 / pngPtr->bitDepth));
+ if (pngPtr->block.width % (8 / pngPtr->bitDepth)) {
+ pngPtr->lineSize++;
+ }
+ }
+
+ /*
+ * Allocate space for decoding the scan lines.
+ */
+
+ pngPtr->lastLineObj = Tcl_NewObj();
+ Tcl_IncrRefCount(pngPtr->lastLineObj);
+ pngPtr->thisLineObj = Tcl_NewObj();
+ Tcl_IncrRefCount(pngPtr->thisLineObj);
+
+ pngPtr->block.pixelPtr = attemptckalloc(pngPtr->blockLen);
+ if (!pngPtr->block.pixelPtr) {
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "memory allocation failed", -1));
+ Tcl_SetErrorCode(interp, "TK", "MALLOC", NULL);
+ return TCL_ERROR;
+ }
+
+ /*
+ * Determine size of the first phase if interlaced. Phase size should
+ * always be <= line size, so probably not necessary to check for
+ * arithmetic overflow here: should be covered by line size check.
+ */
+
+ if (pngPtr->interlace) {
+ /*
+ * Only one pixel per block of 8 per line in the first phase.
+ */
+
+ unsigned int pixels = (pngPtr->block.width + 7) >> 3;
+
+ pngPtr->phase = 1;
+ if (16 == pngPtr->bitDepth) {
+ pngPtr->phaseSize = 1 + pngPtr->numChannels*pixels*2;
+ } else {
+ pngPtr->phaseSize = 1 +
+ ((pngPtr->numChannels*pixels*pngPtr->bitDepth + 7) >> 3);
+ }
+ } else {
+ pngPtr->phaseSize = pngPtr->lineSize;
+ }
+
+ /*
+ * All of the IDAT (data) chunks must be consecutive.
+ */
+
+ while (CHUNK_IDAT == chunkType) {
+ if (ReadIDAT(interp, pngPtr, chunkSz, crc) == TCL_ERROR) {
+ return TCL_ERROR;
+ }
+
+ if (ReadChunkHeader(interp, pngPtr, &chunkSz, &chunkType,
+ &crc) == TCL_ERROR) {
+ return TCL_ERROR;
+ }
+ }
+
+ /*
+ * Ensure that we've got to the end of the compressed stream now that
+ * there are no more IDAT segments. This sanity check is enforced by most
+ * PNG readers.
+ */
+
+ if (!Tcl_ZlibStreamEof(pngPtr->stream)) {
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "unfinalized data stream in PNG data", -1));
+ Tcl_SetErrorCode(interp, "TK", "IMAGE", "PNG", "EXTRA_DATA", NULL);
+ return TCL_ERROR;
+ }
+
+ /*
+ * Now skip the remaining chunks which we're also not interested in.
+ */
+
+ while (CHUNK_IEND != chunkType) {
+ if (SkipChunk(interp, pngPtr, chunkSz, crc) == TCL_ERROR) {
+ return TCL_ERROR;
+ }
+
+ if (ReadChunkHeader(interp, pngPtr, &chunkSz, &chunkType,
+ &crc) == TCL_ERROR) {
+ return TCL_ERROR;
+ }
+ }
+
+ /*
+ * Got the IEND (end of image) chunk. Do some final checks...
+ */
+
+ if (chunkSz) {
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "IEND chunk contents must be empty", -1));
+ Tcl_SetErrorCode(interp, "TK", "IMAGE", "PNG", "BAD_IEND", NULL);
+ return TCL_ERROR;
+ }
+
+ /*
+ * Check the CRC on the IEND chunk.
+ */
+
+ if (CheckCRC(interp, pngPtr, crc) == TCL_ERROR) {
+ return TCL_ERROR;
+ }
+
+ /*
+ * TODO: verify that nothing else comes after the IEND chunk, or do we
+ * really care?
+ */
+
+#if 0
+ if (ReadData(interp, pngPtr, &c, 1, NULL) != TCL_ERROR) {
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "extra data following IEND chunk", -1));
+ Tcl_SetErrorCode(interp, "TK", "IMAGE", "PNG", "BAD_IEND", NULL);
+ return TCL_ERROR;
+ }
+#endif
+
+ /*
+ * Apply overall image alpha if specified.
+ */
+
+ ApplyAlpha(pngPtr);
+
+ /*
+ * Copy the decoded image block into the Tk photo image.
+ */
+
+ if (Tk_PhotoPutBlock(interp, imageHandle, &pngPtr->block, destX, destY,
+ pngPtr->block.width, pngPtr->block.height,
+ TK_PHOTO_COMPOSITE_SET) == TCL_ERROR) {
+ return TCL_ERROR;
+ }
+
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * FileMatchPNG --
+ *
+ * This function is invoked by the photo image type to see if a file
+ * contains image data in PNG format.
+ *
+ * Results:
+ * The return value is 1 if the first characters in file f look like PNG
+ * data, and 0 otherwise.
+ *
+ * Side effects:
+ * The access position in f may change.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+FileMatchPNG(
+ Tcl_Channel chan,
+ const char *fileName,
+ Tcl_Obj *fmtObj,
+ int *widthPtr,
+ int *heightPtr,
+ Tcl_Interp *interp)
+{
+ PNGImage png;
+ int match = 0;
+
+ InitPNGImage(NULL, &png, chan, NULL, TCL_ZLIB_STREAM_INFLATE);
+
+ if (ReadIHDR(interp, &png) == TCL_OK) {
+ *widthPtr = png.block.width;
+ *heightPtr = png.block.height;
+ match = 1;
+ }
+
+ CleanupPNGImage(&png);
+
+ return match;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * FileReadPNG --
+ *
+ * This function is called by the photo image type to read PNG format
+ * data from a file and write it into a given photo image.
+ *
+ * Results:
+ * A standard TCL completion code. If TCL_ERROR is returned then an error
+ * message is left in the interp's result.
+ *
+ * Side effects:
+ * The access position in file f is changed, and new data is added to the
+ * image given by imageHandle.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+FileReadPNG(
+ Tcl_Interp *interp,
+ Tcl_Channel chan,
+ const char *fileName,
+ Tcl_Obj *fmtObj,
+ Tk_PhotoHandle imageHandle,
+ int destX,
+ int destY,
+ int width,
+ int height,
+ int srcX,
+ int srcY)
+{
+ PNGImage png;
+ int result = TCL_ERROR;
+
+ result = InitPNGImage(interp, &png, chan, NULL, TCL_ZLIB_STREAM_INFLATE);
+
+ if (TCL_OK == result) {
+ result = DecodePNG(interp, &png, fmtObj, imageHandle, destX, destY);
+ }
+
+ CleanupPNGImage(&png);
+ return result;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * StringMatchPNG --
+ *
+ * This function is invoked by the photo image type to see if an object
+ * contains image data in PNG format.
+ *
+ * Results:
+ * The return value is 1 if the first characters in the data are like PNG
+ * data, and 0 otherwise.
+ *
+ * Side effects:
+ * The size of the image is placed in widthPre and heightPtr.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+StringMatchPNG(
+ Tcl_Obj *pObjData,
+ Tcl_Obj *fmtObj,
+ int *widthPtr,
+ int *heightPtr,
+ Tcl_Interp *interp)
+{
+ PNGImage png;
+ int match = 0;
+
+ InitPNGImage(NULL, &png, NULL, pObjData, TCL_ZLIB_STREAM_INFLATE);
+
+ png.strDataBuf = Tcl_GetByteArrayFromObj(pObjData, &png.strDataLen);
+
+ if (ReadIHDR(interp, &png) == TCL_OK) {
+ *widthPtr = png.block.width;
+ *heightPtr = png.block.height;
+ match = 1;
+ }
+
+ CleanupPNGImage(&png);
+ return match;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * StringReadPNG --
+ *
+ * This function is called by the photo image type to read PNG format
+ * data from an object and give it to the photo image.
+ *
+ * Results:
+ * A standard TCL completion code. If TCL_ERROR is returned then an error
+ * message is left in the interp's result.
+ *
+ * Side effects:
+ * New data is added to the image given by imageHandle.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+StringReadPNG(
+ Tcl_Interp *interp,
+ Tcl_Obj *pObjData,
+ Tcl_Obj *fmtObj,
+ Tk_PhotoHandle imageHandle,
+ int destX,
+ int destY,
+ int width,
+ int height,
+ int srcX,
+ int srcY)
+{
+ PNGImage png;
+ int result = TCL_ERROR;
+
+ result = InitPNGImage(interp, &png, NULL, pObjData,
+ TCL_ZLIB_STREAM_INFLATE);
+
+ if (TCL_OK == result) {
+ result = DecodePNG(interp, &png, fmtObj, imageHandle, destX, destY);
+ }
+
+ CleanupPNGImage(&png);
+ return result;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * WriteData --
+ *
+ * This function writes a bytes from a buffer out to the PNG image.
+ *
+ * Results:
+ * TCL_OK, or TCL_ERROR if the write fails.
+ *
+ * Side effects:
+ * File or buffer will be modified.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+WriteData(
+ Tcl_Interp *interp,
+ PNGImage *pngPtr,
+ const unsigned char *srcPtr,
+ int srcSz,
+ unsigned long *crcPtr)
+{
+ if (!srcPtr || !srcSz) {
+ return TCL_OK;
+ }
+
+ if (crcPtr) {
+ *crcPtr = Tcl_ZlibCRC32(*crcPtr, srcPtr, srcSz);
+ }
+
+ /*
+ * TODO: is Tcl_AppendObjToObj faster here? i.e., does Tcl join the
+ * objects immediately or store them in a multi-object rep?
+ */
+
+ if (pngPtr->objDataPtr) {
+ int objSz;
+ unsigned char *destPtr;
+
+ Tcl_GetByteArrayFromObj(pngPtr->objDataPtr, &objSz);
+
+ if (objSz > INT_MAX - srcSz) {
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "image too large to store completely in byte array", -1));
+ Tcl_SetErrorCode(interp, "TK", "IMAGE", "PNG", "TOO_LARGE", NULL);
+ return TCL_ERROR;
+ }
+
+ destPtr = Tcl_SetByteArrayLength(pngPtr->objDataPtr, objSz + srcSz);
+
+ if (!destPtr) {
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "memory allocation failed", -1));
+ Tcl_SetErrorCode(interp, "TK", "MALLOC", NULL);
+ return TCL_ERROR;
+ }
+
+ memcpy(destPtr+objSz, srcPtr, srcSz);
+ } else if (Tcl_Write(pngPtr->channel, (const char *) srcPtr, srcSz) < 0) {
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "write to channel failed: %s", Tcl_PosixError(interp)));
+ return TCL_ERROR;
+ }
+
+ return TCL_OK;
+}
+
+static inline int
+WriteByte(
+ Tcl_Interp *interp,
+ PNGImage *pngPtr,
+ unsigned char c,
+ unsigned long *crcPtr)
+{
+ return WriteData(interp, pngPtr, &c, 1, crcPtr);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * WriteInt32 --
+ *
+ * This function writes a 32-bit integer value out to the PNG image as
+ * four bytes in network byte order.
+ *
+ * Results:
+ * TCL_OK, or TCL_ERROR if the write fails.
+ *
+ * Side effects:
+ * File or buffer will be modified.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static inline int
+WriteInt32(
+ Tcl_Interp *interp,
+ PNGImage *pngPtr,
+ unsigned long l,
+ unsigned long *crcPtr)
+{
+ unsigned char pc[4];
+
+ pc[0] = (unsigned char) ((l & 0xff000000) >> 24);
+ pc[1] = (unsigned char) ((l & 0x00ff0000) >> 16);
+ pc[2] = (unsigned char) ((l & 0x0000ff00) >> 8);
+ pc[3] = (unsigned char) ((l & 0x000000ff) >> 0);
+
+ return WriteData(interp, pngPtr, pc, 4, crcPtr);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * WriteChunk --
+ *
+ * Writes a complete chunk to the PNG image, including chunk type,
+ * length, contents, and CRC.
+ *
+ * Results:
+ * TCL_OK, or TCL_ERROR if the write fails.
+ *
+ * Side effects:
+ * None
+ *
+ *----------------------------------------------------------------------
+ */
+
+static inline int
+WriteChunk(
+ Tcl_Interp *interp,
+ PNGImage *pngPtr,
+ unsigned long chunkType,
+ const unsigned char *dataPtr,
+ int dataSize)
+{
+ unsigned long crc = Tcl_ZlibCRC32(0, NULL, 0);
+ int result = TCL_OK;
+
+ /*
+ * Write the length field for the chunk.
+ */
+
+ result = WriteInt32(interp, pngPtr, dataSize, NULL);
+
+ /*
+ * Write the Chunk Type.
+ */
+
+ if (TCL_OK == result) {
+ result = WriteInt32(interp, pngPtr, chunkType, &crc);
+ }
+
+ /*
+ * Write the contents (if any).
+ */
+
+ if (TCL_OK == result) {
+ result = WriteData(interp, pngPtr, dataPtr, dataSize, &crc);
+ }
+
+ /*
+ * Write out the CRC at the end of the chunk.
+ */
+
+ if (TCL_OK == result) {
+ result = WriteInt32(interp, pngPtr, crc, NULL);
+ }
+
+ return result;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * WriteIHDR --
+ *
+ * This function writes the PNG header at the beginning of a PNG file,
+ * which includes information such as dimensions and color type.
+ *
+ * Results:
+ * TCL_OK, or TCL_ERROR if the write fails.
+ *
+ * Side effects:
+ * File or buffer will be modified.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+WriteIHDR(
+ Tcl_Interp *interp,
+ PNGImage *pngPtr,
+ Tk_PhotoImageBlock *blockPtr)
+{
+ unsigned long crc = Tcl_ZlibCRC32(0, NULL, 0);
+ int result = TCL_OK;
+
+ /*
+ * The IHDR (header) chunk has a fixed size of 13 bytes.
+ */
+
+ result = WriteInt32(interp, pngPtr, 13, NULL);
+
+ /*
+ * Write the IHDR Chunk Type.
+ */
+
+ if (TCL_OK == result) {
+ result = WriteInt32(interp, pngPtr, CHUNK_IHDR, &crc);
+ }
+
+ /*
+ * Write the image width, height.
+ */
+
+ if (TCL_OK == result) {
+ result = WriteInt32(interp, pngPtr, (unsigned long) blockPtr->width,
+ &crc);
+ }
+
+ if (TCL_OK == result) {
+ result = WriteInt32(interp, pngPtr, (unsigned long) blockPtr->height,
+ &crc);
+ }
+
+ /*
+ * Write bit depth. Although the PNG format supports 16 bits per channel,
+ * Tk supports only 8 in the internal representation, which blockPtr
+ * points to.
+ */
+
+ if (TCL_OK == result) {
+ result = WriteByte(interp, pngPtr, 8, &crc);
+ }
+
+ /*
+ * Write out the color type, previously determined.
+ */
+
+ if (TCL_OK == result) {
+ result = WriteByte(interp, pngPtr, pngPtr->colorType, &crc);
+ }
+
+ /*
+ * Write compression method (only one method is defined).
+ */
+
+ if (TCL_OK == result) {
+ result = WriteByte(interp, pngPtr, PNG_COMPRESS_DEFLATE, &crc);
+ }
+
+ /*
+ * Write filter method (only one method is defined).
+ */
+
+ if (TCL_OK == result) {
+ result = WriteByte(interp, pngPtr, PNG_FILTMETH_STANDARD, &crc);
+ }
+
+ /*
+ * Write interlace method as not interlaced.
+ *
+ * TODO: support interlace through -format?
+ */
+
+ if (TCL_OK == result) {
+ result = WriteByte(interp, pngPtr, PNG_INTERLACE_NONE, &crc);
+ }
+
+ /*
+ * Write out the CRC at the end of the chunk.
+ */
+
+ if (TCL_OK == result) {
+ result = WriteInt32(interp, pngPtr, crc, NULL);
+ }
+
+ return result;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * WriteIDAT --
+ *
+ * Writes the IDAT (data) chunk to the PNG image, containing the pixel
+ * channel data. Currently, image lines are not filtered and writing
+ * interlaced pixels is not supported.
+ *
+ * Results:
+ * TCL_OK, or TCL_ERROR if the write fails.
+ *
+ * Side effects:
+ * None
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+WriteIDAT(
+ Tcl_Interp *interp,
+ PNGImage *pngPtr,
+ Tk_PhotoImageBlock *blockPtr)
+{
+ int rowNum, flush = TCL_ZLIB_NO_FLUSH, outputSize, result;
+ Tcl_Obj *outputObj;
+ unsigned char *outputBytes;
+
+ /*
+ * Filter and compress each row one at a time.
+ */
+
+ for (rowNum=0 ; rowNum < blockPtr->height ; rowNum++) {
+ int colNum;
+ unsigned char *srcPtr, *destPtr;
+
+ srcPtr = blockPtr->pixelPtr + (rowNum * blockPtr->pitch);
+ destPtr = Tcl_SetByteArrayLength(pngPtr->thisLineObj,
+ pngPtr->lineSize);
+
+ /*
+ * TODO: use Paeth filtering.
+ */
+
+ *destPtr++ = PNG_FILTER_NONE;
+
+ /*
+ * Copy each pixel into the destination buffer after the filter type
+ * before filtering.
+ */
+
+ for (colNum = 0 ; colNum < blockPtr->width ; colNum++) {
+ /*
+ * Copy red or gray channel.
+ */
+
+ *destPtr++ = srcPtr[blockPtr->offset[0]];
+
+ /*
+ * If not grayscale, copy the green and blue channels.
+ */
+
+ if (pngPtr->colorType & PNG_COLOR_USED) {
+ *destPtr++ = srcPtr[blockPtr->offset[1]];
+ *destPtr++ = srcPtr[blockPtr->offset[2]];
+ }
+
+ /*
+ * Copy the alpha channel, if used.
+ */
+
+ if (pngPtr->colorType & PNG_COLOR_ALPHA) {
+ *destPtr++ = srcPtr[blockPtr->offset[3]];
+ }
+
+ /*
+ * Point to the start of the next pixel.
+ */
+
+ srcPtr += blockPtr->pixelSize;
+ }
+
+ /*
+ * Compress the line of pixels into the destination. If this is the
+ * last line, finalize the compressor at the same time. Note that this
+ * can't be just a flush; that leads to a file that some PNG readers
+ * choke on. [Bug 2984787]
+ */
+
+ if (rowNum + 1 == blockPtr->height) {
+ flush = TCL_ZLIB_FINALIZE;
+ }
+ if (Tcl_ZlibStreamPut(pngPtr->stream, pngPtr->thisLineObj,
+ flush) != TCL_OK) {
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "deflate() returned error", -1));
+ Tcl_SetErrorCode(interp, "TK", "IMAGE", "PNG", "DEFLATE", NULL);
+ return TCL_ERROR;
+ }
+
+ /*
+ * Swap line buffers to keep the last around for filtering next.
+ */
+
+ {
+ Tcl_Obj *temp = pngPtr->lastLineObj;
+
+ pngPtr->lastLineObj = pngPtr->thisLineObj;
+ pngPtr->thisLineObj = temp;
+ }
+ }
+
+ /*
+ * Now get the compressed data and write it as one big IDAT chunk.
+ */
+
+ outputObj = Tcl_NewObj();
+ (void) Tcl_ZlibStreamGet(pngPtr->stream, outputObj, -1);
+ outputBytes = Tcl_GetByteArrayFromObj(outputObj, &outputSize);
+ result = WriteChunk(interp, pngPtr, CHUNK_IDAT, outputBytes, outputSize);
+ Tcl_DecrRefCount(outputObj);
+ return result;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * WriteExtraChunks --
+ *
+ * Writes an sBIT and a tEXt chunks to the PNG image, describing a bunch
+ * of not very important metadata that many readers seem to need anyway.
+ *
+ * Results:
+ * TCL_OK, or TCL_ERROR if the write fails.
+ *
+ * Side effects:
+ * None
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+WriteExtraChunks(
+ Tcl_Interp *interp,
+ PNGImage *pngPtr)
+{
+ static const unsigned char sBIT_contents[] = {
+ 8, 8, 8, 8
+ };
+ int sBIT_length = 4;
+ Tcl_DString buf;
+
+ /*
+ * Each byte of each channel is always significant; we always write RGBA
+ * images with 8 bits per channel as that is what the photo image's basic
+ * data model is.
+ */
+
+ switch (pngPtr->colorType) {
+ case PNG_COLOR_GRAY:
+ sBIT_length = 1;
+ break;
+ case PNG_COLOR_GRAYALPHA:
+ sBIT_length = 2;
+ break;
+ case PNG_COLOR_RGB:
+ case PNG_COLOR_PLTE:
+ sBIT_length = 3;
+ break;
+ case PNG_COLOR_RGBA:
+ sBIT_length = 4;
+ break;
+ }
+ if (WriteChunk(interp, pngPtr, CHUNK_sBIT, sBIT_contents, sBIT_length)
+ != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ /*
+ * Say that it is Tk that made the PNG. Note that we *need* the NUL at the
+ * end of "Software" to be transferred; do *not* change the length
+ * parameter to -1 there!
+ */
+
+ Tcl_DStringInit(&buf);
+ Tcl_DStringAppend(&buf, "Software", 9);
+ Tcl_DStringAppend(&buf, "Tk Toolkit v", -1);
+ Tcl_DStringAppend(&buf, TK_PATCH_LEVEL, -1);
+ if (WriteChunk(interp, pngPtr, CHUNK_tEXt,
+ (unsigned char *) Tcl_DStringValue(&buf),
+ Tcl_DStringLength(&buf)) != TCL_OK) {
+ Tcl_DStringFree(&buf);
+ return TCL_ERROR;
+ }
+ Tcl_DStringFree(&buf);
+
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * EncodePNG --
+ *
+ * This function handles the entirety of writing a PNG file (or data)
+ * from the first byte to the last. No effort is made to optimize the
+ * image data for best compression.
+ *
+ * Results:
+ * TCL_OK, or TCL_ERROR if an I/O or memory error occurs.
+ *
+ * Side effects:
+ * None
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+EncodePNG(
+ Tcl_Interp *interp,
+ Tk_PhotoImageBlock *blockPtr,
+ PNGImage *pngPtr)
+{
+ int greenOffset, blueOffset, alphaOffset;
+
+ /*
+ * Determine appropriate color type based on color usage (e.g., only red
+ * and maybe alpha channel = grayscale).
+ *
+ * TODO: Check whether this is doing any good; Tk might just be pushing
+ * full RGBA data all the time through here, even though the actual image
+ * doesn't need it...
+ */
+
+ greenOffset = blockPtr->offset[1] - blockPtr->offset[0];
+ blueOffset = blockPtr->offset[2] - blockPtr->offset[0];
+ alphaOffset = blockPtr->offset[3];
+ if ((alphaOffset >= blockPtr->pixelSize) || (alphaOffset < 0)) {
+ alphaOffset = 0;
+ } else {
+ alphaOffset -= blockPtr->offset[0];
+ }
+
+ if ((greenOffset != 0) || (blueOffset != 0)) {
+ if (alphaOffset) {
+ pngPtr->colorType = PNG_COLOR_RGBA;
+ pngPtr->bytesPerPixel = 4;
+ } else {
+ pngPtr->colorType = PNG_COLOR_RGB;
+ pngPtr->bytesPerPixel = 3;
+ }
+ } else {
+ if (alphaOffset) {
+ pngPtr->colorType = PNG_COLOR_GRAYALPHA;
+ pngPtr->bytesPerPixel = 2;
+ } else {
+ pngPtr->colorType = PNG_COLOR_GRAY;
+ pngPtr->bytesPerPixel = 1;
+ }
+ }
+
+ /*
+ * Allocate buffers for lines for filtering and compressed data.
+ */
+
+ pngPtr->lineSize = 1 + (pngPtr->bytesPerPixel * blockPtr->width);
+ pngPtr->blockLen = pngPtr->lineSize * blockPtr->height;
+
+ if ((blockPtr->width > (INT_MAX - 1) / (pngPtr->bytesPerPixel)) ||
+ (blockPtr->height > INT_MAX / pngPtr->lineSize)) {
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "image is too large to encode pixel data", -1));
+ Tcl_SetErrorCode(interp, "TK", "IMAGE", "PNG", "TOO_LARGE", NULL);
+ return TCL_ERROR;
+ }
+
+ pngPtr->lastLineObj = Tcl_NewObj();
+ Tcl_IncrRefCount(pngPtr->lastLineObj);
+ pngPtr->thisLineObj = Tcl_NewObj();
+ Tcl_IncrRefCount(pngPtr->thisLineObj);
+
+ /*
+ * Write out the PNG Signature that all PNGs begin with.
+ */
+
+ if (WriteData(interp, pngPtr, pngSignature, PNG_SIG_SZ,
+ NULL) == TCL_ERROR) {
+ return TCL_ERROR;
+ }
+
+ /*
+ * Write out the IHDR (header) chunk containing image dimensions, color
+ * type, etc.
+ */
+
+ if (WriteIHDR(interp, pngPtr, blockPtr) == TCL_ERROR) {
+ return TCL_ERROR;
+ }
+
+ /*
+ * Write out the extra chunks containing metadata that is of interest to
+ * other programs more than us.
+ */
+
+ if (WriteExtraChunks(interp, pngPtr) == TCL_ERROR) {
+ return TCL_ERROR;
+ }
+
+ /*
+ * Write out the image pixels in the IDAT (data) chunk.
+ */
+
+ if (WriteIDAT(interp, pngPtr, blockPtr) == TCL_ERROR) {
+ return TCL_ERROR;
+ }
+
+ /*
+ * Write out the IEND chunk that all PNGs end with.
+ */
+
+ return WriteChunk(interp, pngPtr, CHUNK_IEND, NULL, 0);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * FileWritePNG --
+ *
+ * This function is called by the photo image type to write PNG format
+ * data to a file.
+ *
+ * Results:
+ * A standard TCL completion code. If TCL_ERROR is returned then an error
+ * message is left in the interp's result.
+ *
+ * Side effects:
+ * The specified file is overwritten.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+FileWritePNG(
+ Tcl_Interp *interp,
+ const char *filename,
+ Tcl_Obj *fmtObj,
+ Tk_PhotoImageBlock *blockPtr)
+{
+ Tcl_Channel chan;
+ PNGImage png;
+ int result = TCL_ERROR;
+
+ /*
+ * Open a Tcl file channel where the image data will be stored. Tk ought
+ * to take care of this, and just provide a channel, but it doesn't.
+ */
+
+ chan = Tcl_OpenFileChannel(interp, filename, "w", 0644);
+
+ if (!chan) {
+ return TCL_ERROR;
+ }
+
+ /*
+ * Initalize PNGImage instance for encoding.
+ */
+
+ if (InitPNGImage(interp, &png, chan, NULL,
+ TCL_ZLIB_STREAM_DEFLATE) == TCL_ERROR) {
+ goto cleanup;
+ }
+
+ /*
+ * Set the translation mode to binary so that CR and LF are not to the
+ * platform's EOL sequence.
+ */
+
+ if (Tcl_SetChannelOption(interp, chan, "-translation",
+ "binary") != TCL_OK) {
+ goto cleanup;
+ }
+
+ /*
+ * Write the raw PNG data out to the file.
+ */
+
+ result = EncodePNG(interp, blockPtr, &png);
+
+ cleanup:
+ Tcl_Close(interp, chan);
+ CleanupPNGImage(&png);
+ return result;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * StringWritePNG --
+ *
+ * This function is called by the photo image type to write PNG format
+ * data to a Tcl object and return it in the result.
+ *
+ * Results:
+ * A standard TCL completion code. If TCL_ERROR is returned then an error
+ * message is left in the interp's result.
+ *
+ * Side effects:
+ * None
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+StringWritePNG(
+ Tcl_Interp *interp,
+ Tcl_Obj *fmtObj,
+ Tk_PhotoImageBlock *blockPtr)
+{
+ Tcl_Obj *resultObj = Tcl_NewObj();
+ PNGImage png;
+ int result = TCL_ERROR;
+
+ /*
+ * Initalize PNGImage instance for encoding.
+ */
+
+ if (InitPNGImage(interp, &png, NULL, resultObj,
+ TCL_ZLIB_STREAM_DEFLATE) == TCL_ERROR) {
+ goto cleanup;
+ }
+
+ /*
+ * Write the raw PNG data into the prepared Tcl_Obj buffer. Set the result
+ * back to the interpreter if successful.
+ */
+
+ result = EncodePNG(interp, blockPtr, &png);
+
+ if (TCL_OK == result) {
+ Tcl_SetObjResult(interp, png.objDataPtr);
+ }
+
+ cleanup:
+ CleanupPNGImage(&png);
+ return result;
+}
+
+/*
+ * Local Variables:
+ * c-basic-offset: 4
+ * fill-column: 78
+ * End:
+ */
diff --git a/tk8.6/generic/tkImgPPM.c b/tk8.6/generic/tkImgPPM.c
new file mode 100644
index 0000000..6f084f0
--- /dev/null
+++ b/tk8.6/generic/tkImgPPM.c
@@ -0,0 +1,854 @@
+/*
+ * tkImgPPM.c --
+ *
+ * A photo image file handler for PPM (Portable PixMap) files.
+ *
+ * Copyright (c) 1994 The Australian National University.
+ * Copyright (c) 1994-1997 Sun Microsystems, Inc.
+ *
+ * See the file "license.terms" for information on usage and redistribution of
+ * this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ * Author: Paul Mackerras (paulus@cs.anu.edu.au),
+ * Department of Computer Science,
+ * Australian National University.
+ */
+
+#include "tkInt.h"
+
+/*
+ * The maximum amount of memory to allocate for data read from the file. If we
+ * need more than this, we do it in pieces.
+ */
+
+#define MAX_MEMORY 10000 /* don't allocate > 10KB */
+
+/*
+ * Define PGM and PPM, i.e. gray images and color images.
+ */
+
+#define PGM 1
+#define PPM 2
+
+/*
+ * The format record for the PPM file format:
+ */
+
+static int FileMatchPPM(Tcl_Channel chan, const char *fileName,
+ Tcl_Obj *format, int *widthPtr, int *heightPtr,
+ Tcl_Interp *interp);
+static int FileReadPPM(Tcl_Interp *interp, Tcl_Channel chan,
+ const char *fileName, Tcl_Obj *format,
+ Tk_PhotoHandle imageHandle, int destX, int destY,
+ int width, int height, int srcX, int srcY);
+static int FileWritePPM(Tcl_Interp *interp, const char *fileName,
+ Tcl_Obj *format, Tk_PhotoImageBlock *blockPtr);
+static int StringWritePPM(Tcl_Interp *interp, Tcl_Obj *format,
+ Tk_PhotoImageBlock *blockPtr);
+static int StringMatchPPM(Tcl_Obj *dataObj, Tcl_Obj *format,
+ int *widthPtr, int *heightPtr, Tcl_Interp *interp);
+static int StringReadPPM(Tcl_Interp *interp, Tcl_Obj *dataObj,
+ Tcl_Obj *format, Tk_PhotoHandle imageHandle,
+ int destX, int destY, int width, int height,
+ int srcX, int srcY);
+
+Tk_PhotoImageFormat tkImgFmtPPM = {
+ "ppm", /* name */
+ FileMatchPPM, /* fileMatchProc */
+ StringMatchPPM, /* stringMatchProc */
+ FileReadPPM, /* fileReadProc */
+ StringReadPPM, /* stringReadProc */
+ FileWritePPM, /* fileWriteProc */
+ StringWritePPM, /* stringWriteProc */
+ NULL
+};
+
+/*
+ * Prototypes for local functions defined in this file:
+ */
+
+static int ReadPPMFileHeader(Tcl_Channel chan, int *widthPtr,
+ int *heightPtr, int *maxIntensityPtr);
+static int ReadPPMStringHeader(Tcl_Obj *dataObj, int *widthPtr,
+ int *heightPtr, int *maxIntensityPtr,
+ unsigned char **dataBufferPtr, int *dataSizePtr);
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * FileMatchPPM --
+ *
+ * This function is invoked by the photo image type to see if a file
+ * contains image data in PPM format.
+ *
+ * Results:
+ * The return value is >0 if the first characters in file "f" look like
+ * PPM data, and 0 otherwise.
+ *
+ * Side effects:
+ * The access position in f may change.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+FileMatchPPM(
+ Tcl_Channel chan, /* The image file, open for reading. */
+ const char *fileName, /* The name of the image file. */
+ Tcl_Obj *format, /* User-specified format string, or NULL. */
+ int *widthPtr, int *heightPtr,
+ /* The dimensions of the image are returned
+ * here if the file is a valid raw PPM
+ * file. */
+ Tcl_Interp *interp) /* unused */
+{
+ int dummy;
+
+ return ReadPPMFileHeader(chan, widthPtr, heightPtr, &dummy);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * FileReadPPM --
+ *
+ * This function is called by the photo image type to read PPM format
+ * data from a file and write it into a given photo image.
+ *
+ * Results:
+ * A standard TCL completion code. If TCL_ERROR is returned then an error
+ * message is left in the interp's result.
+ *
+ * Side effects:
+ * The access position in file f is changed, and new data is added to the
+ * image given by imageHandle.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+FileReadPPM(
+ Tcl_Interp *interp, /* Interpreter to use for reporting errors. */
+ Tcl_Channel chan, /* The image file, open for reading. */
+ const char *fileName, /* The name of the image file. */
+ Tcl_Obj *format, /* User-specified format string, or NULL. */
+ Tk_PhotoHandle imageHandle, /* The photo image to write into. */
+ int destX, int destY, /* Coordinates of top-left pixel in photo
+ * image to be written to. */
+ int width, int height, /* Dimensions of block of photo image to be
+ * written to. */
+ int srcX, int srcY) /* Coordinates of top-left pixel to be used in
+ * image being read. */
+{
+ int fileWidth, fileHeight, maxIntensity;
+ int nLines, nBytes, h, type, count, bytesPerChannel = 1;
+ unsigned char *pixelPtr;
+ Tk_PhotoImageBlock block;
+
+ type = ReadPPMFileHeader(chan, &fileWidth, &fileHeight, &maxIntensity);
+ if (type == 0) {
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "couldn't read raw PPM header from file \"%s\"", fileName));
+ Tcl_SetErrorCode(interp, "TK", "IMAGE", "PPM", "NO_HEADER", NULL);
+ return TCL_ERROR;
+ }
+ if ((fileWidth <= 0) || (fileHeight <= 0)) {
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "PPM image file \"%s\" has dimension(s) <= 0", fileName));
+ Tcl_SetErrorCode(interp, "TK", "IMAGE", "PPM", "DIMENSIONS", NULL);
+ return TCL_ERROR;
+ }
+ if ((maxIntensity <= 0) || (maxIntensity > 0xffff)) {
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "PPM image file \"%s\" has bad maximum intensity value %d",
+ fileName, maxIntensity));
+ Tcl_SetErrorCode(interp, "TK", "IMAGE", "PPM", "INTENSITY", NULL);
+ return TCL_ERROR;
+ } else if (maxIntensity > 0x00ff) {
+ bytesPerChannel = 2;
+ }
+
+ if ((srcX + width) > fileWidth) {
+ width = fileWidth - srcX;
+ }
+ if ((srcY + height) > fileHeight) {
+ height = fileHeight - srcY;
+ }
+ if ((width <= 0) || (height <= 0)
+ || (srcX >= fileWidth) || (srcY >= fileHeight)) {
+ return TCL_OK;
+ }
+
+ if (type == PGM) {
+ block.pixelSize = 1 * bytesPerChannel;
+ block.offset[0] = 0;
+ block.offset[1] = 0;
+ block.offset[2] = 0;
+ } else {
+ block.pixelSize = 3 * bytesPerChannel;
+ block.offset[0] = 0;
+ block.offset[1] = 1 * bytesPerChannel;
+ block.offset[2] = 2 * bytesPerChannel;
+ }
+ block.offset[3] = 0;
+ block.width = width;
+ block.pitch = block.pixelSize * fileWidth;
+
+ if (Tk_PhotoExpand(interp, imageHandle,
+ destX + width, destY + height) != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ if (srcY > 0) {
+ Tcl_Seek(chan, (Tcl_WideInt)(srcY * block.pitch), SEEK_CUR);
+ }
+
+ nLines = (MAX_MEMORY + block.pitch - 1) / block.pitch;
+ if (nLines > height) {
+ nLines = height;
+ }
+ if (nLines <= 0) {
+ nLines = 1;
+ }
+ nBytes = nLines * block.pitch;
+ pixelPtr = ckalloc(nBytes);
+ block.pixelPtr = pixelPtr + srcX * block.pixelSize;
+
+ for (h = height; h > 0; h -= nLines) {
+ if (nLines > h) {
+ nLines = h;
+ nBytes = nLines * block.pitch;
+ }
+ count = Tcl_Read(chan, (char *) pixelPtr, nBytes);
+ if (count != nBytes) {
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "error reading PPM image file \"%s\": %s", fileName,
+ Tcl_Eof(chan)?"not enough data":Tcl_PosixError(interp)));
+ if (Tcl_Eof(chan)) {
+ Tcl_SetErrorCode(interp, "TK", "IMAGE", "PPM", "EOF", NULL);
+ }
+ ckfree(pixelPtr);
+ return TCL_ERROR;
+ }
+ if (maxIntensity < 0x00ff) {
+ unsigned char *p;
+
+ for (p = pixelPtr; count > 0; count--, p++) {
+ *p = (((int) *p) * 255)/maxIntensity;
+ }
+ } else if (maxIntensity > 0x00ff) {
+ unsigned char *p;
+ unsigned int value;
+
+ for (p = pixelPtr; count > 0; count--, p += 2) {
+ value = ((unsigned int) p[0]) * 256 + ((unsigned int) p[1]);
+ value = value * 255 / maxIntensity;
+ p[0] = p[1] = (unsigned char) value;
+ }
+ }
+ block.height = nLines;
+ if (Tk_PhotoPutBlock(interp, imageHandle, &block, destX, destY,
+ width, nLines, TK_PHOTO_COMPOSITE_SET) != TCL_OK) {
+ ckfree(pixelPtr);
+ return TCL_ERROR;
+ }
+ destY += nLines;
+ }
+
+ ckfree(pixelPtr);
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * FileWritePPM --
+ *
+ * This function is invoked to write image data to a file in PPM format
+ * (although we can read PGM files, we never write them).
+ *
+ * Results:
+ * A standard TCL completion code. If TCL_ERROR is returned then an error
+ * message is left in the interp's result.
+ *
+ * Side effects:
+ * Data is written to the file given by "fileName".
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+FileWritePPM(
+ Tcl_Interp *interp,
+ const char *fileName,
+ Tcl_Obj *format,
+ Tk_PhotoImageBlock *blockPtr)
+{
+ Tcl_Channel chan;
+ int w, h, greenOffset, blueOffset, nBytes;
+ unsigned char *pixelPtr, *pixLinePtr;
+ char header[16 + TCL_INTEGER_SPACE * 2];
+
+ chan = Tcl_OpenFileChannel(interp, fileName, "w", 0666);
+ if (chan == NULL) {
+ return TCL_ERROR;
+ }
+
+ if (Tcl_SetChannelOption(interp, chan, "-translation", "binary")
+ != TCL_OK) {
+ Tcl_Close(NULL, chan);
+ return TCL_ERROR;
+ }
+ if (Tcl_SetChannelOption(interp, chan, "-encoding", "binary")
+ != TCL_OK) {
+ Tcl_Close(NULL, chan);
+ return TCL_ERROR;
+ }
+
+ sprintf(header, "P6\n%d %d\n255\n", blockPtr->width, blockPtr->height);
+ Tcl_Write(chan, header, -1);
+
+ pixLinePtr = blockPtr->pixelPtr + blockPtr->offset[0];
+ greenOffset = blockPtr->offset[1] - blockPtr->offset[0];
+ blueOffset = blockPtr->offset[2] - blockPtr->offset[0];
+
+ if ((greenOffset == 1) && (blueOffset == 2) && (blockPtr->pixelSize == 3)
+ && (blockPtr->pitch == (blockPtr->width * 3))) {
+ nBytes = blockPtr->height * blockPtr->pitch;
+ if (Tcl_Write(chan, (char *) pixLinePtr, nBytes) != nBytes) {
+ goto writeerror;
+ }
+ } else {
+ for (h = blockPtr->height; h > 0; h--) {
+ pixelPtr = pixLinePtr;
+ for (w = blockPtr->width; w > 0; w--) {
+ if ( Tcl_Write(chan,(char *)&pixelPtr[0], 1) == -1 ||
+ Tcl_Write(chan,(char *)&pixelPtr[greenOffset],1)==-1 ||
+ Tcl_Write(chan,(char *)&pixelPtr[blueOffset],1) ==-1) {
+ goto writeerror;
+ }
+ pixelPtr += blockPtr->pixelSize;
+ }
+ pixLinePtr += blockPtr->pitch;
+ }
+ }
+
+ if (Tcl_Close(NULL, chan) == 0) {
+ return TCL_OK;
+ }
+ chan = NULL;
+
+ writeerror:
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf("error writing \"%s\": %s",
+ fileName, Tcl_PosixError(interp)));
+ if (chan != NULL) {
+ Tcl_Close(NULL, chan);
+ }
+ return TCL_ERROR;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * StringWritePPM --
+ *
+ * This function is invoked to write image data to a string in PPM
+ * format.
+ *
+ * Results:
+ * A standard TCL completion code. If TCL_ERROR is returned then an error
+ * message is left in the interp's result.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+StringWritePPM(
+ Tcl_Interp *interp,
+ Tcl_Obj *format,
+ Tk_PhotoImageBlock *blockPtr)
+{
+ int w, h, size, greenOffset, blueOffset;
+ unsigned char *pixLinePtr, *byteArray;
+ char header[16 + TCL_INTEGER_SPACE * 2];
+ Tcl_Obj *byteArrayObj;
+
+ sprintf(header, "P6\n%d %d\n255\n", blockPtr->width, blockPtr->height);
+
+ /*
+ * Construct a byte array of the right size with the header and
+ * get a pointer to the data part of it.
+ */
+
+ size = strlen(header);
+ byteArrayObj = Tcl_NewByteArrayObj((unsigned char *)header, size);
+ byteArray = Tcl_SetByteArrayLength(byteArrayObj,
+ size + 3*blockPtr->width*blockPtr->height);
+ byteArray += size;
+
+ pixLinePtr = blockPtr->pixelPtr + blockPtr->offset[0];
+ greenOffset = blockPtr->offset[1] - blockPtr->offset[0];
+ blueOffset = blockPtr->offset[2] - blockPtr->offset[0];
+
+ /*
+ * Check if we can do the data move in single action.
+ */
+
+ if ((greenOffset == 1) && (blueOffset == 2) && (blockPtr->pixelSize == 3)
+ && (blockPtr->pitch == (blockPtr->width * 3))) {
+ memcpy(byteArray, pixLinePtr,
+ (unsigned)blockPtr->height * blockPtr->pitch);
+ } else {
+ for (h = blockPtr->height; h > 0; h--) {
+ unsigned char *pixelPtr = pixLinePtr;
+
+ for (w = blockPtr->width; w > 0; w--) {
+ *byteArray++ = pixelPtr[0];
+ *byteArray++ = pixelPtr[greenOffset];
+ *byteArray++ = pixelPtr[blueOffset];
+ pixelPtr += blockPtr->pixelSize;
+ }
+ pixLinePtr += blockPtr->pitch;
+ }
+ }
+
+ /*
+ * Return the object in the interpreter result.
+ */
+
+ Tcl_SetObjResult(interp, byteArrayObj);
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * StringMatchPPM --
+ *
+ * This function is invoked by the photo image type to see if a string
+ * contains image data in PPM format.
+ *
+ * Results:
+ * The return value is >0 if the first characters in file "f" look like
+ * PPM data, and 0 otherwise.
+ *
+ * Side effects:
+ * The access position in f may change.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+StringMatchPPM(
+ Tcl_Obj *dataObj, /* The image data. */
+ Tcl_Obj *format, /* User-specified format string, or NULL. */
+ int *widthPtr, int *heightPtr,
+ /* The dimensions of the image are returned
+ * here if the file is a valid raw PPM
+ * file. */
+ Tcl_Interp *interp) /* unused */
+{
+ int dummy;
+
+ return ReadPPMStringHeader(dataObj, widthPtr, heightPtr,
+ &dummy, NULL, NULL);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * StringReadPPM --
+ *
+ * This function is called by the photo image type to read PPM format
+ * data from a string and write it into a given photo image.
+ *
+ * Results:
+ * A standard TCL completion code. If TCL_ERROR is returned then an error
+ * message is left in the interp's result.
+ *
+ * Side effects:
+ * New data is added to the image given by imageHandle.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+StringReadPPM(
+ Tcl_Interp *interp, /* Interpreter to use for reporting errors. */
+ Tcl_Obj *dataObj, /* The image data. */
+ Tcl_Obj *format, /* User-specified format string, or NULL. */
+ Tk_PhotoHandle imageHandle, /* The photo image to write into. */
+ int destX, int destY, /* Coordinates of top-left pixel in photo
+ * image to be written to. */
+ int width, int height, /* Dimensions of block of photo image to be
+ * written to. */
+ int srcX, int srcY) /* Coordinates of top-left pixel to be used in
+ * image being read. */
+{
+ int fileWidth, fileHeight, maxIntensity;
+ int nLines, nBytes, h, type, count, dataSize, bytesPerChannel = 1;
+ unsigned char *pixelPtr, *dataBuffer;
+ Tk_PhotoImageBlock block;
+
+ type = ReadPPMStringHeader(dataObj, &fileWidth, &fileHeight,
+ &maxIntensity, &dataBuffer, &dataSize);
+ if (type == 0) {
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "couldn't read raw PPM header from string", -1));
+ Tcl_SetErrorCode(interp, "TK", "IMAGE", "PPM", "NO_HEADER", NULL);
+ return TCL_ERROR;
+ }
+ if ((fileWidth <= 0) || (fileHeight <= 0)) {
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "PPM image data has dimension(s) <= 0", -1));
+ Tcl_SetErrorCode(interp, "TK", "IMAGE", "PPM", "DIMENSIONS", NULL);
+ return TCL_ERROR;
+ }
+ if ((maxIntensity <= 0) || (maxIntensity > 0xffff)) {
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "PPM image data has bad maximum intensity value %d",
+ maxIntensity));
+ Tcl_SetErrorCode(interp, "TK", "IMAGE", "PPM", "INTENSITY", NULL);
+ return TCL_ERROR;
+ } else if (maxIntensity > 0x00ff) {
+ bytesPerChannel = 2;
+ }
+
+ if ((srcX + width) > fileWidth) {
+ width = fileWidth - srcX;
+ }
+ if ((srcY + height) > fileHeight) {
+ height = fileHeight - srcY;
+ }
+ if ((width <= 0) || (height <= 0)
+ || (srcX >= fileWidth) || (srcY >= fileHeight)) {
+ return TCL_OK;
+ }
+
+ if (type == PGM) {
+ block.pixelSize = 1 * bytesPerChannel;
+ block.offset[0] = 0;
+ block.offset[1] = 0;
+ block.offset[2] = 0;
+ } else {
+ block.pixelSize = 3 * bytesPerChannel;
+ block.offset[0] = 0;
+ block.offset[1] = 1 * bytesPerChannel;
+ block.offset[2] = 2 * bytesPerChannel;
+ }
+ block.offset[3] = 0;
+ block.width = width;
+ block.pitch = block.pixelSize * fileWidth;
+
+ if (srcY > 0) {
+ dataBuffer += srcY * block.pitch;
+ dataSize -= srcY * block.pitch;
+ }
+
+ if (maxIntensity == 0x00ff) {
+ /*
+ * We have all the data in memory, so write everything in one go.
+ */
+
+ if (block.pitch*height > dataSize) {
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "truncated PPM data", -1));
+ Tcl_SetErrorCode(interp, "TK", "IMAGE", "PPM", "TRUNCATED", NULL);
+ return TCL_ERROR;
+ }
+ block.pixelPtr = dataBuffer + srcX * block.pixelSize;
+ block.height = height;
+ return Tk_PhotoPutBlock(interp, imageHandle, &block, destX, destY,
+ width, height, TK_PHOTO_COMPOSITE_SET);
+ }
+
+ if (Tk_PhotoExpand(interp, imageHandle,
+ destX + width, destY + height) != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ nLines = (MAX_MEMORY + block.pitch - 1) / block.pitch;
+ if (nLines > height) {
+ nLines = height;
+ }
+ if (nLines <= 0) {
+ nLines = 1;
+ }
+ nBytes = nLines * block.pitch;
+ pixelPtr = ckalloc(nBytes);
+ block.pixelPtr = pixelPtr + srcX * block.pixelSize;
+
+ for (h = height; h > 0; h -= nLines) {
+ unsigned char *p;
+
+ if (nLines > h) {
+ nLines = h;
+ nBytes = nLines * block.pitch;
+ }
+ if (dataSize < nBytes) {
+ ckfree(pixelPtr);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "truncated PPM data", -1));
+ Tcl_SetErrorCode(interp, "TK", "IMAGE", "PPM", "TRUNCATED", NULL);
+ return TCL_ERROR;
+ }
+ if (maxIntensity < 0x00ff) {
+ for (p=pixelPtr,count=nBytes ; count>0 ; count--,p++,dataBuffer++) {
+ *p = (((int) *dataBuffer) * 255)/maxIntensity;
+ }
+ } else {
+ unsigned char *p;
+ unsigned int value;
+
+ for (p = pixelPtr,count=nBytes; count > 1; count-=2, p += 2) {
+ value = ((unsigned int) p[0]) * 256 + ((unsigned int) p[1]);
+ value = value * 255 / maxIntensity;
+ p[0] = p[1] = (unsigned char) value;
+ }
+ }
+ dataSize -= nBytes;
+ block.height = nLines;
+ if (Tk_PhotoPutBlock(interp, imageHandle, &block, destX, destY,
+ width, nLines, TK_PHOTO_COMPOSITE_SET) != TCL_OK) {
+ ckfree(pixelPtr);
+ return TCL_ERROR;
+ }
+ destY += nLines;
+ }
+
+ ckfree(pixelPtr);
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ReadPPMFileHeader --
+ *
+ * This function reads the PPM header from the beginning of a PPM file
+ * and returns information from the header.
+ *
+ * Results:
+ * The return value is PGM if file "f" appears to start with a valid PGM
+ * header, PPM if "f" appears to start with a valid PPM header, and 0
+ * otherwise. If the header is valid, then *widthPtr and *heightPtr are
+ * modified to hold the dimensions of the image and *maxIntensityPtr is
+ * modified to hold the value of a "fully on" intensity value.
+ *
+ * Side effects:
+ * The access position in f advances.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+ReadPPMFileHeader(
+ Tcl_Channel chan, /* Image file to read the header from. */
+ int *widthPtr, int *heightPtr,
+ /* The dimensions of the image are returned
+ * here. */
+ int *maxIntensityPtr) /* The maximum intensity value for the image
+ * is stored here. */
+{
+#define BUFFER_SIZE 1000
+ char buffer[BUFFER_SIZE], c;
+ int i, numFields, type = 0;
+
+ /*
+ * Read 4 space-separated fields from the file, ignoring comments (any
+ * line that starts with "#").
+ */
+
+ if (Tcl_Read(chan, &c, 1) != 1) {
+ return 0;
+ }
+ i = 0;
+ for (numFields = 0; numFields < 4; numFields++) {
+ /*
+ * Skip comments and white space.
+ */
+
+ while (1) {
+ while (isspace(UCHAR(c))) {
+ if (Tcl_Read(chan, &c, 1) != 1) {
+ return 0;
+ }
+ }
+ if (c != '#') {
+ break;
+ }
+ do {
+ if (Tcl_Read(chan, &c, 1) != 1) {
+ return 0;
+ }
+ } while (c != '\n');
+ }
+
+ /*
+ * Read a field (everything up to the next white space).
+ */
+
+ while (!isspace(UCHAR(c))) {
+ if (i < (BUFFER_SIZE-2)) {
+ buffer[i] = c;
+ i++;
+ }
+ if (Tcl_Read(chan, &c, 1) != 1) {
+ goto done;
+ }
+ }
+ if (i < (BUFFER_SIZE-1)) {
+ buffer[i] = ' ';
+ i++;
+ }
+ }
+
+ done:
+ buffer[i] = 0;
+
+ /*
+ * Parse the fields, which are: id, width, height, maxIntensity.
+ */
+
+ if (strncmp(buffer, "P6 ", 3) == 0) {
+ type = PPM;
+ } else if (strncmp(buffer, "P5 ", 3) == 0) {
+ type = PGM;
+ } else {
+ return 0;
+ }
+ if (sscanf(buffer+3, "%d %d %d", widthPtr, heightPtr, maxIntensityPtr)
+ != 3) {
+ return 0;
+ }
+ return type;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ReadPPMStringHeader --
+ *
+ * This function reads the PPM header from the beginning of a PPM-format
+ * string and returns information from the header.
+ *
+ * Results:
+ * The return value is PGM if the string appears to start with a valid
+ * PGM header, PPM if the string appears to start with a valid PPM
+ * header, and 0 otherwise. If the header is valid, then *widthPtr and
+ * *heightPtr are modified to hold the dimensions of the image and
+ * *maxIntensityPtr is modified to hold the value of a "fully on"
+ * intensity value.
+ *
+ * Side effects:
+ * None
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+ReadPPMStringHeader(
+ Tcl_Obj *dataPtr, /* Object to read the header from. */
+ int *widthPtr, int *heightPtr,
+ /* The dimensions of the image are returned
+ * here. */
+ int *maxIntensityPtr, /* The maximum intensity value for the image
+ * is stored here. */
+ unsigned char **dataBufferPtr,
+ int *dataSizePtr)
+{
+#define BUFFER_SIZE 1000
+ char buffer[BUFFER_SIZE], c;
+ int i, numFields, dataSize, type = 0;
+ unsigned char *dataBuffer;
+
+ dataBuffer = Tcl_GetByteArrayFromObj(dataPtr, &dataSize);
+
+ /*
+ * Read 4 space-separated fields from the string, ignoring comments (any
+ * line that starts with "#").
+ */
+
+ if (dataSize-- < 1) {
+ return 0;
+ }
+ c = (char) (*dataBuffer++);
+ i = 0;
+ for (numFields = 0; numFields < 4; numFields++) {
+ /*
+ * Skip comments and white space.
+ */
+
+ while (1) {
+ while (isspace(UCHAR(c))) {
+ if (dataSize-- < 1) {
+ return 0;
+ }
+ c = (char) (*dataBuffer++);
+ }
+ if (c != '#') {
+ break;
+ }
+ do {
+ if (dataSize-- < 1) {
+ return 0;
+ }
+ c = (char) (*dataBuffer++);
+ } while (c != '\n');
+ }
+
+ /*
+ * Read a field (everything up to the next white space).
+ */
+
+ while (!isspace(UCHAR(c))) {
+ if (i < (BUFFER_SIZE-2)) {
+ buffer[i] = c;
+ i++;
+ }
+ if (dataSize-- < 1) {
+ goto done;
+ }
+ c = (char) (*dataBuffer++);
+ }
+ if (i < (BUFFER_SIZE-1)) {
+ buffer[i] = ' ';
+ i++;
+ }
+ }
+
+ done:
+ buffer[i] = 0;
+
+ /*
+ * Parse the fields, which are: id, width, height, maxIntensity.
+ */
+
+ if (strncmp(buffer, "P6 ", 3) == 0) {
+ type = PPM;
+ } else if (strncmp(buffer, "P5 ", 3) == 0) {
+ type = PGM;
+ } else {
+ return 0;
+ }
+ if (sscanf(buffer+3, "%d %d %d", widthPtr, heightPtr, maxIntensityPtr)
+ != 3) {
+ return 0;
+ }
+ if (dataBufferPtr != NULL) {
+ *dataBufferPtr = dataBuffer;
+ *dataSizePtr = dataSize;
+ }
+ return type;
+}
+
+/*
+ * Local Variables:
+ * mode: c
+ * c-basic-offset: 4
+ * fill-column: 78
+ * End:
+ */
diff --git a/tk8.6/generic/tkImgPhInstance.c b/tk8.6/generic/tkImgPhInstance.c
new file mode 100644
index 0000000..bd152f2
--- /dev/null
+++ b/tk8.6/generic/tkImgPhInstance.c
@@ -0,0 +1,1987 @@
+/*
+ * tkImgPhInstance.c --
+ *
+ * Implements the rendering of images of type "photo" for Tk. Photo
+ * images are stored in full color (32 bits per pixel including alpha
+ * channel) and displayed using dithering if necessary.
+ *
+ * Copyright (c) 1994 The Australian National University.
+ * Copyright (c) 1994-1997 Sun Microsystems, Inc.
+ * Copyright (c) 2002-2008 Donal K. Fellows
+ * Copyright (c) 2003 ActiveState Corporation.
+ *
+ * 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.
+ */
+
+#include "tkImgPhoto.h"
+
+/*
+ * Declaration for internal Xlib function used here:
+ */
+
+extern int _XInitImageFuncPtrs(XImage *image);
+
+/*
+ * Forward declarations
+ */
+
+static void BlendComplexAlpha(XImage *bgImg, PhotoInstance *iPtr,
+ int xOffset, int yOffset, int width, int height);
+static int IsValidPalette(PhotoInstance *instancePtr,
+ const char *palette);
+static int CountBits(pixel mask);
+static void GetColorTable(PhotoInstance *instancePtr);
+static void FreeColorTable(ColorTable *colorPtr, int force);
+static void AllocateColors(ColorTable *colorPtr);
+static void DisposeColorTable(ClientData clientData);
+static int ReclaimColors(ColorTableId *id, int numColors);
+
+/*
+ * Hash table used to hash from (display, colormap, palette, gamma) to
+ * ColorTable address.
+ */
+
+static Tcl_HashTable imgPhotoColorHash;
+static int imgPhotoColorHashInitialized;
+#define N_COLOR_HASH (sizeof(ColorTableId) / sizeof(int))
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkImgPhotoConfigureInstance --
+ *
+ * This function is called to create displaying information for a photo
+ * image instance based on the configuration information in the master.
+ * It is invoked both when new instances are created and when the master
+ * is reconfigured.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Generates errors via Tcl_BackgroundException if there are problems in
+ * setting up the instance.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TkImgPhotoConfigureInstance(
+ PhotoInstance *instancePtr) /* Instance to reconfigure. */
+{
+ PhotoMaster *masterPtr = instancePtr->masterPtr;
+ XImage *imagePtr;
+ int bitsPerPixel;
+ ColorTable *colorTablePtr;
+ XRectangle validBox;
+
+ /*
+ * If the -palette configuration option has been set for the master, use
+ * the value specified for our palette, but only if it is a valid palette
+ * for our windows. Use the gamma value specified the master.
+ */
+
+ if ((masterPtr->palette && masterPtr->palette[0])
+ && IsValidPalette(instancePtr, masterPtr->palette)) {
+ instancePtr->palette = masterPtr->palette;
+ } else {
+ instancePtr->palette = instancePtr->defaultPalette;
+ }
+ instancePtr->gamma = masterPtr->gamma;
+
+ /*
+ * If we don't currently have a color table, or if the one we have no
+ * longer applies (e.g. because our palette or gamma has changed), get a
+ * new one.
+ */
+
+ colorTablePtr = instancePtr->colorTablePtr;
+ if ((colorTablePtr == NULL)
+ || (instancePtr->colormap != colorTablePtr->id.colormap)
+ || (instancePtr->palette != colorTablePtr->id.palette)
+ || (instancePtr->gamma != colorTablePtr->id.gamma)) {
+ /*
+ * Free up our old color table, and get a new one.
+ */
+
+ if (colorTablePtr != NULL) {
+ colorTablePtr->liveRefCount -= 1;
+ FreeColorTable(colorTablePtr, 0);
+ }
+ GetColorTable(instancePtr);
+
+ /*
+ * Create a new XImage structure for sending data to the X server, if
+ * necessary.
+ */
+
+ if (instancePtr->colorTablePtr->flags & BLACK_AND_WHITE) {
+ bitsPerPixel = 1;
+ } else {
+ bitsPerPixel = instancePtr->visualInfo.depth;
+ }
+
+ if ((instancePtr->imagePtr == NULL)
+ || (instancePtr->imagePtr->bits_per_pixel != bitsPerPixel)) {
+ if (instancePtr->imagePtr != NULL) {
+ XDestroyImage(instancePtr->imagePtr);
+ }
+ imagePtr = XCreateImage(instancePtr->display,
+ instancePtr->visualInfo.visual, (unsigned) bitsPerPixel,
+ (bitsPerPixel > 1? ZPixmap: XYBitmap), 0, NULL,
+ 1, 1, 32, 0);
+ instancePtr->imagePtr = imagePtr;
+
+ /*
+ * We create images using the local host's endianness, rather than
+ * the endianness of the server; otherwise we would have to
+ * byte-swap any 16 or 32 bit values that we store in the image
+ * if the server's endianness is different from ours.
+ */
+
+ if (imagePtr != NULL) {
+#ifdef WORDS_BIGENDIAN
+ imagePtr->byte_order = MSBFirst;
+#else
+ imagePtr->byte_order = LSBFirst;
+#endif
+ _XInitImageFuncPtrs(imagePtr);
+ }
+ }
+ }
+
+ /*
+ * If the user has specified a width and/or height for the master which is
+ * different from our current width/height, set the size to the values
+ * specified by the user. If we have no pixmap, we do this also, since it
+ * has the side effect of allocating a pixmap for us.
+ */
+
+ if ((instancePtr->pixels == None) || (instancePtr->error == NULL)
+ || (instancePtr->width != masterPtr->width)
+ || (instancePtr->height != masterPtr->height)) {
+ TkImgPhotoInstanceSetSize(instancePtr);
+ }
+
+ /*
+ * Redither this instance if necessary.
+ */
+
+ if ((masterPtr->flags & IMAGE_CHANGED)
+ || (instancePtr->colorTablePtr != colorTablePtr)) {
+ TkClipBox(masterPtr->validRegion, &validBox);
+ if ((validBox.width > 0) && (validBox.height > 0)) {
+ TkImgDitherInstance(instancePtr, validBox.x, validBox.y,
+ validBox.width, validBox.height);
+ }
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkImgPhotoGet --
+ *
+ * This function is called for each use of a photo image in a widget.
+ *
+ * Results:
+ * The return value is a token for the instance, which is passed back to
+ * us in calls to TkImgPhotoDisplay and ImgPhotoFree.
+ *
+ * Side effects:
+ * A data structure is set up for the instance (or, an existing instance
+ * is re-used for the new one).
+ *
+ *----------------------------------------------------------------------
+ */
+
+ClientData
+TkImgPhotoGet(
+ Tk_Window tkwin, /* Window in which the instance will be
+ * used. */
+ ClientData masterData) /* Pointer to our master structure for the
+ * image. */
+{
+ PhotoMaster *masterPtr = masterData;
+ PhotoInstance *instancePtr;
+ Colormap colormap;
+ int mono, nRed, nGreen, nBlue, numVisuals;
+ XVisualInfo visualInfo, *visInfoPtr;
+ char buf[TCL_INTEGER_SPACE * 3];
+ XColor *white, *black;
+ XGCValues gcValues;
+
+ /*
+ * Table of "best" choices for palette for PseudoColor displays with
+ * between 3 and 15 bits/pixel.
+ */
+
+ static const int paletteChoice[13][3] = {
+ /* #red, #green, #blue */
+ {2, 2, 2, /* 3 bits, 8 colors */},
+ {2, 3, 2, /* 4 bits, 12 colors */},
+ {3, 4, 2, /* 5 bits, 24 colors */},
+ {4, 5, 3, /* 6 bits, 60 colors */},
+ {5, 6, 4, /* 7 bits, 120 colors */},
+ {7, 7, 4, /* 8 bits, 198 colors */},
+ {8, 10, 6, /* 9 bits, 480 colors */},
+ {10, 12, 8, /* 10 bits, 960 colors */},
+ {14, 15, 9, /* 11 bits, 1890 colors */},
+ {16, 20, 12, /* 12 bits, 3840 colors */},
+ {20, 24, 16, /* 13 bits, 7680 colors */},
+ {26, 30, 20, /* 14 bits, 15600 colors */},
+ {32, 32, 30, /* 15 bits, 30720 colors */}
+ };
+
+ /*
+ * See if there is already an instance for windows using the same
+ * colormap. If so then just re-use it.
+ */
+
+ colormap = Tk_Colormap(tkwin);
+ for (instancePtr = masterPtr->instancePtr; instancePtr != NULL;
+ instancePtr = instancePtr->nextPtr) {
+ if ((colormap == instancePtr->colormap)
+ && (Tk_Display(tkwin) == instancePtr->display)) {
+ /*
+ * Re-use this instance.
+ */
+
+ if (instancePtr->refCount == 0) {
+ /*
+ * We are resurrecting this instance.
+ */
+
+ Tcl_CancelIdleCall(TkImgDisposeInstance, instancePtr);
+ if (instancePtr->colorTablePtr != NULL) {
+ FreeColorTable(instancePtr->colorTablePtr, 0);
+ }
+ GetColorTable(instancePtr);
+ }
+ instancePtr->refCount++;
+ return instancePtr;
+ }
+ }
+
+ /*
+ * The image isn't already in use in a window with the same colormap. Make
+ * a new instance of the image.
+ */
+
+ instancePtr = ckalloc(sizeof(PhotoInstance));
+ instancePtr->masterPtr = masterPtr;
+ instancePtr->display = Tk_Display(tkwin);
+ instancePtr->colormap = Tk_Colormap(tkwin);
+ Tk_PreserveColormap(instancePtr->display, instancePtr->colormap);
+ instancePtr->refCount = 1;
+ instancePtr->colorTablePtr = NULL;
+ instancePtr->pixels = None;
+ instancePtr->error = NULL;
+ instancePtr->width = 0;
+ instancePtr->height = 0;
+ instancePtr->imagePtr = 0;
+ instancePtr->nextPtr = masterPtr->instancePtr;
+ masterPtr->instancePtr = instancePtr;
+
+ /*
+ * Obtain information about the visual and decide on the default palette.
+ */
+
+ visualInfo.screen = Tk_ScreenNumber(tkwin);
+ visualInfo.visualid = XVisualIDFromVisual(Tk_Visual(tkwin));
+ visInfoPtr = XGetVisualInfo(Tk_Display(tkwin),
+ VisualScreenMask | VisualIDMask, &visualInfo, &numVisuals);
+ if (visInfoPtr == NULL) {
+ Tcl_Panic("TkImgPhotoGet couldn't find visual for window");
+ }
+
+ nRed = 2;
+ nGreen = nBlue = 0;
+ mono = 1;
+ instancePtr->visualInfo = *visInfoPtr;
+ switch (visInfoPtr->class) {
+ case DirectColor:
+ case TrueColor:
+ nRed = 1 << CountBits(visInfoPtr->red_mask);
+ nGreen = 1 << CountBits(visInfoPtr->green_mask);
+ nBlue = 1 << CountBits(visInfoPtr->blue_mask);
+ mono = 0;
+ break;
+ case PseudoColor:
+ case StaticColor:
+ if (visInfoPtr->depth > 15) {
+ nRed = 32;
+ nGreen = 32;
+ nBlue = 32;
+ mono = 0;
+ } else if (visInfoPtr->depth >= 3) {
+ const int *ip = paletteChoice[visInfoPtr->depth - 3];
+
+ nRed = ip[0];
+ nGreen = ip[1];
+ nBlue = ip[2];
+ mono = 0;
+ }
+ break;
+ case GrayScale:
+ case StaticGray:
+ nRed = 1 << visInfoPtr->depth;
+ break;
+ }
+ XFree((char *) visInfoPtr);
+
+ if (mono) {
+ sprintf(buf, "%d", nRed);
+ } else {
+ sprintf(buf, "%d/%d/%d", nRed, nGreen, nBlue);
+ }
+ instancePtr->defaultPalette = Tk_GetUid(buf);
+
+ /*
+ * Make a GC with background = black and foreground = white.
+ */
+
+ white = Tk_GetColor(masterPtr->interp, tkwin, "white");
+ black = Tk_GetColor(masterPtr->interp, tkwin, "black");
+ gcValues.foreground = (white != NULL)? white->pixel:
+ WhitePixelOfScreen(Tk_Screen(tkwin));
+ gcValues.background = (black != NULL)? black->pixel:
+ BlackPixelOfScreen(Tk_Screen(tkwin));
+ Tk_FreeColor(white);
+ Tk_FreeColor(black);
+ gcValues.graphics_exposures = False;
+ instancePtr->gc = Tk_GetGC(tkwin,
+ GCForeground|GCBackground|GCGraphicsExposures, &gcValues);
+
+ /*
+ * Set configuration options and finish the initialization of the
+ * instance. This will also dither the image if necessary.
+ */
+
+ TkImgPhotoConfigureInstance(instancePtr);
+
+ /*
+ * If this is the first instance, must set the size of the image.
+ */
+
+ if (instancePtr->nextPtr == NULL) {
+ Tk_ImageChanged(masterPtr->tkMaster, 0, 0, 0, 0,
+ masterPtr->width, masterPtr->height);
+ }
+
+ return instancePtr;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * BlendComplexAlpha --
+ *
+ * This function is called when an image with partially transparent
+ * pixels must be drawn over another image. It blends the photo data onto
+ * a local copy of the surface that we are drawing on, *including* the
+ * pixels drawn by everything that should be drawn underneath the image.
+ *
+ * Much of this code has hard-coded values in for speed because this
+ * routine is performance critical for complex image drawing.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Background image passed in gets drawn over with image data.
+ *
+ * Notes:
+ * This should work on all platforms that set mask and shift data
+ * properly from the visualInfo. RGB is really only a 24+ bpp version
+ * whereas RGB15 is the correct version and works for 15bpp+, but it
+ * slower, so it's only used for 15bpp+.
+ *
+ * Note that Win32 pre-defines those operations that we really need.
+ *
+ * Note that on MacOS, if the background comes from a Retina display
+ * then it will be twice as wide and twice as high as the photoimage.
+ *
+ *----------------------------------------------------------------------
+ */
+
+#ifndef _WIN32
+#define GetRValue(rgb) (UCHAR(((rgb) & red_mask) >> red_shift))
+#define GetGValue(rgb) (UCHAR(((rgb) & green_mask) >> green_shift))
+#define GetBValue(rgb) (UCHAR(((rgb) & blue_mask) >> blue_shift))
+#define RGB(r, g, b) ((unsigned)( \
+ (UCHAR(r) << red_shift) | \
+ (UCHAR(g) << green_shift) | \
+ (UCHAR(b) << blue_shift) ))
+#define RGB15(r, g, b) ((unsigned)( \
+ (((r) * red_mask / 255) & red_mask) | \
+ (((g) * green_mask / 255) & green_mask) | \
+ (((b) * blue_mask / 255) & blue_mask) ))
+#endif /* !_WIN32 */
+
+static void
+BlendComplexAlpha(
+ XImage *bgImg, /* Background image to draw on. */
+ PhotoInstance *iPtr, /* Image instance to draw. */
+ int xOffset, int yOffset, /* X & Y offset into image instance to
+ * draw. */
+ int width, int height) /* Width & height of image to draw. */
+{
+ int x, y, line;
+ unsigned long pixel;
+ unsigned char r, g, b, alpha, unalpha, *masterPtr;
+ unsigned char *alphaAr = iPtr->masterPtr->pix32;
+#if defined(MAC_OSX_TK)
+ /* Background "pixels" are actually 2^pp x 2^pp blocks of subpixels. Each
+ * block gets blended with the color of one image pixel. Since we iterate
+ * over the background subpixels, we reset the width and height to the
+ * subpixel dimensions of the background image we are using.
+ */
+ int pp = bgImg->pixelpower;
+ width = width << pp;
+ height = height << pp;
+#endif
+ /*
+ * This blending is an integer version of the Source-Over compositing rule
+ * (see Porter&Duff, "Compositing Digital Images", proceedings of SIGGRAPH
+ * 1984) that has been hard-coded (for speed) to work with targetting a
+ * solid surface.
+ *
+ * The 'unalpha' field must be 255-alpha; it is separated out to encourage
+ * more efficient compilation.
+ */
+
+#define ALPHA_BLEND(bgPix, imgPix, alpha, unalpha) \
+ ((bgPix * unalpha + imgPix * alpha) / 255)
+
+ /*
+ * We have to get the mask and shift info from the visual on non-Win32 so
+ * that the macros Get*Value(), RGB() and RGB15() work correctly. This
+ * might be cached for better performance.
+ */
+
+#ifndef _WIN32
+ unsigned long red_mask, green_mask, blue_mask;
+ unsigned long red_shift, green_shift, blue_shift;
+ Visual *visual = iPtr->visualInfo.visual;
+
+ red_mask = visual->red_mask;
+ green_mask = visual->green_mask;
+ blue_mask = visual->blue_mask;
+ red_shift = 0;
+ green_shift = 0;
+ blue_shift = 0;
+ while ((0x0001 & (red_mask >> red_shift)) == 0) {
+ red_shift++;
+ }
+ while ((0x0001 & (green_mask >> green_shift)) == 0) {
+ green_shift++;
+ }
+ while ((0x0001 & (blue_mask >> blue_shift)) == 0) {
+ blue_shift++;
+ }
+#endif /* !_WIN32 */
+
+ /*
+ * Only UNIX requires the special case for <24bpp. It varies with 3 extra
+ * shifts and uses RGB15. The 24+bpp version could also then be further
+ * optimized.
+ */
+
+#if !(defined(_WIN32) || defined(MAC_OSX_TK))
+ if (bgImg->depth < 24) {
+ unsigned char red_mlen, green_mlen, blue_mlen;
+
+ red_mlen = 8 - CountBits(red_mask >> red_shift);
+ green_mlen = 8 - CountBits(green_mask >> green_shift);
+ blue_mlen = 8 - CountBits(blue_mask >> blue_shift);
+ for (y = 0; y < height; y++) {
+ line = (y + yOffset) * iPtr->masterPtr->width;
+ for (x = 0; x < width; x++) {
+ masterPtr = alphaAr + ((line + x + xOffset) * 4);
+ alpha = masterPtr[3];
+
+ /*
+ * Ignore pixels that are fully transparent
+ */
+
+ if (alpha) {
+ /*
+ * We could perhaps be more efficient than XGetPixel for
+ * 24 and 32 bit displays, but this seems "fast enough".
+ */
+
+ r = masterPtr[0];
+ g = masterPtr[1];
+ b = masterPtr[2];
+ if (alpha != 255) {
+ /*
+ * Only blend pixels that have some transparency
+ */
+
+ unsigned char ra, ga, ba;
+
+ pixel = XGetPixel(bgImg, x, y);
+ ra = GetRValue(pixel) << red_mlen;
+ ga = GetGValue(pixel) << green_mlen;
+ ba = GetBValue(pixel) << blue_mlen;
+ unalpha = 255 - alpha; /* Calculate once. */
+ r = ALPHA_BLEND(ra, r, alpha, unalpha);
+ g = ALPHA_BLEND(ga, g, alpha, unalpha);
+ b = ALPHA_BLEND(ba, b, alpha, unalpha);
+ }
+ XPutPixel(bgImg, x, y, RGB15(r, g, b));
+ }
+ }
+ }
+ return;
+ }
+#endif /* !_WIN32 && !MAC_OSX_TK */
+
+ for (y = 0; y < height; y++) {
+# if !defined(MAC_OSX_TK)
+ line = (y + yOffset) * iPtr->masterPtr->width;
+ for (x = 0; x < width; x++) {
+ masterPtr = alphaAr + ((line + x + xOffset) * 4);
+#else
+ /* Repeat each image row and column 2^pp times. */
+ line = ((y>>pp) + yOffset) * iPtr->masterPtr->width;
+ for (x = 0; x < width; x++) {
+ masterPtr = alphaAr + ((line + (x>>pp) + xOffset) * 4);
+#endif
+ alpha = masterPtr[3];
+
+ /*
+ * Ignore pixels that are fully transparent
+ */
+
+ if (alpha) {
+ /*
+ * We could perhaps be more efficient than XGetPixel for 24
+ * and 32 bit displays, but this seems "fast enough".
+ */
+
+ r = masterPtr[0];
+ g = masterPtr[1];
+ b = masterPtr[2];
+ if (alpha != 255) {
+ /*
+ * Only blend pixels that have some transparency
+ */
+
+ unsigned char ra, ga, ba;
+
+ pixel = XGetPixel(bgImg, x, y);
+ ra = GetRValue(pixel);
+ ga = GetGValue(pixel);
+ ba = GetBValue(pixel);
+ unalpha = 255 - alpha; /* Calculate once. */
+ r = ALPHA_BLEND(ra, r, alpha, unalpha);
+ g = ALPHA_BLEND(ga, g, alpha, unalpha);
+ b = ALPHA_BLEND(ba, b, alpha, unalpha);
+ }
+ XPutPixel(bgImg, x, y, RGB(r, g, b));
+ }
+ }
+ }
+#undef ALPHA_BLEND
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkImgPhotoDisplay --
+ *
+ * This function is invoked to draw a photo image.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * A portion of the image gets rendered in a pixmap or window.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TkImgPhotoDisplay(
+ ClientData clientData, /* Pointer to PhotoInstance structure for
+ * instance to be displayed. */
+ Display *display, /* Display on which to draw image. */
+ Drawable drawable, /* Pixmap or window in which to draw image. */
+ int imageX, int imageY, /* Upper-left corner of region within image to
+ * draw. */
+ int width, int height, /* Dimensions of region within image to
+ * draw. */
+ int drawableX,int drawableY)/* Coordinates within drawable that correspond
+ * to imageX and imageY. */
+{
+ PhotoInstance *instancePtr = clientData;
+ XVisualInfo visInfo = instancePtr->visualInfo;
+
+ /*
+ * If there's no pixmap, it means that an error occurred while creating
+ * the image instance so it can't be displayed.
+ */
+
+ if (instancePtr->pixels == None) {
+ return;
+ }
+
+ if ((instancePtr->masterPtr->flags & COMPLEX_ALPHA)
+ && visInfo.depth >= 15
+ && (visInfo.class == DirectColor || visInfo.class == TrueColor)) {
+ Tk_ErrorHandler handler;
+ XImage *bgImg = NULL;
+
+ /*
+ * Create an error handler to suppress the case where the input was
+ * not properly constrained, which can cause an X error. [Bug 979239]
+ */
+
+ handler = Tk_CreateErrorHandler(display, -1, -1, -1, NULL, NULL);
+
+ /*
+ * Pull the current background from the display to blend with
+ */
+
+ bgImg = XGetImage(display, drawable, drawableX, drawableY,
+ (unsigned int)width, (unsigned int)height, AllPlanes, ZPixmap);
+ if (bgImg == NULL) {
+ Tk_DeleteErrorHandler(handler);
+ /* We failed to get the image, so draw without blending alpha.
+ * It's the best we can do.
+ */
+ goto fallBack;
+ }
+
+ BlendComplexAlpha(bgImg, instancePtr, imageX, imageY, width, height);
+
+ /*
+ * Color info is unimportant as we only do this operation for depth >=
+ * 15.
+ */
+
+ TkPutImage(NULL, 0, display, drawable, instancePtr->gc,
+ bgImg, 0, 0, drawableX, drawableY,
+ (unsigned int) width, (unsigned int) height);
+ XDestroyImage(bgImg);
+ Tk_DeleteErrorHandler(handler);
+ } else {
+ /*
+ * masterPtr->region describes which parts of the image contain valid
+ * data. We set this region as the clip mask for the gc, setting its
+ * origin appropriately, and use it when drawing the image.
+ */
+
+ fallBack:
+ TkSetRegion(display, instancePtr->gc,
+ instancePtr->masterPtr->validRegion);
+ XSetClipOrigin(display, instancePtr->gc, drawableX - imageX,
+ drawableY - imageY);
+ XCopyArea(display, instancePtr->pixels, drawable, instancePtr->gc,
+ imageX, imageY, (unsigned) width, (unsigned) height,
+ drawableX, drawableY);
+ XSetClipMask(display, instancePtr->gc, None);
+ XSetClipOrigin(display, instancePtr->gc, 0, 0);
+ }
+ XFlush(display);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkImgPhotoFree --
+ *
+ * This function is called when a widget ceases to use a particular
+ * instance of an image. We don't actually get rid of the instance until
+ * later because we may be about to get this instance again.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Internal data structures get cleaned up, later.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TkImgPhotoFree(
+ ClientData clientData, /* Pointer to PhotoInstance structure for
+ * instance to be displayed. */
+ Display *display) /* Display containing window that used
+ * image. */
+{
+ PhotoInstance *instancePtr = clientData;
+ ColorTable *colorPtr;
+
+ instancePtr->refCount -= 1;
+ if (instancePtr->refCount > 0) {
+ return;
+ }
+
+ /*
+ * There are no more uses of the image within this widget. Decrement the
+ * count of live uses of its color table, so that its colors can be
+ * reclaimed if necessary, and set up an idle call to free the instance
+ * structure.
+ */
+
+ colorPtr = instancePtr->colorTablePtr;
+ if (colorPtr != NULL) {
+ colorPtr->liveRefCount -= 1;
+ }
+
+ Tcl_DoWhenIdle(TkImgDisposeInstance, instancePtr);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkImgPhotoInstanceSetSize --
+ *
+ * This function reallocates the instance pixmap and dithering error
+ * array for a photo instance, as necessary, to change the image's size
+ * to `width' x `height' pixels.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Storage gets reallocated, here and in the X server.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TkImgPhotoInstanceSetSize(
+ PhotoInstance *instancePtr) /* Instance whose size is to be changed. */
+{
+ PhotoMaster *masterPtr;
+ schar *newError, *errSrcPtr, *errDestPtr;
+ int h, offset;
+ XRectangle validBox;
+ Pixmap newPixmap;
+
+ masterPtr = instancePtr->masterPtr;
+ TkClipBox(masterPtr->validRegion, &validBox);
+
+ if ((instancePtr->width != masterPtr->width)
+ || (instancePtr->height != masterPtr->height)
+ || (instancePtr->pixels == None)) {
+ newPixmap = Tk_GetPixmap(instancePtr->display,
+ RootWindow(instancePtr->display,
+ instancePtr->visualInfo.screen),
+ (masterPtr->width > 0) ? masterPtr->width: 1,
+ (masterPtr->height > 0) ? masterPtr->height: 1,
+ instancePtr->visualInfo.depth);
+ if (!newPixmap) {
+ Tcl_Panic("Fail to create pixmap with Tk_GetPixmap in TkImgPhotoInstanceSetSize");
+ }
+
+ /*
+ * The following is a gross hack needed to properly support colormaps
+ * under Windows. Before the pixels can be copied to the pixmap, the
+ * relevent colormap must be associated with the drawable. Normally we
+ * can infer this association from the window that was used to create
+ * the pixmap. However, in this case we're using the root window, so
+ * we have to be more explicit.
+ */
+
+ TkSetPixmapColormap(newPixmap, instancePtr->colormap);
+
+ if (instancePtr->pixels != None) {
+ /*
+ * Copy any common pixels from the old pixmap and free it.
+ */
+
+ XCopyArea(instancePtr->display, instancePtr->pixels, newPixmap,
+ instancePtr->gc, validBox.x, validBox.y,
+ validBox.width, validBox.height, validBox.x, validBox.y);
+ Tk_FreePixmap(instancePtr->display, instancePtr->pixels);
+ }
+ instancePtr->pixels = newPixmap;
+ }
+
+ if ((instancePtr->width != masterPtr->width)
+ || (instancePtr->height != masterPtr->height)
+ || (instancePtr->error == NULL)) {
+ if (masterPtr->height > 0 && masterPtr->width > 0) {
+ /*
+ * TODO: use attemptckalloc() here once there is a strategy that
+ * will allow us to recover from failure. Right now, there's no
+ * such possibility.
+ */
+
+ newError = ckalloc(masterPtr->height * masterPtr->width
+ * 3 * sizeof(schar));
+
+ /*
+ * Zero the new array so that we don't get bogus error values
+ * propagating into areas we dither later.
+ */
+
+ if ((instancePtr->error != NULL)
+ && ((instancePtr->width == masterPtr->width)
+ || (validBox.width == masterPtr->width))) {
+ if (validBox.y > 0) {
+ memset(newError, 0, (size_t)
+ validBox.y * masterPtr->width * 3 * sizeof(schar));
+ }
+ h = validBox.y + validBox.height;
+ if (h < masterPtr->height) {
+ memset(newError + h*masterPtr->width*3, 0,
+ (size_t) (masterPtr->height - h)
+ * masterPtr->width * 3 * sizeof(schar));
+ }
+ } else {
+ memset(newError, 0, (size_t)
+ masterPtr->height * masterPtr->width *3*sizeof(schar));
+ }
+ } else {
+ newError = NULL;
+ }
+
+ if (instancePtr->error != NULL) {
+ /*
+ * Copy the common area over to the new array and free the old
+ * array.
+ */
+
+ if (masterPtr->width == instancePtr->width) {
+ offset = validBox.y * masterPtr->width * 3;
+ memcpy(newError + offset, instancePtr->error + offset,
+ (size_t) (validBox.height
+ * masterPtr->width * 3 * sizeof(schar)));
+
+ } else if (validBox.width > 0 && validBox.height > 0) {
+ errDestPtr = newError +
+ (validBox.y * masterPtr->width + validBox.x) * 3;
+ errSrcPtr = instancePtr->error +
+ (validBox.y * instancePtr->width + validBox.x) * 3;
+
+ for (h = validBox.height; h > 0; --h) {
+ memcpy(errDestPtr, errSrcPtr,
+ validBox.width * 3 * sizeof(schar));
+ errDestPtr += masterPtr->width * 3;
+ errSrcPtr += instancePtr->width * 3;
+ }
+ }
+ ckfree(instancePtr->error);
+ }
+
+ instancePtr->error = newError;
+ }
+
+ instancePtr->width = masterPtr->width;
+ instancePtr->height = masterPtr->height;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * IsValidPalette --
+ *
+ * This function is called to check whether a value given for the
+ * -palette option is valid for a particular instance of a photo image.
+ *
+ * Results:
+ * A boolean value: 1 if the palette is acceptable, 0 otherwise.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+IsValidPalette(
+ PhotoInstance *instancePtr, /* Instance to which the palette specification
+ * is to be applied. */
+ const char *palette) /* Palette specification string. */
+{
+ int nRed, nGreen, nBlue, mono, numColors;
+ char *endp;
+
+ /*
+ * First parse the specification: it must be of the form %d or %d/%d/%d.
+ */
+
+ nRed = strtol(palette, &endp, 10);
+ if ((endp == palette) || ((*endp != 0) && (*endp != '/'))
+ || (nRed < 2) || (nRed > 256)) {
+ return 0;
+ }
+
+ if (*endp == 0) {
+ mono = 1;
+ nGreen = nBlue = nRed;
+ } else {
+ palette = endp + 1;
+ nGreen = strtol(palette, &endp, 10);
+ if ((endp == palette) || (*endp != '/') || (nGreen < 2)
+ || (nGreen > 256)) {
+ return 0;
+ }
+ palette = endp + 1;
+ nBlue = strtol(palette, &endp, 10);
+ if ((endp == palette) || (*endp != 0) || (nBlue < 2)
+ || (nBlue > 256)) {
+ return 0;
+ }
+ mono = 0;
+ }
+
+ switch (instancePtr->visualInfo.class) {
+ case DirectColor:
+ case TrueColor:
+ if ((nRed > (1 << CountBits(instancePtr->visualInfo.red_mask)))
+ || (nGreen>(1<<CountBits(instancePtr->visualInfo.green_mask)))
+ || (nBlue>(1<<CountBits(instancePtr->visualInfo.blue_mask)))) {
+ return 0;
+ }
+ break;
+ case PseudoColor:
+ case StaticColor:
+ numColors = nRed;
+ if (!mono) {
+ numColors *= nGreen * nBlue;
+ }
+ if (numColors > (1 << instancePtr->visualInfo.depth)) {
+ return 0;
+ }
+ break;
+ case GrayScale:
+ case StaticGray:
+ if (!mono || (nRed > (1 << instancePtr->visualInfo.depth))) {
+ return 0;
+ }
+ break;
+ }
+
+ return 1;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * CountBits --
+ *
+ * This function counts how many bits are set to 1 in `mask'.
+ *
+ * Results:
+ * The integer number of bits.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+CountBits(
+ pixel mask) /* Value to count the 1 bits in. */
+{
+ int n;
+
+ for (n=0 ; mask!=0 ; mask&=mask-1) {
+ n++;
+ }
+ return n;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * GetColorTable --
+ *
+ * This function is called to allocate a table of colormap information
+ * for an instance of a photo image. Only one such table is allocated for
+ * all photo instances using the same display, colormap, palette and
+ * gamma values, so that the application need only request a set of
+ * colors from the X server once for all such photo widgets. This
+ * function maintains a hash table to find previously-allocated
+ * ColorTables.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * A new ColorTable may be allocated and placed in the hash table, and
+ * have colors allocated for it.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+GetColorTable(
+ PhotoInstance *instancePtr) /* Instance needing a color table. */
+{
+ ColorTable *colorPtr;
+ Tcl_HashEntry *entry;
+ ColorTableId id;
+ int isNew;
+
+ /*
+ * Look for an existing ColorTable in the hash table.
+ */
+
+ memset(&id, 0, sizeof(id));
+ id.display = instancePtr->display;
+ id.colormap = instancePtr->colormap;
+ id.palette = instancePtr->palette;
+ id.gamma = instancePtr->gamma;
+ if (!imgPhotoColorHashInitialized) {
+ Tcl_InitHashTable(&imgPhotoColorHash, N_COLOR_HASH);
+ imgPhotoColorHashInitialized = 1;
+ }
+ entry = Tcl_CreateHashEntry(&imgPhotoColorHash, (char *) &id, &isNew);
+
+ if (!isNew) {
+ /*
+ * Re-use the existing entry.
+ */
+
+ colorPtr = Tcl_GetHashValue(entry);
+ } else {
+ /*
+ * No color table currently available; need to make one.
+ */
+
+ colorPtr = ckalloc(sizeof(ColorTable));
+
+ /*
+ * The following line of code should not normally be needed due to the
+ * assignment in the following line. However, it compensates for bugs
+ * in some compilers (HP, for example) where sizeof(ColorTable) is 24
+ * but the assignment only copies 20 bytes, leaving 4 bytes
+ * uninitialized; these cause problems when using the id for lookups
+ * in imgPhotoColorHash, and can result in core dumps.
+ */
+
+ memset(&colorPtr->id, 0, sizeof(ColorTableId));
+ colorPtr->id = id;
+ Tk_PreserveColormap(colorPtr->id.display, colorPtr->id.colormap);
+ colorPtr->flags = 0;
+ colorPtr->refCount = 0;
+ colorPtr->liveRefCount = 0;
+ colorPtr->numColors = 0;
+ colorPtr->visualInfo = instancePtr->visualInfo;
+ colorPtr->pixelMap = NULL;
+ Tcl_SetHashValue(entry, colorPtr);
+ }
+
+ colorPtr->refCount++;
+ colorPtr->liveRefCount++;
+ instancePtr->colorTablePtr = colorPtr;
+ if (colorPtr->flags & DISPOSE_PENDING) {
+ Tcl_CancelIdleCall(DisposeColorTable, colorPtr);
+ colorPtr->flags &= ~DISPOSE_PENDING;
+ }
+
+ /*
+ * Allocate colors for this color table if necessary.
+ */
+
+ if ((colorPtr->numColors == 0) && !(colorPtr->flags & BLACK_AND_WHITE)) {
+ AllocateColors(colorPtr);
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * FreeColorTable --
+ *
+ * This function is called when an instance ceases using a color table.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * If no other instances are using this color table, a when-idle handler
+ * is registered to free up the color table and the colors allocated for
+ * it.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+FreeColorTable(
+ ColorTable *colorPtr, /* Pointer to the color table which is no
+ * longer required by an instance. */
+ int force) /* Force free to happen immediately. */
+{
+ colorPtr->refCount--;
+ if (colorPtr->refCount > 0) {
+ return;
+ }
+
+ if (force) {
+ if (colorPtr->flags & DISPOSE_PENDING) {
+ Tcl_CancelIdleCall(DisposeColorTable, colorPtr);
+ colorPtr->flags &= ~DISPOSE_PENDING;
+ }
+ DisposeColorTable(colorPtr);
+ } else if (!(colorPtr->flags & DISPOSE_PENDING)) {
+ Tcl_DoWhenIdle(DisposeColorTable, colorPtr);
+ colorPtr->flags |= DISPOSE_PENDING;
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * AllocateColors --
+ *
+ * This function allocates the colors required by a color table, and sets
+ * up the fields in the color table data structure which are used in
+ * dithering.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Colors are allocated from the X server. Fields in the color table data
+ * structure are updated.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+AllocateColors(
+ ColorTable *colorPtr) /* Pointer to the color table requiring colors
+ * to be allocated. */
+{
+ int i, r, g, b, rMult, mono;
+ int numColors, nRed, nGreen, nBlue;
+ double fr, fg, fb, igam;
+ XColor *colors;
+ unsigned long *pixels;
+
+ /*
+ * 16-bit intensity value for i/n of full intensity.
+ */
+#define CFRAC(i, n) ((i) * 65535 / (n))
+
+ /* As for CFRAC, but apply exponent of g. */
+#define CGFRAC(i, n, g) ((int)(65535 * pow((double)(i) / (n), (g))))
+
+ /*
+ * First parse the palette specification to get the required number of
+ * shades of each primary.
+ */
+
+ mono = sscanf(colorPtr->id.palette, "%d/%d/%d", &nRed, &nGreen, &nBlue)
+ <= 1;
+ igam = 1.0 / colorPtr->id.gamma;
+
+ /*
+ * Each time around this loop, we reduce the number of colors we're trying
+ * to allocate until we succeed in allocating all of the colors we need.
+ */
+
+ for (;;) {
+ /*
+ * If we are using 1 bit/pixel, we don't need to allocate any colors
+ * (we just use the foreground and background colors in the GC).
+ */
+
+ if (mono && (nRed <= 2)) {
+ colorPtr->flags |= BLACK_AND_WHITE;
+ return;
+ }
+
+ /*
+ * Calculate the RGB coordinates of the colors we want to allocate and
+ * store them in *colors.
+ */
+
+ if ((colorPtr->visualInfo.class == DirectColor)
+ || (colorPtr->visualInfo.class == TrueColor)) {
+
+ /*
+ * Direct/True Color: allocate shades of red, green, blue
+ * independently.
+ */
+
+ if (mono) {
+ numColors = nGreen = nBlue = nRed;
+ } else {
+ numColors = MAX(MAX(nRed, nGreen), nBlue);
+ }
+ colors = ckalloc(numColors * sizeof(XColor));
+
+ for (i = 0; i < numColors; ++i) {
+ if (igam == 1.0) {
+ colors[i].red = CFRAC(i, nRed - 1);
+ colors[i].green = CFRAC(i, nGreen - 1);
+ colors[i].blue = CFRAC(i, nBlue - 1);
+ } else {
+ colors[i].red = CGFRAC(i, nRed - 1, igam);
+ colors[i].green = CGFRAC(i, nGreen - 1, igam);
+ colors[i].blue = CGFRAC(i, nBlue - 1, igam);
+ }
+ }
+ } else {
+ /*
+ * PseudoColor, StaticColor, GrayScale or StaticGray visual: we
+ * have to allocate each color in the color cube separately.
+ */
+
+ numColors = (mono) ? nRed: (nRed * nGreen * nBlue);
+ colors = ckalloc(numColors * sizeof(XColor));
+
+ if (!mono) {
+ /*
+ * Color display using a PseudoColor or StaticColor visual.
+ */
+
+ i = 0;
+ for (r = 0; r < nRed; ++r) {
+ for (g = 0; g < nGreen; ++g) {
+ for (b = 0; b < nBlue; ++b) {
+ if (igam == 1.0) {
+ colors[i].red = CFRAC(r, nRed - 1);
+ colors[i].green = CFRAC(g, nGreen - 1);
+ colors[i].blue = CFRAC(b, nBlue - 1);
+ } else {
+ colors[i].red = CGFRAC(r, nRed - 1, igam);
+ colors[i].green = CGFRAC(g, nGreen - 1, igam);
+ colors[i].blue = CGFRAC(b, nBlue - 1, igam);
+ }
+ i++;
+ }
+ }
+ }
+ } else {
+ /*
+ * Monochrome display - allocate the shades of grey we want.
+ */
+
+ for (i = 0; i < numColors; ++i) {
+ if (igam == 1.0) {
+ r = CFRAC(i, numColors - 1);
+ } else {
+ r = CGFRAC(i, numColors - 1, igam);
+ }
+ colors[i].red = colors[i].green = colors[i].blue = r;
+ }
+ }
+ }
+
+ /*
+ * Now try to allocate the colors we've calculated.
+ */
+
+ pixels = ckalloc(numColors * sizeof(unsigned long));
+ for (i = 0; i < numColors; ++i) {
+ if (!XAllocColor(colorPtr->id.display, colorPtr->id.colormap,
+ &colors[i])) {
+ /*
+ * Can't get all the colors we want in the default colormap;
+ * first try freeing colors from other unused color tables.
+ */
+
+ if (!ReclaimColors(&colorPtr->id, numColors - i)
+ || !XAllocColor(colorPtr->id.display,
+ colorPtr->id.colormap, &colors[i])) {
+ /*
+ * Still can't allocate the color.
+ */
+
+ break;
+ }
+ }
+ pixels[i] = colors[i].pixel;
+ }
+
+ /*
+ * If we didn't get all of the colors, reduce the resolution of the
+ * color cube, free the ones we got, and try again.
+ */
+
+ if (i >= numColors) {
+ break;
+ }
+ XFreeColors(colorPtr->id.display, colorPtr->id.colormap, pixels, i, 0);
+ ckfree(colors);
+ ckfree(pixels);
+
+ if (!mono) {
+ if ((nRed == 2) && (nGreen == 2) && (nBlue == 2)) {
+ /*
+ * Fall back to 1-bit monochrome display.
+ */
+
+ mono = 1;
+ } else {
+ /*
+ * Reduce the number of shades of each primary to about 3/4 of
+ * the previous value. This should reduce the total number of
+ * colors required to about half the previous value for
+ * PseudoColor displays.
+ */
+
+ nRed = (nRed * 3 + 2) / 4;
+ nGreen = (nGreen * 3 + 2) / 4;
+ nBlue = (nBlue * 3 + 2) / 4;
+ }
+ } else {
+ /*
+ * Reduce the number of shades of gray to about 1/2.
+ */
+
+ nRed = nRed / 2;
+ }
+ }
+
+ /*
+ * We have allocated all of the necessary colors: fill in various fields
+ * of the ColorTable record.
+ */
+
+ if (!mono) {
+ colorPtr->flags |= COLOR_WINDOW;
+
+ /*
+ * The following is a hairy hack. We only want to index into the
+ * pixelMap on colormap displays. However, if the display is on
+ * Windows, then we actually want to store the index not the value
+ * since we will be passing the color table into the TkPutImage call.
+ */
+
+#ifndef _WIN32
+ if ((colorPtr->visualInfo.class != DirectColor)
+ && (colorPtr->visualInfo.class != TrueColor)) {
+ colorPtr->flags |= MAP_COLORS;
+ }
+#endif /* _WIN32 */
+ }
+
+ colorPtr->numColors = numColors;
+ colorPtr->pixelMap = pixels;
+
+ /*
+ * Set up quantization tables for dithering.
+ */
+
+ rMult = nGreen * nBlue;
+ for (i = 0; i < 256; ++i) {
+ r = (i * (nRed - 1) + 127) / 255;
+ if (mono) {
+ fr = (double) colors[r].red / 65535.0;
+ if (colorPtr->id.gamma != 1.0 ) {
+ fr = pow(fr, colorPtr->id.gamma);
+ }
+ colorPtr->colorQuant[0][i] = (int)(fr * 255.99);
+ colorPtr->redValues[i] = colors[r].pixel;
+ } else {
+ g = (i * (nGreen - 1) + 127) / 255;
+ b = (i * (nBlue - 1) + 127) / 255;
+ if ((colorPtr->visualInfo.class == DirectColor)
+ || (colorPtr->visualInfo.class == TrueColor)) {
+ colorPtr->redValues[i] =
+ colors[r].pixel & colorPtr->visualInfo.red_mask;
+ colorPtr->greenValues[i] =
+ colors[g].pixel & colorPtr->visualInfo.green_mask;
+ colorPtr->blueValues[i] =
+ colors[b].pixel & colorPtr->visualInfo.blue_mask;
+ } else {
+ r *= rMult;
+ g *= nBlue;
+ colorPtr->redValues[i] = r;
+ colorPtr->greenValues[i] = g;
+ colorPtr->blueValues[i] = b;
+ }
+ fr = (double) colors[r].red / 65535.0;
+ fg = (double) colors[g].green / 65535.0;
+ fb = (double) colors[b].blue / 65535.0;
+ if (colorPtr->id.gamma != 1.0) {
+ fr = pow(fr, colorPtr->id.gamma);
+ fg = pow(fg, colorPtr->id.gamma);
+ fb = pow(fb, colorPtr->id.gamma);
+ }
+ colorPtr->colorQuant[0][i] = (int)(fr * 255.99);
+ colorPtr->colorQuant[1][i] = (int)(fg * 255.99);
+ colorPtr->colorQuant[2][i] = (int)(fb * 255.99);
+ }
+ }
+
+ ckfree(colors);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * DisposeColorTable --
+ *
+ * Release a color table and its associated resources.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The colors in the argument color table are freed, as is the color
+ * table structure itself. The color table is removed from the hash table
+ * which is used to locate color tables.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+DisposeColorTable(
+ ClientData clientData) /* Pointer to the ColorTable whose
+ * colors are to be released. */
+{
+ ColorTable *colorPtr = clientData;
+ Tcl_HashEntry *entry;
+
+ if (colorPtr->pixelMap != NULL) {
+ if (colorPtr->numColors > 0) {
+ XFreeColors(colorPtr->id.display, colorPtr->id.colormap,
+ colorPtr->pixelMap, colorPtr->numColors, 0);
+ Tk_FreeColormap(colorPtr->id.display, colorPtr->id.colormap);
+ }
+ ckfree(colorPtr->pixelMap);
+ }
+
+ entry = Tcl_FindHashEntry(&imgPhotoColorHash, (char *) &colorPtr->id);
+ if (entry == NULL) {
+ Tcl_Panic("DisposeColorTable couldn't find hash entry");
+ }
+ Tcl_DeleteHashEntry(entry);
+
+ ckfree(colorPtr);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ReclaimColors --
+ *
+ * This function is called to try to free up colors in the colormap used
+ * by a color table. It looks for other color tables with the same
+ * colormap and with a zero live reference count, and frees their colors.
+ * It only does so if there is the possibility of freeing up at least
+ * `numColors' colors.
+ *
+ * Results:
+ * The return value is TRUE if any colors were freed, FALSE otherwise.
+ *
+ * Side effects:
+ * ColorTables which are not currently in use may lose their color
+ * allocations.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+ReclaimColors(
+ ColorTableId *id, /* Pointer to information identifying
+ * the color table which needs more colors. */
+ int numColors) /* Number of colors required. */
+{
+ Tcl_HashSearch srch;
+ Tcl_HashEntry *entry;
+ ColorTable *colorPtr;
+ int nAvail = 0;
+
+ /*
+ * First scan through the color hash table to get an upper bound on how
+ * many colors we might be able to free.
+ */
+
+ entry = Tcl_FirstHashEntry(&imgPhotoColorHash, &srch);
+ while (entry != NULL) {
+ colorPtr = Tcl_GetHashValue(entry);
+ if ((colorPtr->id.display == id->display)
+ && (colorPtr->id.colormap == id->colormap)
+ && (colorPtr->liveRefCount == 0 )&& (colorPtr->numColors != 0)
+ && ((colorPtr->id.palette != id->palette)
+ || (colorPtr->id.gamma != id->gamma))) {
+ /*
+ * We could take this guy's colors off him.
+ */
+
+ nAvail += colorPtr->numColors;
+ }
+ entry = Tcl_NextHashEntry(&srch);
+ }
+
+ /*
+ * nAvail is an (over)estimate of the number of colors we could free.
+ */
+
+ if (nAvail < numColors) {
+ return 0;
+ }
+
+ /*
+ * Scan through a second time freeing colors.
+ */
+
+ entry = Tcl_FirstHashEntry(&imgPhotoColorHash, &srch);
+ while ((entry != NULL) && (numColors > 0)) {
+ colorPtr = Tcl_GetHashValue(entry);
+ if ((colorPtr->id.display == id->display)
+ && (colorPtr->id.colormap == id->colormap)
+ && (colorPtr->liveRefCount == 0) && (colorPtr->numColors != 0)
+ && ((colorPtr->id.palette != id->palette)
+ || (colorPtr->id.gamma != id->gamma))) {
+ /*
+ * Free the colors that this ColorTable has.
+ */
+
+ XFreeColors(colorPtr->id.display, colorPtr->id.colormap,
+ colorPtr->pixelMap, colorPtr->numColors, 0);
+ numColors -= colorPtr->numColors;
+ colorPtr->numColors = 0;
+ ckfree(colorPtr->pixelMap);
+ colorPtr->pixelMap = NULL;
+ }
+
+ entry = Tcl_NextHashEntry(&srch);
+ }
+ return 1; /* We freed some colors. */
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkImgDisposeInstance --
+ *
+ * This function is called to finally free up an instance of a photo
+ * image which is no longer required.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The instance data structure and the resources it references are freed.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TkImgDisposeInstance(
+ ClientData clientData) /* Pointer to the instance whose resources are
+ * to be released. */
+{
+ PhotoInstance *instancePtr = clientData;
+ PhotoInstance *prevPtr;
+
+ if (instancePtr->pixels != None) {
+ Tk_FreePixmap(instancePtr->display, instancePtr->pixels);
+ }
+ if (instancePtr->gc != None) {
+ Tk_FreeGC(instancePtr->display, instancePtr->gc);
+ }
+ if (instancePtr->imagePtr != NULL) {
+ XDestroyImage(instancePtr->imagePtr);
+ }
+ if (instancePtr->error != NULL) {
+ ckfree(instancePtr->error);
+ }
+ if (instancePtr->colorTablePtr != NULL) {
+ FreeColorTable(instancePtr->colorTablePtr, 1);
+ }
+
+ if (instancePtr->masterPtr->instancePtr == instancePtr) {
+ instancePtr->masterPtr->instancePtr = instancePtr->nextPtr;
+ } else {
+ for (prevPtr = instancePtr->masterPtr->instancePtr;
+ prevPtr->nextPtr != instancePtr; prevPtr = prevPtr->nextPtr) {
+ /* Empty loop body. */
+ }
+ prevPtr->nextPtr = instancePtr->nextPtr;
+ }
+ Tk_FreeColormap(instancePtr->display, instancePtr->colormap);
+ ckfree(instancePtr);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkImgDitherInstance --
+ *
+ * This function is called to update an area of an instance's pixmap by
+ * dithering the corresponding area of the master.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The instance's pixmap gets updated.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TkImgDitherInstance(
+ PhotoInstance *instancePtr, /* The instance to be updated. */
+ int xStart, int yStart, /* Coordinates of the top-left pixel in the
+ * block to be dithered. */
+ int width, int height) /* Dimensions of the block to be dithered. */
+{
+ PhotoMaster *masterPtr = instancePtr->masterPtr;
+ ColorTable *colorPtr = instancePtr->colorTablePtr;
+ XImage *imagePtr;
+ int nLines, bigEndian, i, c, x, y, xEnd, doDithering = 1;
+ int bitsPerPixel, bytesPerLine, lineLength;
+ unsigned char *srcLinePtr;
+ schar *errLinePtr;
+ pixel firstBit, word, mask;
+
+ /*
+ * Turn dithering off in certain cases where it is not needed (TrueColor,
+ * DirectColor with many colors).
+ */
+
+ if ((colorPtr->visualInfo.class == DirectColor)
+ || (colorPtr->visualInfo.class == TrueColor)) {
+ int nRed, nGreen, nBlue, result;
+
+ result = sscanf(colorPtr->id.palette, "%d/%d/%d", &nRed,
+ &nGreen, &nBlue);
+ if ((nRed >= 256)
+ && ((result == 1) || ((nGreen >= 256) && (nBlue >= 256)))) {
+ doDithering = 0;
+ }
+ }
+
+ /*
+ * First work out how many lines to do at a time, then how many bytes
+ * we'll need for pixel storage, and allocate it.
+ */
+
+ nLines = (MAX_PIXELS + width - 1) / width;
+ if (nLines < 1) {
+ nLines = 1;
+ }
+ if (nLines > height ) {
+ nLines = height;
+ }
+
+ imagePtr = instancePtr->imagePtr;
+ if (imagePtr == NULL) {
+ return; /* We must be really tight on memory. */
+ }
+ bitsPerPixel = imagePtr->bits_per_pixel;
+ bytesPerLine = ((bitsPerPixel * width + 31) >> 3) & ~3;
+ imagePtr->width = width;
+ imagePtr->height = nLines;
+ imagePtr->bytes_per_line = bytesPerLine;
+
+ /*
+ * TODO: use attemptckalloc() here once we have some strategy for
+ * recovering from the failure.
+ */
+
+ imagePtr->data = ckalloc(imagePtr->bytes_per_line * nLines);
+ bigEndian = imagePtr->bitmap_bit_order == MSBFirst;
+ firstBit = bigEndian? (1 << (imagePtr->bitmap_unit - 1)): 1;
+
+ lineLength = masterPtr->width * 3;
+ srcLinePtr = masterPtr->pix32 + (yStart * masterPtr->width + xStart) * 4;
+ errLinePtr = instancePtr->error + yStart * lineLength + xStart * 3;
+ xEnd = xStart + width;
+
+ /*
+ * Loop over the image, doing at most nLines lines before updating the
+ * screen image.
+ */
+
+ for (; height > 0; height -= nLines) {
+ unsigned char *dstLinePtr = (unsigned char *) imagePtr->data;
+ int yEnd;
+
+ if (nLines > height) {
+ nLines = height;
+ }
+ yEnd = yStart + nLines;
+ for (y = yStart; y < yEnd; ++y) {
+ unsigned char *srcPtr = srcLinePtr;
+ schar *errPtr = errLinePtr;
+ unsigned char *destBytePtr = dstLinePtr;
+ pixel *destLongPtr = (pixel *) dstLinePtr;
+
+ if (colorPtr->flags & COLOR_WINDOW) {
+ /*
+ * Color window. We dither the three components independently,
+ * using Floyd-Steinberg dithering, which propagates errors
+ * from the quantization of pixels to the pixels below and to
+ * the right.
+ */
+
+ for (x = xStart; x < xEnd; ++x) {
+ int col[3];
+
+ if (doDithering) {
+ for (i = 0; i < 3; ++i) {
+ /*
+ * Compute the error propagated into this pixel
+ * for this component. If e[x,y] is the array of
+ * quantization error values, we compute
+ * 7/16 * e[x-1,y] + 1/16 * e[x-1,y-1]
+ * + 5/16 * e[x,y-1] + 3/16 * e[x+1,y-1]
+ * and round it to an integer.
+ *
+ * The expression ((c + 2056) >> 4) - 128 computes
+ * round(c / 16), and works correctly on machines
+ * without a sign-extending right shift.
+ */
+
+ c = (x > 0) ? errPtr[-3] * 7: 0;
+ if (y > 0) {
+ if (x > 0) {
+ c += errPtr[-lineLength-3];
+ }
+ c += errPtr[-lineLength] * 5;
+ if ((x + 1) < masterPtr->width) {
+ c += errPtr[-lineLength+3] * 3;
+ }
+ }
+
+ /*
+ * Add the propagated error to the value of this
+ * component, quantize it, and store the
+ * quantization error.
+ */
+
+ c = ((c + 2056) >> 4) - 128 + *srcPtr++;
+ if (c < 0) {
+ c = 0;
+ } else if (c > 255) {
+ c = 255;
+ }
+ col[i] = colorPtr->colorQuant[i][c];
+ *errPtr++ = c - col[i];
+ }
+ } else {
+ /*
+ * Output is virtually continuous in this case, so
+ * don't bother dithering.
+ */
+
+ col[0] = *srcPtr++;
+ col[1] = *srcPtr++;
+ col[2] = *srcPtr++;
+ }
+ srcPtr++;
+
+ /*
+ * Translate the quantized component values into an X
+ * pixel value, and store it in the image.
+ */
+
+ i = colorPtr->redValues[col[0]]
+ + colorPtr->greenValues[col[1]]
+ + colorPtr->blueValues[col[2]];
+ if (colorPtr->flags & MAP_COLORS) {
+ i = colorPtr->pixelMap[i];
+ }
+ switch (bitsPerPixel) {
+ case NBBY:
+ *destBytePtr++ = i;
+ break;
+#ifndef _WIN32
+ /*
+ * This case is not valid for Windows because the
+ * image format is different from the pixel format in
+ * Win32. Eventually we need to fix the image code in
+ * Tk to use the Windows native image ordering. This
+ * would speed up the image code for all of the common
+ * sizes.
+ */
+
+ case NBBY * sizeof(pixel):
+ *destLongPtr++ = i;
+ break;
+#endif
+ default:
+ XPutPixel(imagePtr, x - xStart, y - yStart,
+ (unsigned) i);
+ }
+ }
+
+ } else if (bitsPerPixel > 1) {
+ /*
+ * Multibit monochrome window. The operation here is similar
+ * to the color window case above, except that there is only
+ * one component. If the master image is in color, use the
+ * luminance computed as
+ * 0.344 * red + 0.5 * green + 0.156 * blue.
+ */
+
+ for (x = xStart; x < xEnd; ++x) {
+ c = (x > 0) ? errPtr[-1] * 7: 0;
+ if (y > 0) {
+ if (x > 0) {
+ c += errPtr[-lineLength-1];
+ }
+ c += errPtr[-lineLength] * 5;
+ if (x + 1 < masterPtr->width) {
+ c += errPtr[-lineLength+1] * 3;
+ }
+ }
+ c = ((c + 2056) >> 4) - 128;
+
+ if (masterPtr->flags & COLOR_IMAGE) {
+ c += (unsigned) (srcPtr[0] * 11 + srcPtr[1] * 16
+ + srcPtr[2] * 5 + 16) >> 5;
+ } else {
+ c += srcPtr[0];
+ }
+ srcPtr += 4;
+
+ if (c < 0) {
+ c = 0;
+ } else if (c > 255) {
+ c = 255;
+ }
+ i = colorPtr->colorQuant[0][c];
+ *errPtr++ = c - i;
+ i = colorPtr->redValues[i];
+ switch (bitsPerPixel) {
+ case NBBY:
+ *destBytePtr++ = i;
+ break;
+#ifndef _WIN32
+ /*
+ * This case is not valid for Windows because the
+ * image format is different from the pixel format in
+ * Win32. Eventually we need to fix the image code in
+ * Tk to use the Windows native image ordering. This
+ * would speed up the image code for all of the common
+ * sizes.
+ */
+
+ case NBBY * sizeof(pixel):
+ *destLongPtr++ = i;
+ break;
+#endif
+ default:
+ XPutPixel(imagePtr, x - xStart, y - yStart,
+ (unsigned) i);
+ }
+ }
+ } else {
+ /*
+ * 1-bit monochrome window. This is similar to the multibit
+ * monochrome case above, except that the quantization is
+ * simpler (we only have black = 0 and white = 255), and we
+ * produce an XY-Bitmap.
+ */
+
+ word = 0;
+ mask = firstBit;
+ for (x = xStart; x < xEnd; ++x) {
+ /*
+ * If we have accumulated a whole word, store it in the
+ * image and start a new word.
+ */
+
+ if (mask == 0) {
+ *destLongPtr++ = word;
+ mask = firstBit;
+ word = 0;
+ }
+
+ c = (x > 0) ? errPtr[-1] * 7: 0;
+ if (y > 0) {
+ if (x > 0) {
+ c += errPtr[-lineLength-1];
+ }
+ c += errPtr[-lineLength] * 5;
+ if (x + 1 < masterPtr->width) {
+ c += errPtr[-lineLength+1] * 3;
+ }
+ }
+ c = ((c + 2056) >> 4) - 128;
+
+ if (masterPtr->flags & COLOR_IMAGE) {
+ c += (unsigned)(srcPtr[0] * 11 + srcPtr[1] * 16
+ + srcPtr[2] * 5 + 16) >> 5;
+ } else {
+ c += srcPtr[0];
+ }
+ srcPtr += 4;
+
+ if (c < 0) {
+ c = 0;
+ } else if (c > 255) {
+ c = 255;
+ }
+ if (c >= 128) {
+ word |= mask;
+ *errPtr++ = c - 255;
+ } else {
+ *errPtr++ = c;
+ }
+ mask = bigEndian? (mask >> 1): (mask << 1);
+ }
+ *destLongPtr = word;
+ }
+ srcLinePtr += masterPtr->width * 4;
+ errLinePtr += lineLength;
+ dstLinePtr += bytesPerLine;
+ }
+
+ /*
+ * Update the pixmap for this instance with the block of pixels that
+ * we have just computed.
+ */
+
+ TkPutImage(colorPtr->pixelMap, colorPtr->numColors,
+ instancePtr->display, instancePtr->pixels,
+ instancePtr->gc, imagePtr, 0, 0, xStart, yStart,
+ (unsigned) width, (unsigned) nLines);
+ yStart = yEnd;
+ }
+
+ ckfree(imagePtr->data);
+ imagePtr->data = NULL;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkImgResetDither --
+ *
+ * This function is called to eliminate the content of a photo instance's
+ * dither error buffer. It's called when the overall image is blanked.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The instance's dither buffer gets cleared.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TkImgResetDither(
+ PhotoInstance *instancePtr)
+{
+ if (instancePtr->error) {
+ memset(instancePtr->error, 0,
+ /*(size_t)*/ (instancePtr->masterPtr->width
+ * instancePtr->masterPtr->height * 3 * sizeof(schar)));
+ }
+}
+
+/*
+ * Local Variables:
+ * mode: c
+ * c-basic-offset: 4
+ * fill-column: 78
+ * End:
+ */
diff --git a/tk8.6/generic/tkImgPhoto.c b/tk8.6/generic/tkImgPhoto.c
new file mode 100644
index 0000000..3e03f3d
--- /dev/null
+++ b/tk8.6/generic/tkImgPhoto.c
@@ -0,0 +1,4073 @@
+/*
+ * tkImgPhoto.c --
+ *
+ * Implements images of type "photo" for Tk. Photo images are stored in
+ * full color (32 bits per pixel including alpha channel) and displayed
+ * using dithering if necessary.
+ *
+ * Copyright (c) 1994 The Australian National University.
+ * Copyright (c) 1994-1997 Sun Microsystems, Inc.
+ * Copyright (c) 2002-2003 Donal K. Fellows
+ * Copyright (c) 2003 ActiveState Corporation.
+ *
+ * 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.
+ */
+
+#include "tkImgPhoto.h"
+
+/*
+ * The following data structure is used to return information from
+ * ParseSubcommandOptions:
+ */
+
+struct SubcommandOptions {
+ int options; /* Individual bits indicate which options were
+ * specified - see below. */
+ Tcl_Obj *name; /* Name specified without an option. */
+ int fromX, fromY; /* Values specified for -from option. */
+ int fromX2, fromY2; /* Second coordinate pair for -from option. */
+ int toX, toY; /* Values specified for -to option. */
+ int toX2, toY2; /* Second coordinate pair for -to option. */
+ int zoomX, zoomY; /* Values specified for -zoom option. */
+ int subsampleX, subsampleY; /* Values specified for -subsample option. */
+ Tcl_Obj *format; /* Value specified for -format option. */
+ XColor *background; /* Value specified for -background option. */
+ int compositingRule; /* Value specified for -compositingrule
+ * option. */
+};
+
+/*
+ * Bit definitions for use with ParseSubcommandOptions: each bit is set in the
+ * allowedOptions parameter on a call to ParseSubcommandOptions if that option
+ * is allowed for the current photo image subcommand. On return, the bit is
+ * set in the options field of the SubcommandOptions structure if that option
+ * was specified.
+ *
+ * OPT_BACKGROUND: Set if -format option allowed/specified.
+ * OPT_COMPOSITE: Set if -compositingrule option allowed/spec'd.
+ * OPT_FORMAT: Set if -format option allowed/specified.
+ * OPT_FROM: Set if -from option allowed/specified.
+ * OPT_GRAYSCALE: Set if -grayscale option allowed/specified.
+ * OPT_SHRINK: Set if -shrink option allowed/specified.
+ * OPT_SUBSAMPLE: Set if -subsample option allowed/spec'd.
+ * OPT_TO: Set if -to option allowed/specified.
+ * OPT_ZOOM: Set if -zoom option allowed/specified.
+ */
+
+#define OPT_BACKGROUND 1
+#define OPT_COMPOSITE 2
+#define OPT_FORMAT 4
+#define OPT_FROM 8
+#define OPT_GRAYSCALE 0x10
+#define OPT_SHRINK 0x20
+#define OPT_SUBSAMPLE 0x40
+#define OPT_TO 0x80
+#define OPT_ZOOM 0x100
+
+/*
+ * List of option names. The order here must match the order of declarations
+ * of the OPT_* constants above.
+ */
+
+static const char *const optionNames[] = {
+ "-background",
+ "-compositingrule",
+ "-format",
+ "-from",
+ "-grayscale",
+ "-shrink",
+ "-subsample",
+ "-to",
+ "-zoom",
+ NULL
+};
+
+/*
+ * Message to generate when an attempt to resize an image fails due to memory
+ * problems.
+ */
+
+#define TK_PHOTO_ALLOC_FAILURE_MESSAGE \
+ "not enough free memory for image buffer"
+
+/*
+ * Functions used in the type record for photo images.
+ */
+
+static int ImgPhotoCreate(Tcl_Interp *interp, const char *name,
+ int objc, Tcl_Obj *const objv[],
+ const Tk_ImageType *typePtr, Tk_ImageMaster master,
+ ClientData *clientDataPtr);
+static void ImgPhotoDelete(ClientData clientData);
+static int ImgPhotoPostscript(ClientData clientData,
+ Tcl_Interp *interp, Tk_Window tkwin,
+ Tk_PostscriptInfo psInfo, int x, int y, int width,
+ int height, int prepass);
+
+/*
+ * The type record itself for photo images:
+ */
+
+Tk_ImageType tkPhotoImageType = {
+ "photo", /* name */
+ ImgPhotoCreate, /* createProc */
+ TkImgPhotoGet, /* getProc */
+ TkImgPhotoDisplay, /* displayProc */
+ TkImgPhotoFree, /* freeProc */
+ ImgPhotoDelete, /* deleteProc */
+ ImgPhotoPostscript, /* postscriptProc */
+ NULL, /* nextPtr */
+ NULL
+};
+
+typedef struct ThreadSpecificData {
+ Tk_PhotoImageFormat *formatList;
+ /* Pointer to the first in the list of known
+ * photo image formats.*/
+ Tk_PhotoImageFormat *oldFormatList;
+ /* Pointer to the first in the list of known
+ * photo image formats.*/
+ int initialized; /* Set to 1 if we've initialized the
+ * structure. */
+} ThreadSpecificData;
+static Tcl_ThreadDataKey dataKey;
+
+/*
+ * Default configuration
+ */
+
+#define DEF_PHOTO_GAMMA "1"
+#define DEF_PHOTO_HEIGHT "0"
+#define DEF_PHOTO_PALETTE ""
+#define DEF_PHOTO_WIDTH "0"
+
+/*
+ * Information used for parsing configuration specifications:
+ */
+
+static const Tk_ConfigSpec configSpecs[] = {
+ {TK_CONFIG_STRING, "-file", NULL, NULL,
+ NULL, Tk_Offset(PhotoMaster, fileString), TK_CONFIG_NULL_OK, NULL},
+ {TK_CONFIG_DOUBLE, "-gamma", NULL, NULL,
+ DEF_PHOTO_GAMMA, Tk_Offset(PhotoMaster, gamma), 0, NULL},
+ {TK_CONFIG_INT, "-height", NULL, NULL,
+ DEF_PHOTO_HEIGHT, Tk_Offset(PhotoMaster, userHeight), 0, NULL},
+ {TK_CONFIG_UID, "-palette", NULL, NULL,
+ DEF_PHOTO_PALETTE, Tk_Offset(PhotoMaster, palette), 0, NULL},
+ {TK_CONFIG_INT, "-width", NULL, NULL,
+ DEF_PHOTO_WIDTH, Tk_Offset(PhotoMaster, userWidth), 0, NULL},
+ {TK_CONFIG_END, NULL, NULL, NULL, NULL, 0, 0, NULL}
+};
+
+/*
+ * Forward declarations
+ */
+
+static void PhotoFormatThreadExitProc(ClientData clientData);
+static int ImgPhotoCmd(ClientData clientData, Tcl_Interp *interp,
+ int objc, Tcl_Obj *const objv[]);
+static int ParseSubcommandOptions(
+ struct SubcommandOptions *optPtr,
+ Tcl_Interp *interp, int allowedOptions,
+ int *indexPtr, int objc, Tcl_Obj *const objv[]);
+static void ImgPhotoCmdDeletedProc(ClientData clientData);
+static int ImgPhotoConfigureMaster(Tcl_Interp *interp,
+ PhotoMaster *masterPtr, int objc,
+ Tcl_Obj *const objv[], int flags);
+static int ToggleComplexAlphaIfNeeded(PhotoMaster *mPtr);
+static int ImgPhotoSetSize(PhotoMaster *masterPtr, int width,
+ int height);
+static int ImgStringWrite(Tcl_Interp *interp,
+ Tcl_Obj *formatString,
+ Tk_PhotoImageBlock *blockPtr);
+static char * ImgGetPhoto(PhotoMaster *masterPtr,
+ Tk_PhotoImageBlock *blockPtr,
+ struct SubcommandOptions *optPtr);
+static int MatchFileFormat(Tcl_Interp *interp, Tcl_Channel chan,
+ const char *fileName, Tcl_Obj *formatString,
+ Tk_PhotoImageFormat **imageFormatPtr,
+ int *widthPtr, int *heightPtr, int *oldformat);
+static int MatchStringFormat(Tcl_Interp *interp, Tcl_Obj *data,
+ Tcl_Obj *formatString,
+ Tk_PhotoImageFormat **imageFormatPtr,
+ int *widthPtr, int *heightPtr, int *oldformat);
+static const char * GetExtension(const char *path);
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * PhotoFormatThreadExitProc --
+ *
+ * Clean up the registered list of photo formats.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The thread's linked lists of photo image formats is deleted.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+PhotoFormatThreadExitProc(
+ ClientData clientData) /* not used */
+{
+ Tk_PhotoImageFormat *freePtr;
+ ThreadSpecificData *tsdPtr =
+ Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
+
+ while (tsdPtr->oldFormatList != NULL) {
+ freePtr = tsdPtr->oldFormatList;
+ tsdPtr->oldFormatList = tsdPtr->oldFormatList->nextPtr;
+ ckfree(freePtr);
+ }
+ while (tsdPtr->formatList != NULL) {
+ freePtr = tsdPtr->formatList;
+ tsdPtr->formatList = tsdPtr->formatList->nextPtr;
+ ckfree((char *)freePtr->name);
+ ckfree(freePtr);
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_CreateOldPhotoImageFormat, Tk_CreatePhotoImageFormat --
+ *
+ * This function is invoked by an image file handler to register a new
+ * photo image format and the functions that handle the new format. The
+ * function is typically invoked during Tcl_AppInit.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The new image file format is entered into a table used in the photo
+ * image "read" and "write" subcommands.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tk_CreateOldPhotoImageFormat(
+ const Tk_PhotoImageFormat *formatPtr)
+ /* Structure describing the format. All of the
+ * fields except "nextPtr" must be filled in
+ * by caller. */
+{
+ Tk_PhotoImageFormat *copyPtr;
+ ThreadSpecificData *tsdPtr =
+ Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
+
+ if (!tsdPtr->initialized) {
+ tsdPtr->initialized = 1;
+ Tcl_CreateThreadExitHandler(PhotoFormatThreadExitProc, NULL);
+ }
+ copyPtr = ckalloc(sizeof(Tk_PhotoImageFormat));
+ *copyPtr = *formatPtr;
+ copyPtr->nextPtr = tsdPtr->oldFormatList;
+ tsdPtr->oldFormatList = copyPtr;
+}
+
+void
+Tk_CreatePhotoImageFormat(
+ const Tk_PhotoImageFormat *formatPtr)
+ /* Structure describing the format. All of the
+ * fields except "nextPtr" must be filled in
+ * by caller. */
+{
+ Tk_PhotoImageFormat *copyPtr;
+ ThreadSpecificData *tsdPtr =
+ Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
+
+ if (!tsdPtr->initialized) {
+ tsdPtr->initialized = 1;
+ Tcl_CreateThreadExitHandler(PhotoFormatThreadExitProc, NULL);
+ }
+ copyPtr = ckalloc(sizeof(Tk_PhotoImageFormat));
+ *copyPtr = *formatPtr;
+ if (isupper((unsigned char) *formatPtr->name)) {
+ copyPtr->nextPtr = tsdPtr->oldFormatList;
+ tsdPtr->oldFormatList = copyPtr;
+ } else {
+ /* for compatibility with aMSN: make a copy of formatPtr->name */
+ char *name = ckalloc(strlen(formatPtr->name) + 1);
+ strcpy(name, formatPtr->name);
+ copyPtr->name = name;
+ copyPtr->nextPtr = tsdPtr->formatList;
+ tsdPtr->formatList = copyPtr;
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ImgPhotoCreate --
+ *
+ * This function is called by the Tk image code to create a new photo
+ * image.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * The data structure for a new photo image is allocated and initialized.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+ImgPhotoCreate(
+ Tcl_Interp *interp, /* Interpreter for application containing
+ * image. */
+ const char *name, /* Name to use for image. */
+ int objc, /* Number of arguments. */
+ Tcl_Obj *const objv[], /* Argument objects for options (doesn't
+ * include image name or type). */
+ const Tk_ImageType *typePtr,/* Pointer to our type record (not used). */
+ Tk_ImageMaster master, /* Token for image, to be used by us in later
+ * callbacks. */
+ ClientData *clientDataPtr) /* Store manager's token for image here; it
+ * will be returned in later callbacks. */
+{
+ PhotoMaster *masterPtr;
+
+ /*
+ * Allocate and initialize the photo image master record.
+ */
+
+ masterPtr = ckalloc(sizeof(PhotoMaster));
+ memset(masterPtr, 0, sizeof(PhotoMaster));
+ masterPtr->tkMaster = master;
+ masterPtr->interp = interp;
+ masterPtr->imageCmd = Tcl_CreateObjCommand(interp, name, ImgPhotoCmd,
+ masterPtr, ImgPhotoCmdDeletedProc);
+ masterPtr->palette = NULL;
+ masterPtr->pix32 = NULL;
+ masterPtr->instancePtr = NULL;
+ masterPtr->validRegion = TkCreateRegion();
+
+ /*
+ * Process configuration options given in the image create command.
+ */
+
+ if (ImgPhotoConfigureMaster(interp, masterPtr, objc, objv, 0) != TCL_OK) {
+ ImgPhotoDelete(masterPtr);
+ return TCL_ERROR;
+ }
+
+ *clientDataPtr = masterPtr;
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ImgPhotoCmd --
+ *
+ * This function is invoked to process the Tcl command that corresponds
+ * to a photo image. See the user documentation for details on what it
+ * does.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * See the user documentation.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+ImgPhotoCmd(
+ ClientData clientData, /* Information about photo master. */
+ Tcl_Interp *interp, /* Current interpreter. */
+ int objc, /* Number of arguments. */
+ Tcl_Obj *const objv[]) /* Argument objects. */
+{
+ static const char *const photoOptions[] = {
+ "blank", "cget", "configure", "copy", "data", "get", "put",
+ "read", "redither", "transparency", "write", NULL
+ };
+ enum PhotoOptions {
+ PHOTO_BLANK, PHOTO_CGET, PHOTO_CONFIGURE, PHOTO_COPY, PHOTO_DATA,
+ PHOTO_GET, PHOTO_PUT, PHOTO_READ, PHOTO_REDITHER, PHOTO_TRANS,
+ PHOTO_WRITE
+ };
+
+ PhotoMaster *masterPtr = clientData;
+ int result, index, x, y, width, height, dataWidth, dataHeight, listObjc;
+ struct SubcommandOptions options;
+ Tcl_Obj **listObjv, **srcObjv;
+ unsigned char *pixelPtr;
+ Tk_PhotoImageBlock block;
+ Tk_Window tkwin;
+ Tk_PhotoImageFormat *imageFormat;
+ int imageWidth, imageHeight, matched, length, oldformat = 0;
+ Tcl_Channel chan;
+ Tk_PhotoHandle srcHandle;
+ ThreadSpecificData *tsdPtr =
+ Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
+
+ if (objc < 2) {
+ Tcl_WrongNumArgs(interp, 1, objv, "option ?arg ...?");
+ return TCL_ERROR;
+ }
+
+ if (Tcl_GetIndexFromObj(interp, objv[1], photoOptions, "option", 0,
+ &index) != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ switch ((enum PhotoOptions) index) {
+ case PHOTO_BLANK:
+ /*
+ * photo blank command - just call Tk_PhotoBlank.
+ */
+
+ if (objc == 2) {
+ Tk_PhotoBlank(masterPtr);
+ return TCL_OK;
+ } else {
+ Tcl_WrongNumArgs(interp, 2, objv, NULL);
+ return TCL_ERROR;
+ }
+
+ case PHOTO_CGET: {
+ const char *arg;
+
+ if (objc != 3) {
+ Tcl_WrongNumArgs(interp, 2, objv, "option");
+ return TCL_ERROR;
+ }
+ arg = Tcl_GetStringFromObj(objv[2], &length);
+ if (strncmp(arg,"-data", (unsigned) length) == 0) {
+ if (masterPtr->dataString) {
+ Tcl_SetObjResult(interp, masterPtr->dataString);
+ }
+ } else if (strncmp(arg,"-format", (unsigned) length) == 0) {
+ if (masterPtr->format) {
+ Tcl_SetObjResult(interp, masterPtr->format);
+ }
+ } else {
+ Tk_ConfigureValue(interp, Tk_MainWindow(interp), configSpecs,
+ (char *) masterPtr, Tcl_GetString(objv[2]), 0);
+ }
+ return TCL_OK;
+ }
+
+ case PHOTO_CONFIGURE:
+ /*
+ * photo configure command - handle this in the standard way.
+ */
+
+ if (objc == 2) {
+ Tcl_Obj *obj, *subobj;
+
+ result = Tk_ConfigureInfo(interp, Tk_MainWindow(interp),
+ configSpecs, (char *) masterPtr, NULL, 0);
+ if (result != TCL_OK) {
+ return result;
+ }
+ obj = Tcl_NewObj();
+ subobj = Tcl_NewStringObj("-data {} {} {}", 14);
+ if (masterPtr->dataString) {
+ Tcl_ListObjAppendElement(NULL, subobj, masterPtr->dataString);
+ } else {
+ Tcl_AppendStringsToObj(subobj, " {}", NULL);
+ }
+ Tcl_ListObjAppendElement(interp, obj, subobj);
+ subobj = Tcl_NewStringObj("-format {} {} {}", 16);
+ if (masterPtr->format) {
+ Tcl_ListObjAppendElement(NULL, subobj, masterPtr->format);
+ } else {
+ Tcl_AppendStringsToObj(subobj, " {}", NULL);
+ }
+ Tcl_ListObjAppendElement(interp, obj, subobj);
+ Tcl_ListObjAppendList(interp, obj, Tcl_GetObjResult(interp));
+ Tcl_SetObjResult(interp, obj);
+ return TCL_OK;
+
+ } else if (objc == 3) {
+ const char *arg = Tcl_GetStringFromObj(objv[2], &length);
+
+ if (length > 1 && !strncmp(arg, "-data", (unsigned) length)) {
+ Tcl_AppendResult(interp, "-data {} {} {}", NULL);
+ if (masterPtr->dataString) {
+ /*
+ * TODO: Modifying result is bad!
+ */
+
+ Tcl_ListObjAppendElement(NULL, Tcl_GetObjResult(interp),
+ masterPtr->dataString);
+ } else {
+ Tcl_AppendResult(interp, " {}", NULL);
+ }
+ return TCL_OK;
+ } else if (length > 1 &&
+ !strncmp(arg, "-format", (unsigned) length)) {
+ Tcl_AppendResult(interp, "-format {} {} {}", NULL);
+ if (masterPtr->format) {
+ /*
+ * TODO: Modifying result is bad!
+ */
+
+ Tcl_ListObjAppendElement(NULL, Tcl_GetObjResult(interp),
+ masterPtr->format);
+ } else {
+ Tcl_AppendResult(interp, " {}", NULL);
+ }
+ return TCL_OK;
+ } else {
+ return Tk_ConfigureInfo(interp, Tk_MainWindow(interp),
+ configSpecs, (char *) masterPtr, arg, 0);
+ }
+ } else {
+ return ImgPhotoConfigureMaster(interp, masterPtr, objc-2, objv+2,
+ TK_CONFIG_ARGV_ONLY);
+ }
+
+ case PHOTO_COPY:
+ /*
+ * photo copy command - first parse options.
+ */
+
+ index = 2;
+ memset(&options, 0, sizeof(options));
+ options.zoomX = options.zoomY = 1;
+ options.subsampleX = options.subsampleY = 1;
+ options.name = NULL;
+ options.compositingRule = TK_PHOTO_COMPOSITE_OVERLAY;
+ if (ParseSubcommandOptions(&options, interp,
+ OPT_FROM | OPT_TO | OPT_ZOOM | OPT_SUBSAMPLE | OPT_SHRINK |
+ OPT_COMPOSITE, &index, objc, objv) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (options.name == NULL || index < objc) {
+ Tcl_WrongNumArgs(interp, 2, objv,
+ "source-image ?-compositingrule rule? ?-from x1 y1 x2 y2? ?-to x1 y1 x2 y2? ?-zoom x y? ?-subsample x y?");
+ return TCL_ERROR;
+ }
+
+ /*
+ * Look for the source image and get a pointer to its image data.
+ * Check the values given for the -from option.
+ */
+
+ srcHandle = Tk_FindPhoto(interp, Tcl_GetString(options.name));
+ if (srcHandle == NULL) {
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "image \"%s\" doesn't exist or is not a photo image",
+ Tcl_GetString(options.name)));
+ Tcl_SetErrorCode(interp, "TK", "LOOKUP", "PHOTO",
+ Tcl_GetString(options.name), NULL);
+ return TCL_ERROR;
+ }
+ Tk_PhotoGetImage(srcHandle, &block);
+ if ((options.fromX2 > block.width) || (options.fromY2 > block.height)
+ || (options.fromX2 > block.width)
+ || (options.fromY2 > block.height)) {
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "coordinates for -from option extend outside source image",
+ -1));
+ Tcl_SetErrorCode(interp, "TK", "IMAGE", "PHOTO", "BAD_FROM", NULL);
+ return TCL_ERROR;
+ }
+
+ /*
+ * Hack to pass through the message that the place we're coming from
+ * has a simple alpha channel.
+ */
+
+ if (!(((PhotoMaster *) srcHandle)->flags & COMPLEX_ALPHA)) {
+ options.compositingRule |= SOURCE_IS_SIMPLE_ALPHA_PHOTO;
+ }
+
+ /*
+ * Fill in default values for unspecified parameters.
+ */
+
+ if (!(options.options & OPT_FROM) || (options.fromX2 < 0)) {
+ options.fromX2 = block.width;
+ options.fromY2 = block.height;
+ }
+ if (!(options.options & OPT_TO) || (options.toX2 < 0)) {
+ width = options.fromX2 - options.fromX;
+ if (options.subsampleX > 0) {
+ width = (width + options.subsampleX - 1) / options.subsampleX;
+ } else if (options.subsampleX == 0) {
+ width = 0;
+ } else {
+ width = (width - options.subsampleX - 1) / -options.subsampleX;
+ }
+ options.toX2 = options.toX + width * options.zoomX;
+
+ height = options.fromY2 - options.fromY;
+ if (options.subsampleY > 0) {
+ height = (height + options.subsampleY - 1)
+ / options.subsampleY;
+ } else if (options.subsampleY == 0) {
+ height = 0;
+ } else {
+ height = (height - options.subsampleY - 1)
+ / -options.subsampleY;
+ }
+ options.toY2 = options.toY + height * options.zoomY;
+ }
+
+ /*
+ * Set the destination image size if the -shrink option was specified.
+ */
+
+ if (options.options & OPT_SHRINK) {
+ if (ImgPhotoSetSize(masterPtr, options.toX2,
+ options.toY2) != TCL_OK) {
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ TK_PHOTO_ALLOC_FAILURE_MESSAGE, -1));
+ Tcl_SetErrorCode(interp, "TK", "MALLOC", NULL);
+ return TCL_ERROR;
+ }
+ }
+
+ /*
+ * Copy the image data over using Tk_PhotoPutZoomedBlock.
+ */
+
+ block.pixelPtr += options.fromX * block.pixelSize
+ + options.fromY * block.pitch;
+ block.width = options.fromX2 - options.fromX;
+ block.height = options.fromY2 - options.fromY;
+ return Tk_PhotoPutZoomedBlock(interp, (Tk_PhotoHandle) masterPtr,
+ &block, options.toX, options.toY, options.toX2 - options.toX,
+ options.toY2 - options.toY, options.zoomX, options.zoomY,
+ options.subsampleX, options.subsampleY,
+ options.compositingRule);
+
+ case PHOTO_DATA: {
+ char *data;
+
+ /*
+ * photo data command - first parse and check any options given.
+ */
+
+ Tk_ImageStringWriteProc *stringWriteProc = NULL;
+
+ index = 2;
+ memset(&options, 0, sizeof(options));
+ options.name = NULL;
+ options.format = NULL;
+ options.fromX = 0;
+ options.fromY = 0;
+ if (ParseSubcommandOptions(&options, interp,
+ OPT_FORMAT | OPT_FROM | OPT_GRAYSCALE | OPT_BACKGROUND,
+ &index, objc, objv) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if ((options.name != NULL) || (index < objc)) {
+ Tcl_WrongNumArgs(interp, 2, objv, "?-option value ...?");
+ return TCL_ERROR;
+ }
+ if ((options.fromX > masterPtr->width)
+ || (options.fromY > masterPtr->height)
+ || (options.fromX2 > masterPtr->width)
+ || (options.fromY2 > masterPtr->height)) {
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "coordinates for -from option extend outside image", -1));
+ Tcl_SetErrorCode(interp, "TK", "IMAGE", "PHOTO", "BAD_FROM", NULL);
+ return TCL_ERROR;
+ }
+
+ /*
+ * Fill in default values for unspecified parameters.
+ */
+
+ if (!(options.options & OPT_FROM) || (options.fromX2 < 0)) {
+ options.fromX2 = masterPtr->width;
+ options.fromY2 = masterPtr->height;
+ }
+
+ /*
+ * Search for an appropriate image string format handler.
+ */
+
+ if (options.options & OPT_FORMAT) {
+ matched = 0;
+ for (imageFormat = tsdPtr->formatList; imageFormat != NULL;
+ imageFormat = imageFormat->nextPtr) {
+ if ((strncasecmp(Tcl_GetString(options.format),
+ imageFormat->name, strlen(imageFormat->name)) == 0)) {
+ matched = 1;
+ if (imageFormat->stringWriteProc != NULL) {
+ stringWriteProc = imageFormat->stringWriteProc;
+ break;
+ }
+ }
+ }
+ if (stringWriteProc == NULL) {
+ oldformat = 1;
+ for (imageFormat = tsdPtr->oldFormatList; imageFormat != NULL;
+ imageFormat = imageFormat->nextPtr) {
+ if ((strncasecmp(Tcl_GetString(options.format),
+ imageFormat->name,
+ strlen(imageFormat->name)) == 0)) {
+ matched = 1;
+ if (imageFormat->stringWriteProc != NULL) {
+ stringWriteProc = imageFormat->stringWriteProc;
+ break;
+ }
+ }
+ }
+ }
+ if (stringWriteProc == NULL) {
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "image string format \"%s\" is %s",
+ Tcl_GetString(options.format),
+ (matched ? "not supported" : "unknown")));
+ Tcl_SetErrorCode(interp, "TK", "LOOKUP", "PHOTO_FORMAT",
+ Tcl_GetString(options.format), NULL);
+ return TCL_ERROR;
+ }
+ } else {
+ stringWriteProc = ImgStringWrite;
+ }
+
+ /*
+ * Call the handler's string write function to write out the image.
+ */
+
+ data = ImgGetPhoto(masterPtr, &block, &options);
+
+ if (oldformat) {
+ Tcl_DString buffer;
+ typedef int (*OldStringWriteProc)(Tcl_Interp *interp,
+ Tcl_DString *dataPtr, const char *formatString,
+ Tk_PhotoImageBlock *blockPtr);
+
+ Tcl_DStringInit(&buffer);
+ result = ((OldStringWriteProc) stringWriteProc)(interp, &buffer,
+ Tcl_GetString(options.format), &block);
+ if (result == TCL_OK) {
+ Tcl_DStringResult(interp, &buffer);
+ } else {
+ Tcl_DStringFree(&buffer);
+ }
+ } else {
+ typedef int (*NewStringWriteProc)(Tcl_Interp *interp,
+ Tcl_Obj *formatString, Tk_PhotoImageBlock *blockPtr,
+ void *dummy);
+
+ result = ((NewStringWriteProc) stringWriteProc)(interp,
+ options.format, &block, NULL);
+ }
+ if (options.background) {
+ Tk_FreeColor(options.background);
+ }
+ if (data) {
+ ckfree(data);
+ }
+ return result;
+ }
+
+ case PHOTO_GET: {
+ /*
+ * photo get command - first parse and check parameters.
+ */
+
+ Tcl_Obj *channels[3];
+
+ if (objc != 4) {
+ Tcl_WrongNumArgs(interp, 2, objv, "x y");
+ return TCL_ERROR;
+ }
+ if ((Tcl_GetIntFromObj(interp, objv[2], &x) != TCL_OK)
+ || (Tcl_GetIntFromObj(interp, objv[3], &y) != TCL_OK)) {
+ return TCL_ERROR;
+ }
+ if ((x < 0) || (x >= masterPtr->width)
+ || (y < 0) || (y >= masterPtr->height)) {
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "%s get: coordinates out of range",
+ Tcl_GetString(objv[0])));
+ Tcl_SetErrorCode(interp, "TK", "IMAGE", "PHOTO", "COORDINATES",
+ NULL);
+ return TCL_ERROR;
+ }
+
+ /*
+ * Extract the value of the desired pixel and format it as a string.
+ */
+
+ pixelPtr = masterPtr->pix32 + (y * masterPtr->width + x) * 4;
+ channels[0] = Tcl_NewIntObj(pixelPtr[0]);
+ channels[1] = Tcl_NewIntObj(pixelPtr[1]);
+ channels[2] = Tcl_NewIntObj(pixelPtr[2]);
+ Tcl_SetObjResult(interp, Tcl_NewListObj(3, channels));
+ return TCL_OK;
+ }
+
+ case PHOTO_PUT:
+ /*
+ * photo put command - first parse the options and colors specified.
+ */
+
+ index = 2;
+ memset(&options, 0, sizeof(options));
+ options.name = NULL;
+ if (ParseSubcommandOptions(&options, interp, OPT_TO|OPT_FORMAT,
+ &index, objc, objv) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if ((options.name == NULL) || (index < objc)) {
+ Tcl_WrongNumArgs(interp, 2, objv, "data ?-option value ...?");
+ return TCL_ERROR;
+ }
+
+ if (MatchStringFormat(interp, options.name ? objv[2]:NULL,
+ options.format, &imageFormat, &imageWidth,
+ &imageHeight, &oldformat) == TCL_OK) {
+ Tcl_Obj *format, *data;
+
+ if (!(options.options & OPT_TO) || (options.toX2 < 0)) {
+ options.toX2 = options.toX + imageWidth;
+ options.toY2 = options.toY + imageHeight;
+ }
+ if (imageWidth > options.toX2 - options.toX) {
+ imageWidth = options.toX2 - options.toX;
+ }
+ if (imageHeight > options.toY2 - options.toY) {
+ imageHeight = options.toY2 - options.toY;
+ }
+ format = options.format;
+ data = objv[2];
+ if (oldformat) {
+ if (format) {
+ format = (Tcl_Obj *) Tcl_GetString(format);
+ }
+ data = (Tcl_Obj *) Tcl_GetString(data);
+ }
+ if (imageFormat->stringReadProc(interp, data, format,
+ (Tk_PhotoHandle) masterPtr, options.toX, options.toY,
+ imageWidth, imageHeight, 0, 0) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ masterPtr->flags |= IMAGE_CHANGED;
+ return TCL_OK;
+ }
+ if (options.options & OPT_FORMAT) {
+ return TCL_ERROR;
+ }
+ Tcl_ResetResult(interp);
+ if (Tcl_ListObjGetElements(interp, options.name,
+ &dataHeight, &srcObjv) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ tkwin = Tk_MainWindow(interp);
+ block.pixelPtr = NULL;
+ dataWidth = 0;
+ pixelPtr = NULL;
+ for (y = 0; y < dataHeight; ++y) {
+ if (Tcl_ListObjGetElements(interp, srcObjv[y],
+ &listObjc, &listObjv) != TCL_OK) {
+ break;
+ }
+
+ if (y == 0) {
+ if (listObjc == 0) {
+ /*
+ * Lines must be non-empty...
+ */
+
+ break;
+ }
+ dataWidth = listObjc;
+ /*
+ * Memory allocation overflow protection.
+ * May not be able to trigger/ demo / test this.
+ */
+
+ if (dataWidth > (int)((UINT_MAX/3) / dataHeight)) {
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "photo image dimensions exceed Tcl memory limits", -1));
+ Tcl_SetErrorCode(interp, "TK", "IMAGE", "PHOTO",
+ "OVERFLOW", NULL);
+ break;
+ }
+
+ pixelPtr = ckalloc(dataWidth * dataHeight * 3);
+ block.pixelPtr = pixelPtr;
+ } else if (listObjc != dataWidth) {
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "all elements of color list must have the same"
+ " number of elements", -1));
+ Tcl_SetErrorCode(interp, "TK", "IMAGE", "PHOTO",
+ "NON_RECTANGULAR", NULL);
+ break;
+ }
+
+ for (x = 0; x < dataWidth; ++x) {
+ const char *colorString = Tcl_GetString(listObjv[x]);
+ XColor color;
+ int tmpr, tmpg, tmpb;
+
+ /*
+ * We do not use Tk_GetColorFromObj() because we absolutely do
+ * not want to invoke the fallback code.
+ */
+
+ if (colorString[0] == '#') {
+ if (isxdigit(UCHAR(colorString[1])) &&
+ isxdigit(UCHAR(colorString[2])) &&
+ isxdigit(UCHAR(colorString[3]))) {
+ if (colorString[4] == '\0') {
+ /* Got #rgb */
+ sscanf(colorString+1, "%1x%1x%1x",
+ &tmpr, &tmpg, &tmpb);
+ *pixelPtr++ = tmpr * 0x11;
+ *pixelPtr++ = tmpg * 0x11;
+ *pixelPtr++ = tmpb * 0x11;
+ continue;
+ } else if (isxdigit(UCHAR(colorString[4])) &&
+ isxdigit(UCHAR(colorString[5])) &&
+ isxdigit(UCHAR(colorString[6])) &&
+ colorString[7] == '\0') {
+ /* Got #rrggbb */
+ sscanf(colorString+1, "%2x%2x%2x",
+ &tmpr, &tmpg, &tmpb);
+ *pixelPtr++ = tmpr;
+ *pixelPtr++ = tmpg;
+ *pixelPtr++ = tmpb;
+ continue;
+ }
+ }
+ }
+
+ if (!TkParseColor(Tk_Display(tkwin), Tk_Colormap(tkwin),
+ colorString, &color)) {
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "can't parse color \"%s\"", colorString));
+ Tcl_SetErrorCode(interp, "TK", "VALUE", "COLOR", NULL);
+ break;
+ }
+ *pixelPtr++ = color.red >> 8;
+ *pixelPtr++ = color.green >> 8;
+ *pixelPtr++ = color.blue >> 8;
+ }
+ if (x < dataWidth) {
+ break;
+ }
+ }
+ if (y < dataHeight || dataHeight == 0 || dataWidth == 0) {
+ if (block.pixelPtr != NULL) {
+ ckfree(block.pixelPtr);
+ }
+ if (y < dataHeight) {
+ return TCL_ERROR;
+ }
+ return TCL_OK;
+ }
+
+ /*
+ * Fill in default values for the -to option, then copy the block in
+ * using Tk_PhotoPutBlock.
+ */
+
+ if (!(options.options & OPT_TO) || (options.toX2 < 0)) {
+ options.toX2 = options.toX + dataWidth;
+ options.toY2 = options.toY + dataHeight;
+ }
+ block.width = dataWidth;
+ block.height = dataHeight;
+ block.pitch = dataWidth * 3;
+ block.pixelSize = 3;
+ block.offset[0] = 0;
+ block.offset[1] = 1;
+ block.offset[2] = 2;
+ block.offset[3] = 0;
+ result = Tk_PhotoPutBlock(interp, masterPtr, &block,
+ options.toX, options.toY, options.toX2 - options.toX,
+ options.toY2 - options.toY,
+ TK_PHOTO_COMPOSITE_SET);
+ ckfree(block.pixelPtr);
+ return result;
+
+ case PHOTO_READ: {
+ Tcl_Obj *format;
+
+ /*
+ * photo read command - first parse the options specified.
+ */
+
+ index = 2;
+ memset(&options, 0, sizeof(options));
+ options.name = NULL;
+ options.format = NULL;
+ if (ParseSubcommandOptions(&options, interp,
+ OPT_FORMAT | OPT_FROM | OPT_TO | OPT_SHRINK,
+ &index, objc, objv) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if ((options.name == NULL) || (index < objc)) {
+ Tcl_WrongNumArgs(interp, 2, objv, "fileName ?-option value ...?");
+ return TCL_ERROR;
+ }
+
+ /*
+ * Prevent file system access in safe interpreters.
+ */
+
+ if (Tcl_IsSafe(interp)) {
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "can't get image from a file in a safe interpreter", -1));
+ Tcl_SetErrorCode(interp, "TK", "SAFE", "PHOTO_FILE", NULL);
+ return TCL_ERROR;
+ }
+
+ /*
+ * Open the image file and look for a handler for it.
+ */
+
+ chan = Tcl_OpenFileChannel(interp,
+ Tcl_GetString(options.name), "r", 0);
+ if (chan == NULL) {
+ return TCL_ERROR;
+ }
+ if (Tcl_SetChannelOption(interp, chan, "-translation", "binary")
+ != TCL_OK) {
+ Tcl_Close(NULL, chan);
+ return TCL_ERROR;
+ }
+ if (Tcl_SetChannelOption(interp, chan, "-encoding", "binary")
+ != TCL_OK) {
+ Tcl_Close(NULL, chan);
+ return TCL_ERROR;
+ }
+
+ if (MatchFileFormat(interp, chan,
+ Tcl_GetString(options.name), options.format, &imageFormat,
+ &imageWidth, &imageHeight, &oldformat) != TCL_OK) {
+ Tcl_Close(NULL, chan);
+ return TCL_ERROR;
+ }
+
+ /*
+ * Check the values given for the -from option.
+ */
+
+ if ((options.fromX > imageWidth) || (options.fromY > imageHeight)
+ || (options.fromX2 > imageWidth)
+ || (options.fromY2 > imageHeight)) {
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "coordinates for -from option extend outside source image",
+ -1));
+ Tcl_SetErrorCode(interp, "TK", "IMAGE", "PHOTO", "BAD_FROM", NULL);
+ Tcl_Close(NULL, chan);
+ return TCL_ERROR;
+ }
+ if (!(options.options & OPT_FROM) || (options.fromX2 < 0)) {
+ width = imageWidth - options.fromX;
+ height = imageHeight - options.fromY;
+ } else {
+ width = options.fromX2 - options.fromX;
+ height = options.fromY2 - options.fromY;
+ }
+
+ /*
+ * If the -shrink option was specified, set the size of the image.
+ */
+
+ if (options.options & OPT_SHRINK) {
+ if (ImgPhotoSetSize(masterPtr, options.toX + width,
+ options.toY + height) != TCL_OK) {
+ Tcl_ResetResult(interp);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ TK_PHOTO_ALLOC_FAILURE_MESSAGE, -1));
+ Tcl_SetErrorCode(interp, "TK", "MALLOC", NULL);
+ return TCL_ERROR;
+ }
+ }
+
+ /*
+ * Call the handler's file read function to read the data into the
+ * image.
+ */
+
+ format = options.format;
+ if (oldformat && format) {
+ format = (Tcl_Obj *) Tcl_GetString(format);
+ }
+ result = imageFormat->fileReadProc(interp, chan,
+ Tcl_GetString(options.name),
+ format, (Tk_PhotoHandle) masterPtr, options.toX,
+ options.toY, width, height, options.fromX, options.fromY);
+ if (chan != NULL) {
+ Tcl_Close(NULL, chan);
+ }
+ return result;
+ }
+
+ case PHOTO_REDITHER:
+ if (objc != 2) {
+ Tcl_WrongNumArgs(interp, 2, objv, NULL);
+ return TCL_ERROR;
+ }
+
+ /*
+ * Call Dither if any part of the image is not correctly dithered at
+ * present.
+ */
+
+ x = masterPtr->ditherX;
+ y = masterPtr->ditherY;
+ if (masterPtr->ditherX != 0) {
+ Tk_DitherPhoto((Tk_PhotoHandle) masterPtr, x, y,
+ masterPtr->width - x, 1);
+ }
+ if (masterPtr->ditherY < masterPtr->height) {
+ x = 0;
+ Tk_DitherPhoto((Tk_PhotoHandle)masterPtr, 0,
+ masterPtr->ditherY, masterPtr->width,
+ masterPtr->height - masterPtr->ditherY);
+ }
+
+ if (y < masterPtr->height) {
+ /*
+ * Tell the core image code that part of the image has changed.
+ */
+
+ Tk_ImageChanged(masterPtr->tkMaster, x, y,
+ (masterPtr->width - x), (masterPtr->height - y),
+ masterPtr->width, masterPtr->height);
+ }
+ return TCL_OK;
+
+ case PHOTO_TRANS: {
+ static const char *const photoTransOptions[] = {
+ "get", "set", NULL
+ };
+ enum transOptions {
+ PHOTO_TRANS_GET, PHOTO_TRANS_SET
+ };
+
+ if (objc < 3) {
+ Tcl_WrongNumArgs(interp, 2, objv, "option ?arg ...?");
+ return TCL_ERROR;
+ }
+ if (Tcl_GetIndexFromObj(interp, objv[2], photoTransOptions, "option",
+ 0, &index) != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ switch ((enum transOptions) index) {
+ case PHOTO_TRANS_GET: {
+ XRectangle testBox;
+ TkRegion testRegion;
+
+ if (objc != 5) {
+ Tcl_WrongNumArgs(interp, 3, objv, "x y");
+ return TCL_ERROR;
+ }
+ if ((Tcl_GetIntFromObj(interp, objv[3], &x) != TCL_OK)
+ || (Tcl_GetIntFromObj(interp, objv[4], &y) != TCL_OK)) {
+ return TCL_ERROR;
+ }
+ if ((x < 0) || (x >= masterPtr->width)
+ || (y < 0) || (y >= masterPtr->height)) {
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "%s transparency get: coordinates out of range",
+ Tcl_GetString(objv[0])));
+ Tcl_SetErrorCode(interp, "TK", "IMAGE", "PHOTO", "COORDINATES",
+ NULL);
+ return TCL_ERROR;
+ }
+
+ testBox.x = x;
+ testBox.y = y;
+ testBox.width = 1;
+ testBox.height = 1;
+ /* What a way to do a test! */
+ testRegion = TkCreateRegion();
+ TkUnionRectWithRegion(&testBox, testRegion, testRegion);
+ TkIntersectRegion(testRegion, masterPtr->validRegion, testRegion);
+ TkClipBox(testRegion, &testBox);
+ TkDestroyRegion(testRegion);
+
+ Tcl_SetObjResult(interp, Tcl_NewBooleanObj(
+ testBox.width==0 && testBox.height==0));
+ return TCL_OK;
+ }
+
+ case PHOTO_TRANS_SET: {
+ int transFlag;
+ XRectangle setBox;
+
+ if (objc != 6) {
+ Tcl_WrongNumArgs(interp, 3, objv, "x y boolean");
+ return TCL_ERROR;
+ }
+ if ((Tcl_GetIntFromObj(interp, objv[3], &x) != TCL_OK)
+ || (Tcl_GetIntFromObj(interp, objv[4], &y) != TCL_OK)
+ || (Tcl_GetBooleanFromObj(interp, objv[5],
+ &transFlag) != TCL_OK)) {
+ return TCL_ERROR;
+ }
+ if ((x < 0) || (x >= masterPtr->width)
+ || (y < 0) || (y >= masterPtr->height)) {
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "%s transparency set: coordinates out of range",
+ Tcl_GetString(objv[0])));
+ Tcl_SetErrorCode(interp, "TK", "IMAGE", "PHOTO", "COORDINATES",
+ NULL);
+ return TCL_ERROR;
+ }
+
+ setBox.x = x;
+ setBox.y = y;
+ setBox.width = 1;
+ setBox.height = 1;
+ pixelPtr = masterPtr->pix32 + (y * masterPtr->width + x) * 4;
+
+ if (transFlag) {
+ /*
+ * Make pixel transparent.
+ */
+
+ TkRegion clearRegion = TkCreateRegion();
+
+ TkUnionRectWithRegion(&setBox, clearRegion, clearRegion);
+ TkSubtractRegion(masterPtr->validRegion, clearRegion,
+ masterPtr->validRegion);
+ TkDestroyRegion(clearRegion);
+
+ /*
+ * Set the alpha value correctly.
+ */
+
+ pixelPtr[3] = 0;
+ } else {
+ /*
+ * Make pixel opaque.
+ */
+
+ TkUnionRectWithRegion(&setBox, masterPtr->validRegion,
+ masterPtr->validRegion);
+ pixelPtr[3] = 255;
+ }
+
+ /*
+ * Inform the generic image code that the image
+ * has (potentially) changed.
+ */
+
+ Tk_ImageChanged(masterPtr->tkMaster, x, y, 1, 1,
+ masterPtr->width, masterPtr->height);
+ masterPtr->flags &= ~IMAGE_CHANGED;
+ return TCL_OK;
+ }
+
+ }
+ Tcl_Panic("unexpected fallthrough");
+ }
+
+ case PHOTO_WRITE: {
+ char *data;
+ const char *fmtString;
+ Tcl_Obj *format;
+ int usedExt;
+
+ /*
+ * Prevent file system access in safe interpreters.
+ */
+
+ if (Tcl_IsSafe(interp)) {
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "can't write image to a file in a safe interpreter", -1));
+ Tcl_SetErrorCode(interp, "TK", "SAFE", "PHOTO_FILE", NULL);
+ return TCL_ERROR;
+ }
+
+ /*
+ * photo write command - first parse and check any options given.
+ */
+
+ index = 2;
+ memset(&options, 0, sizeof(options));
+ options.name = NULL;
+ options.format = NULL;
+ if (ParseSubcommandOptions(&options, interp,
+ OPT_FORMAT | OPT_FROM | OPT_GRAYSCALE | OPT_BACKGROUND,
+ &index, objc, objv) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if ((options.name == NULL) || (index < objc)) {
+ Tcl_WrongNumArgs(interp, 2, objv, "fileName ?-option value ...?");
+ return TCL_ERROR;
+ }
+ if ((options.fromX > masterPtr->width)
+ || (options.fromY > masterPtr->height)
+ || (options.fromX2 > masterPtr->width)
+ || (options.fromY2 > masterPtr->height)) {
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "coordinates for -from option extend outside image", -1));
+ Tcl_SetErrorCode(interp, "TK", "IMAGE", "PHOTO", "BAD_FROM", NULL);
+ return TCL_ERROR;
+ }
+
+ /*
+ * Fill in default values for unspecified parameters. Note that a
+ * missing -format flag results in us having a guess from the file
+ * extension. [Bug 2983824]
+ */
+
+ if (!(options.options & OPT_FROM) || (options.fromX2 < 0)) {
+ options.fromX2 = masterPtr->width;
+ options.fromY2 = masterPtr->height;
+ }
+ if (options.format == NULL) {
+ fmtString = GetExtension(Tcl_GetString(options.name));
+ usedExt = (fmtString != NULL);
+ } else {
+ fmtString = Tcl_GetString(options.format);
+ usedExt = 0;
+ }
+
+ /*
+ * Search for an appropriate image file format handler, and give an
+ * error if none is found.
+ */
+
+ matched = 0;
+ redoFormatLookup:
+ for (imageFormat = tsdPtr->formatList; imageFormat != NULL;
+ imageFormat = imageFormat->nextPtr) {
+ if ((fmtString == NULL)
+ || (strncasecmp(fmtString, 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 ((fmtString == NULL)
+ || (strncasecmp(fmtString, imageFormat->name,
+ strlen(imageFormat->name)) == 0)) {
+ matched = 1;
+ if (imageFormat->fileWriteProc != NULL) {
+ break;
+ }
+ }
+ }
+ }
+ if (usedExt && !matched) {
+ /*
+ * If we didn't find one and we're using file extensions as the
+ * basis for the guessing, go back and look again without
+ * prejudice. Supports old broken code.
+ */
+
+ usedExt = 0;
+ fmtString = NULL;
+ goto redoFormatLookup;
+ }
+ if (imageFormat == NULL) {
+ if (fmtString == NULL) {
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "no available image file format has file writing"
+ " capability", -1));
+ } else if (!matched) {
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "image file format \"%s\" is unknown", fmtString));
+ } else {
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "image file format \"%s\" has no file writing capability",
+ fmtString));
+ }
+ Tcl_SetErrorCode(interp, "TK", "LOOKUP", "PHOTO_FORMAT",
+ fmtString, NULL);
+ return TCL_ERROR;
+ }
+
+ /*
+ * Call the handler's file write function to write out the image.
+ */
+
+ data = ImgGetPhoto(masterPtr, &block, &options);
+ format = options.format;
+ if (oldformat && format) {
+ format = (Tcl_Obj *) Tcl_GetString(options.format);
+ }
+ result = imageFormat->fileWriteProc(interp,
+ Tcl_GetString(options.name), format, &block);
+ if (options.background) {
+ Tk_FreeColor(options.background);
+ }
+ if (data) {
+ ckfree(data);
+ }
+ return result;
+ }
+
+ }
+ Tcl_Panic("unexpected fallthrough");
+ return TCL_ERROR; /* NOT REACHED */
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * GetExtension --
+ *
+ * Return the extension part of a path, or NULL if there is no extension.
+ * The returned string will be a substring of the argument string, so
+ * should not be ckfree()d directly. No side effects.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static const char *
+GetExtension(
+ const char *path)
+{
+ char c;
+ const char *extension = NULL;
+
+ for (; (c=*path++) != '\0' ;) {
+ if (c == '.') {
+ extension = path;
+ }
+ }
+ if (extension != NULL && extension[0] == '\0') {
+ extension = NULL;
+ }
+ return extension;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ParseSubcommandOptions --
+ *
+ * This function is invoked to process one of the options which may be
+ * specified for the photo image subcommands, namely, -from, -to, -zoom,
+ * -subsample, -format, -shrink, and -compositingrule.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * Fields in *optPtr get filled in.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+ParseSubcommandOptions(
+ struct SubcommandOptions *optPtr,
+ /* Information about the options specified and
+ * the values given is returned here. */
+ Tcl_Interp *interp, /* Interpreter to use for reporting errors. */
+ int allowedOptions, /* Indicates which options are valid for the
+ * current command. */
+ int *optIndexPtr, /* Points to a variable containing the current
+ * index in objv; this variable is updated by
+ * this function. */
+ int objc, /* Number of arguments in objv[]. */
+ Tcl_Obj *const objv[]) /* Arguments to be parsed. */
+{
+ static const char *const compositingRules[] = {
+ "overlay", "set", /* Note that these must match the
+ * TK_PHOTO_COMPOSITE_* constants. */
+ NULL
+ };
+ int index, c, bit, currentBit, length;
+ int values[4], numValues, maxValues, argIndex;
+ const char *option, *expandedOption, *needed;
+ const char *const *listPtr;
+ Tcl_Obj *msgObj;
+
+ for (index = *optIndexPtr; index < objc; *optIndexPtr = ++index) {
+ /*
+ * We can have one value specified without an option; it goes into
+ * optPtr->name.
+ */
+
+ expandedOption = option = Tcl_GetStringFromObj(objv[index], &length);
+ if (option[0] != '-') {
+ if (optPtr->name == NULL) {
+ optPtr->name = objv[index];
+ continue;
+ }
+ break;
+ }
+
+ /*
+ * Work out which option this is.
+ */
+
+ c = option[0];
+ bit = 0;
+ currentBit = 1;
+ for (listPtr = optionNames; *listPtr != NULL; ++listPtr) {
+ if ((c == *listPtr[0])
+ && (strncmp(option, *listPtr, (size_t) length) == 0)) {
+ expandedOption = *listPtr;
+ if (bit != 0) {
+ goto unknownOrAmbiguousOption;
+ }
+ bit = currentBit;
+ }
+ currentBit <<= 1;
+ }
+
+ /*
+ * If this option is not recognized and allowed, put an error message
+ * in the interpreter and return.
+ */
+
+ if (!(allowedOptions & bit)) {
+ goto unknownOrAmbiguousOption;
+ }
+
+ /*
+ * For the -from, -to, -zoom and -subsample options, parse the values
+ * given. Report an error if too few or too many values are given.
+ */
+
+ if (bit == OPT_BACKGROUND) {
+ /*
+ * The -background option takes a single XColor value.
+ */
+
+ if (index + 1 >= objc) {
+ goto oneValueRequired;
+ }
+ *optIndexPtr = ++index;
+ optPtr->background = Tk_GetColor(interp, Tk_MainWindow(interp),
+ Tk_GetUid(Tcl_GetString(objv[index])));
+ if (!optPtr->background) {
+ return TCL_ERROR;
+ }
+ } else if (bit == OPT_FORMAT) {
+ /*
+ * The -format option takes a single string value. Note that
+ * parsing this is outside the scope of this function.
+ */
+
+ if (index + 1 >= objc) {
+ goto oneValueRequired;
+ }
+ *optIndexPtr = ++index;
+ optPtr->format = objv[index];
+ } else if (bit == OPT_COMPOSITE) {
+ /*
+ * The -compositingrule option takes a single value from a
+ * well-known set.
+ */
+
+ if (index + 1 >= objc) {
+ goto oneValueRequired;
+ }
+ index++;
+ if (Tcl_GetIndexFromObj(interp, objv[index], compositingRules,
+ "compositing rule", 0, &optPtr->compositingRule)
+ != TCL_OK) {
+ return TCL_ERROR;
+ }
+ *optIndexPtr = index;
+ } else if ((bit != OPT_SHRINK) && (bit != OPT_GRAYSCALE)) {
+ const char *val;
+
+ maxValues = ((bit == OPT_FROM) || (bit == OPT_TO)) ? 4 : 2;
+ argIndex = index + 1;
+ for (numValues = 0; numValues < maxValues; ++numValues) {
+ if (argIndex >= objc) {
+ break;
+ }
+ val = Tcl_GetString(objv[argIndex]);
+ if ((argIndex < objc) && (isdigit(UCHAR(val[0]))
+ || ((val[0] == '-') && isdigit(UCHAR(val[1]))))) {
+ if (Tcl_GetInt(interp, val, &values[numValues])
+ != TCL_OK) {
+ return TCL_ERROR;
+ }
+ } else {
+ break;
+ }
+ argIndex++;
+ }
+
+ if (numValues == 0) {
+ goto manyValuesRequired;
+ }
+ *optIndexPtr = (index += numValues);
+
+ /*
+ * Y values default to the corresponding X value if not specified.
+ */
+
+ if (numValues == 1) {
+ values[1] = values[0];
+ }
+ if (numValues == 3) {
+ values[3] = values[2];
+ }
+
+ /*
+ * Check the values given and put them in the appropriate field of
+ * the SubcommandOptions structure.
+ */
+
+ switch (bit) {
+ case OPT_FROM:
+ if ((values[0] < 0) || (values[1] < 0) || ((numValues > 2)
+ && ((values[2] < 0) || (values[3] < 0)))) {
+ needed = "non-negative";
+ goto numberOutOfRange;
+ }
+ if (numValues <= 2) {
+ optPtr->fromX = values[0];
+ optPtr->fromY = values[1];
+ optPtr->fromX2 = -1;
+ optPtr->fromY2 = -1;
+ } else {
+ optPtr->fromX = MIN(values[0], values[2]);
+ optPtr->fromY = MIN(values[1], values[3]);
+ optPtr->fromX2 = MAX(values[0], values[2]);
+ optPtr->fromY2 = MAX(values[1], values[3]);
+ }
+ break;
+ case OPT_SUBSAMPLE:
+ optPtr->subsampleX = values[0];
+ optPtr->subsampleY = values[1];
+ break;
+ case OPT_TO:
+ if ((values[0] < 0) || (values[1] < 0) || ((numValues > 2)
+ && ((values[2] < 0) || (values[3] < 0)))) {
+ needed = "non-negative";
+ goto numberOutOfRange;
+ }
+ if (numValues <= 2) {
+ optPtr->toX = values[0];
+ optPtr->toY = values[1];
+ optPtr->toX2 = -1;
+ optPtr->toY2 = -1;
+ } else {
+ optPtr->toX = MIN(values[0], values[2]);
+ optPtr->toY = MIN(values[1], values[3]);
+ optPtr->toX2 = MAX(values[0], values[2]);
+ optPtr->toY2 = MAX(values[1], values[3]);
+ }
+ break;
+ case OPT_ZOOM:
+ if ((values[0] <= 0) || (values[1] <= 0)) {
+ needed = "positive";
+ goto numberOutOfRange;
+ }
+ optPtr->zoomX = values[0];
+ optPtr->zoomY = values[1];
+ break;
+ }
+ }
+
+ /*
+ * Remember that we saw this option.
+ */
+
+ optPtr->options |= bit;
+ }
+ return TCL_OK;
+
+ /*
+ * Exception generation.
+ */
+
+ oneValueRequired:
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "the \"%s\" option requires a value", expandedOption));
+ Tcl_SetErrorCode(interp, "TK", "IMAGE", "PHOTO", "MISSING_VALUE", NULL);
+ return TCL_ERROR;
+
+ manyValuesRequired:
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "the \"%s\" option requires one %s integer values",
+ expandedOption, (maxValues == 2) ? "or two": "to four"));
+ Tcl_SetErrorCode(interp, "TK", "IMAGE", "PHOTO", "MISSING_VALUE", NULL);
+ return TCL_ERROR;
+
+ numberOutOfRange:
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "value(s) for the %s option must be %s", expandedOption, needed));
+ Tcl_SetErrorCode(interp, "TK", "IMAGE", "PHOTO", "BAD_VALUE", NULL);
+ return TCL_ERROR;
+
+ unknownOrAmbiguousOption:
+ msgObj = Tcl_ObjPrintf("unrecognized option \"%s\": must be ", option);
+ bit = 1;
+ for (listPtr = optionNames; *listPtr != NULL; ++listPtr) {
+ if (allowedOptions & bit) {
+ if (allowedOptions & (bit - 1)) {
+ if (allowedOptions & ~((bit << 1) - 1)) {
+ Tcl_AppendToObj(msgObj, ", ", -1);
+ } else {
+ Tcl_AppendToObj(msgObj, ", or ", -1);
+ }
+ }
+ Tcl_AppendToObj(msgObj, *listPtr, -1);
+ }
+ bit <<= 1;
+ }
+ Tcl_SetObjResult(interp, msgObj);
+ Tcl_SetErrorCode(interp, "TK", "IMAGE", "PHOTO", "BAD_OPTION", NULL);
+ return TCL_ERROR;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ImgPhotoConfigureMaster --
+ *
+ * This function is called when a photo image is created or reconfigured.
+ * It processes configuration options and resets any instances of the
+ * image.
+ *
+ * Results:
+ * A standard Tcl return value. If TCL_ERROR is returned then an error
+ * message is left in the masterPtr->interp's result.
+ *
+ * Side effects:
+ * Existing instances of the image will be redisplayed to match the new
+ * configuration options.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+ImgPhotoConfigureMaster(
+ Tcl_Interp *interp, /* Interpreter to use for reporting errors. */
+ PhotoMaster *masterPtr, /* Pointer to data structure describing
+ * overall photo image to (re)configure. */
+ int objc, /* Number of entries in objv. */
+ Tcl_Obj *const objv[], /* Pairs of configuration options for image. */
+ int flags) /* Flags to pass to Tk_ConfigureWidget, such
+ * as TK_CONFIG_ARGV_ONLY. */
+{
+ PhotoInstance *instancePtr;
+ const char *oldFileString, *oldPaletteString;
+ Tcl_Obj *oldData, *data = NULL, *oldFormat, *format = NULL;
+ Tcl_Obj *tempdata, *tempformat;
+ int length, i, j, result, imageWidth, imageHeight, oldformat;
+ double oldGamma;
+ Tcl_Channel chan;
+ Tk_PhotoImageFormat *imageFormat;
+ const char **args;
+
+ args = 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 {
+ ckfree(args);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "value for \"-data\" missing", -1));
+ Tcl_SetErrorCode(interp, "TK", "IMAGE", "PHOTO",
+ "MISSING_VALUE", NULL);
+ return TCL_ERROR;
+ }
+ } else if ((args[j][1] == 'f') &&
+ !strncmp(args[j], "-format", (size_t) length)) {
+ if (++i < objc) {
+ format = objv[i];
+ j--;
+ } else {
+ ckfree(args);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "value for \"-format\" missing", -1));
+ Tcl_SetErrorCode(interp, "TK", "IMAGE", "PHOTO",
+ "MISSING_VALUE", NULL);
+ return TCL_ERROR;
+ }
+ }
+ }
+ }
+
+ /*
+ * Save the current values for fileString and dataString, so we can tell
+ * if the user specifies them anew. IMPORTANT: if the format changes we
+ * have to interpret "-file" and "-data" again as well! It might be that
+ * the format string influences how "-data" or "-file" is interpreted.
+ */
+
+ oldFileString = masterPtr->fileString;
+ if (oldFileString == NULL) {
+ oldData = masterPtr->dataString;
+ if (oldData != NULL) {
+ Tcl_IncrRefCount(oldData);
+ }
+ } else {
+ oldData = NULL;
+ }
+ oldFormat = masterPtr->format;
+ if (oldFormat != NULL) {
+ Tcl_IncrRefCount(oldFormat);
+ }
+ oldPaletteString = masterPtr->palette;
+ oldGamma = masterPtr->gamma;
+
+ /*
+ * Process the configuration options specified.
+ */
+
+ if (Tk_ConfigureWidget(interp, Tk_MainWindow(interp), configSpecs,
+ j, args, (char *) masterPtr, flags) != TCL_OK) {
+ ckfree(args);
+ goto errorExit;
+ }
+ ckfree(args);
+
+ /*
+ * Regard the empty string for -file, -data or -format as the null value.
+ */
+
+ if ((masterPtr->fileString != NULL) && (masterPtr->fileString[0] == 0)) {
+ ckfree(masterPtr->fileString);
+ masterPtr->fileString = NULL;
+ }
+ if (data) {
+ /*
+ * Force into ByteArray format, which most (all) image handlers will
+ * use anyway. Empty length means ignore the -data option.
+ */
+
+ (void) Tcl_GetByteArrayFromObj(data, &length);
+ if (length) {
+ Tcl_IncrRefCount(data);
+ } else {
+ data = NULL;
+ }
+ if (masterPtr->dataString) {
+ Tcl_DecrRefCount(masterPtr->dataString);
+ }
+ masterPtr->dataString = data;
+ }
+ if (format) {
+ /*
+ * Stringify to ignore -format "". It may come in as a list or other
+ * object.
+ */
+
+ (void) Tcl_GetStringFromObj(format, &length);
+ if (length) {
+ Tcl_IncrRefCount(format);
+ } else {
+ format = NULL;
+ }
+ if (masterPtr->format) {
+ Tcl_DecrRefCount(masterPtr->format);
+ }
+ masterPtr->format = format;
+ }
+ /*
+ * Set the image to the user-requested size, if any, and make sure storage
+ * is correctly allocated for this image.
+ */
+
+ if (ImgPhotoSetSize(masterPtr, masterPtr->width,
+ masterPtr->height) != TCL_OK) {
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ TK_PHOTO_ALLOC_FAILURE_MESSAGE, -1));
+ Tcl_SetErrorCode(interp, "TK", "MALLOC", NULL);
+ goto errorExit;
+ }
+
+ /*
+ * Read in the image from the file or string if the user has specified the
+ * -file or -data option.
+ */
+
+ if ((masterPtr->fileString != NULL)
+ && ((masterPtr->fileString != oldFileString)
+ || (masterPtr->format != oldFormat))) {
+ /*
+ * Prevent file system access in a safe interpreter.
+ */
+
+ if (Tcl_IsSafe(interp)) {
+ Tcl_ResetResult(interp);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "can't get image from a file in a safe interpreter",
+ -1));
+ Tcl_SetErrorCode(interp, "TK", "SAFE", "PHOTO_FILE", NULL);
+ goto errorExit;
+ }
+
+ chan = Tcl_OpenFileChannel(interp, masterPtr->fileString, "r", 0);
+ if (chan == NULL) {
+ goto errorExit;
+ }
+
+ /*
+ * -translation binary also sets -encoding binary
+ */
+
+ if ((Tcl_SetChannelOption(interp, chan,
+ "-translation", "binary") != TCL_OK) ||
+ (MatchFileFormat(interp, chan, masterPtr->fileString,
+ masterPtr->format, &imageFormat, &imageWidth,
+ &imageHeight, &oldformat) != TCL_OK)) {
+ Tcl_Close(NULL, chan);
+ goto errorExit;
+ }
+ result = ImgPhotoSetSize(masterPtr, imageWidth, imageHeight);
+ if (result != TCL_OK) {
+ Tcl_Close(NULL, chan);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ TK_PHOTO_ALLOC_FAILURE_MESSAGE, -1));
+ Tcl_SetErrorCode(interp, "TK", "MALLOC", NULL);
+ goto errorExit;
+ }
+ tempformat = masterPtr->format;
+ if (oldformat && tempformat) {
+ tempformat = (Tcl_Obj *) Tcl_GetString(tempformat);
+ }
+ result = imageFormat->fileReadProc(interp, chan,
+ masterPtr->fileString, tempformat, (Tk_PhotoHandle) masterPtr,
+ 0, 0, imageWidth, imageHeight, 0, 0);
+ Tcl_Close(NULL, chan);
+ if (result != TCL_OK) {
+ goto errorExit;
+ }
+
+ Tcl_ResetResult(interp);
+ masterPtr->flags |= IMAGE_CHANGED;
+ }
+
+ if ((masterPtr->fileString == NULL) && (masterPtr->dataString != NULL)
+ && ((masterPtr->dataString != oldData)
+ || (masterPtr->format != oldFormat))) {
+
+ if (MatchStringFormat(interp, masterPtr->dataString,
+ masterPtr->format, &imageFormat, &imageWidth,
+ &imageHeight, &oldformat) != TCL_OK) {
+ goto errorExit;
+ }
+ if (ImgPhotoSetSize(masterPtr, imageWidth, imageHeight) != TCL_OK) {
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ TK_PHOTO_ALLOC_FAILURE_MESSAGE, -1));
+ Tcl_SetErrorCode(interp, "TK", "MALLOC", NULL);
+ goto errorExit;
+ }
+ tempformat = masterPtr->format;
+ tempdata = masterPtr->dataString;
+ if (oldformat) {
+ if (tempformat) {
+ tempformat = (Tcl_Obj *) Tcl_GetString(tempformat);
+ }
+ tempdata = (Tcl_Obj *) Tcl_GetString(tempdata);
+ }
+ if (imageFormat->stringReadProc(interp, tempdata, tempformat,
+ (Tk_PhotoHandle) masterPtr, 0, 0, imageWidth, imageHeight,
+ 0, 0) != TCL_OK) {
+ goto errorExit;
+ }
+
+ Tcl_ResetResult(interp);
+ masterPtr->flags |= IMAGE_CHANGED;
+ }
+
+ /*
+ * Enforce a reasonable value for gamma.
+ */
+
+ if (masterPtr->gamma <= 0) {
+ masterPtr->gamma = 1.0;
+ }
+
+ if ((masterPtr->gamma != oldGamma)
+ || (masterPtr->palette != oldPaletteString)) {
+ masterPtr->flags |= IMAGE_CHANGED;
+ }
+
+ /*
+ * Cycle through all of the instances of this image, regenerating the
+ * information for each instance. Then force the image to be redisplayed
+ * everywhere that it is used.
+ */
+
+ for (instancePtr = masterPtr->instancePtr; instancePtr != NULL;
+ instancePtr = instancePtr->nextPtr) {
+ TkImgPhotoConfigureInstance(instancePtr);
+ }
+
+ /*
+ * Inform the generic image code that the image has (potentially) changed.
+ */
+
+ Tk_ImageChanged(masterPtr->tkMaster, 0, 0, masterPtr->width,
+ masterPtr->height, masterPtr->width, masterPtr->height);
+ masterPtr->flags &= ~IMAGE_CHANGED;
+
+ if (oldData != NULL) {
+ Tcl_DecrRefCount(oldData);
+ }
+ if (oldFormat != NULL) {
+ Tcl_DecrRefCount(oldFormat);
+ }
+
+ ToggleComplexAlphaIfNeeded(masterPtr);
+
+ return TCL_OK;
+
+ errorExit:
+ if (oldData != NULL) {
+ Tcl_DecrRefCount(oldData);
+ }
+ if (oldFormat != NULL) {
+ Tcl_DecrRefCount(oldFormat);
+ }
+ return TCL_ERROR;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ToggleComplexAlphaIfNeeded --
+ *
+ * This function is called when an image is modified to check if any
+ * partially transparent pixels exist, which requires blending instead of
+ * straight copy.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * (Re)sets COMPLEX_ALPHA flag of master.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+ToggleComplexAlphaIfNeeded(
+ PhotoMaster *mPtr)
+{
+ size_t len = (size_t)MAX(mPtr->userWidth, mPtr->width) *
+ (size_t)MAX(mPtr->userHeight, mPtr->height) * 4;
+ unsigned char *c = mPtr->pix32;
+ unsigned char *end = c + len;
+
+ /*
+ * Set the COMPLEX_ALPHA flag if we have an image with partially
+ * transparent bits.
+ */
+
+ mPtr->flags &= ~COMPLEX_ALPHA;
+ if (c == NULL) {
+ return 0;
+ }
+ c += 3; /* Start at first alpha byte. */
+ for (; c < end; c += 4) {
+ if (*c && *c != 255) {
+ mPtr->flags |= COMPLEX_ALPHA;
+ break;
+ }
+ }
+ return (mPtr->flags & COMPLEX_ALPHA);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ImgPhotoDelete --
+ *
+ * This function is called by the image code to delete the master
+ * structure for an image.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Resources associated with the image get freed.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+ImgPhotoDelete(
+ ClientData masterData) /* Pointer to PhotoMaster structure for image.
+ * Must not have any more instances. */
+{
+ PhotoMaster *masterPtr = masterData;
+ PhotoInstance *instancePtr;
+
+ while ((instancePtr = masterPtr->instancePtr) != NULL) {
+ if (instancePtr->refCount > 0) {
+ Tcl_Panic("tried to delete photo image when instances still exist");
+ }
+ Tcl_CancelIdleCall(TkImgDisposeInstance, instancePtr);
+ TkImgDisposeInstance(instancePtr);
+ }
+ masterPtr->tkMaster = NULL;
+ if (masterPtr->imageCmd != NULL) {
+ Tcl_DeleteCommandFromToken(masterPtr->interp, masterPtr->imageCmd);
+ }
+ if (masterPtr->pix32 != NULL) {
+ ckfree(masterPtr->pix32);
+ }
+ if (masterPtr->validRegion != NULL) {
+ TkDestroyRegion(masterPtr->validRegion);
+ }
+ if (masterPtr->dataString != NULL) {
+ Tcl_DecrRefCount(masterPtr->dataString);
+ }
+ if (masterPtr->format != NULL) {
+ Tcl_DecrRefCount(masterPtr->format);
+ }
+ Tk_FreeOptions(configSpecs, (char *) masterPtr, NULL, 0);
+ ckfree(masterPtr);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ImgPhotoCmdDeletedProc --
+ *
+ * This function is invoked when the image command for an image is
+ * deleted. It deletes the image.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The image is deleted.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+ImgPhotoCmdDeletedProc(
+ ClientData clientData) /* Pointer to PhotoMaster structure for
+ * image. */
+{
+ PhotoMaster *masterPtr = clientData;
+
+ masterPtr->imageCmd = NULL;
+ if (masterPtr->tkMaster != NULL) {
+ Tk_DeleteImage(masterPtr->interp, Tk_NameOfImage(masterPtr->tkMaster));
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ImgPhotoSetSize --
+ *
+ * This function reallocates the image storage and instance pixmaps for a
+ * photo image, as necessary, to change the image's size to `width' x
+ * `height' pixels.
+ *
+ * Results:
+ * TCL_OK if successful, TCL_ERROR if failure occurred (currently just
+ * with memory allocation.)
+ *
+ * Side effects:
+ * Storage gets reallocated, for the master and all its instances.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+ImgPhotoSetSize(
+ PhotoMaster *masterPtr,
+ int width, int height)
+{
+ unsigned char *newPix32 = NULL;
+ int h, offset, pitch;
+ unsigned char *srcPtr, *destPtr;
+ XRectangle validBox, clipBox;
+ TkRegion clipRegion;
+ PhotoInstance *instancePtr;
+
+ if (masterPtr->userWidth > 0) {
+ width = masterPtr->userWidth;
+ }
+ if (masterPtr->userHeight > 0) {
+ height = masterPtr->userHeight;
+ }
+
+ if (width > INT_MAX / 4) {
+ /* Pitch overflows int */
+ return TCL_ERROR;
+ }
+ pitch = width * 4;
+
+ /*
+ * Test if we're going to (re)allocate the main buffer now, so that any
+ * failures will leave the photo unchanged.
+ */
+
+ if ((width != masterPtr->width) || (height != masterPtr->height)
+ || (masterPtr->pix32 == NULL)) {
+ unsigned newPixSize;
+
+ if (pitch && height > (int)(UINT_MAX / pitch)) {
+ return TCL_ERROR;
+ }
+ newPixSize = height * pitch;
+
+ /*
+ * Some mallocs() really hate allocating zero bytes. [Bug 619544]
+ */
+
+ if (newPixSize == 0) {
+ newPix32 = NULL;
+ } else {
+ newPix32 = attemptckalloc(newPixSize);
+ if (newPix32 == NULL) {
+ return TCL_ERROR;
+ }
+ }
+ }
+
+ /*
+ * We have to trim the valid region if it is currently larger than the new
+ * image size.
+ */
+
+ TkClipBox(masterPtr->validRegion, &validBox);
+ if ((validBox.x + validBox.width > width)
+ || (validBox.y + validBox.height > height)) {
+ clipBox.x = 0;
+ clipBox.y = 0;
+ clipBox.width = width;
+ clipBox.height = height;
+ clipRegion = TkCreateRegion();
+ TkUnionRectWithRegion(&clipBox, clipRegion, clipRegion);
+ TkIntersectRegion(masterPtr->validRegion, clipRegion,
+ masterPtr->validRegion);
+ TkDestroyRegion(clipRegion);
+ TkClipBox(masterPtr->validRegion, &validBox);
+ }
+
+ /*
+ * Use the reallocated storage (allocation above) for the 32-bit image and
+ * copy over valid regions. Note that this test is true precisely when the
+ * allocation has already been done.
+ */
+
+ if (newPix32 != NULL) {
+ /*
+ * Zero the new array. The dithering code shouldn't read the areas
+ * outside validBox, but they might be copied to another photo image
+ * or written to a file.
+ */
+
+ if ((masterPtr->pix32 != NULL)
+ && ((width == masterPtr->width) || (width == validBox.width))) {
+ if (validBox.y > 0) {
+ memset(newPix32, 0, ((size_t) validBox.y * pitch));
+ }
+ h = validBox.y + validBox.height;
+ if (h < height) {
+ memset(newPix32 + h*pitch, 0, ((size_t) (height - h) * pitch));
+ }
+ } else {
+ memset(newPix32, 0, ((size_t)height * pitch));
+ }
+
+ if (masterPtr->pix32 != NULL) {
+ /*
+ * Copy the common area over to the new array array and free the
+ * old array.
+ */
+
+ if (width == masterPtr->width) {
+
+ /*
+ * The region to be copied is contiguous.
+ */
+
+ offset = validBox.y * pitch;
+ memcpy(newPix32 + offset, masterPtr->pix32 + offset,
+ ((size_t)validBox.height * pitch));
+
+ } else if ((validBox.width > 0) && (validBox.height > 0)) {
+ /*
+ * Area to be copied is not contiguous - copy line by line.
+ */
+
+ destPtr = newPix32 + (validBox.y * width + validBox.x) * 4;
+ srcPtr = masterPtr->pix32 + (validBox.y * masterPtr->width
+ + validBox.x) * 4;
+ for (h = validBox.height; h > 0; h--) {
+ memcpy(destPtr, srcPtr, ((size_t)validBox.width * 4));
+ destPtr += width * 4;
+ srcPtr += masterPtr->width * 4;
+ }
+ }
+
+ ckfree(masterPtr->pix32);
+ }
+
+ masterPtr->pix32 = newPix32;
+ masterPtr->width = width;
+ masterPtr->height = height;
+
+ /*
+ * Dithering will be correct up to the end of the last pre-existing
+ * complete scanline.
+ */
+
+ if ((validBox.x > 0) || (validBox.y > 0)) {
+ masterPtr->ditherX = 0;
+ masterPtr->ditherY = 0;
+ } else if (validBox.width == width) {
+ if ((int) validBox.height < masterPtr->ditherY) {
+ masterPtr->ditherX = 0;
+ masterPtr->ditherY = validBox.height;
+ }
+ } else if ((masterPtr->ditherY > 0)
+ || ((int) validBox.width < masterPtr->ditherX)) {
+ masterPtr->ditherX = validBox.width;
+ masterPtr->ditherY = 0;
+ }
+ }
+
+ ToggleComplexAlphaIfNeeded(masterPtr);
+
+ /*
+ * Now adjust the sizes of the pixmaps for all of the instances.
+ */
+
+ for (instancePtr = masterPtr->instancePtr; instancePtr != NULL;
+ instancePtr = instancePtr->nextPtr) {
+ TkImgPhotoInstanceSetSize(instancePtr);
+ }
+
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * MatchFileFormat --
+ *
+ * This function is called to find a photo image file format handler
+ * which can parse the image data in the given file. If a user-specified
+ * format string is provided, only handlers whose names match a prefix of
+ * the format string are tried.
+ *
+ * Results:
+ * A standard TCL return value. If the return value is TCL_OK, a pointer
+ * to the image format record is returned in *imageFormatPtr, and the
+ * width and height of the image are returned in *widthPtr and
+ * *heightPtr.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+MatchFileFormat(
+ Tcl_Interp *interp, /* Interpreter to use for reporting errors. */
+ Tcl_Channel chan, /* The image file, open for reading. */
+ const char *fileName, /* The name of the image file. */
+ Tcl_Obj *formatObj, /* User-specified format string, or NULL. */
+ Tk_PhotoImageFormat **imageFormatPtr,
+ /* A pointer to the photo image format record
+ * is returned here. */
+ int *widthPtr, int *heightPtr,
+ /* The dimensions of the image are returned
+ * here. */
+ int *oldformat) /* Returns 1 if the old image API is used. */
+{
+ int matched = 0, useoldformat = 0;
+ Tk_PhotoImageFormat *formatPtr;
+ ThreadSpecificData *tsdPtr =
+ Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
+ const char *formatString = NULL;
+
+ if (formatObj) {
+ formatString = Tcl_GetString(formatObj);
+ }
+
+ /*
+ * Scan through the table of file format handlers to find one which can
+ * handle the image.
+ */
+
+ for (formatPtr = tsdPtr->formatList; formatPtr != NULL;
+ formatPtr = formatPtr->nextPtr) {
+ if (formatObj != NULL) {
+ if (strncasecmp(formatString,
+ formatPtr->name, strlen(formatPtr->name)) != 0) {
+ continue;
+ }
+ matched = 1;
+ if (formatPtr->fileMatchProc == NULL) {
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "-file option isn't supported for %s images",
+ formatString));
+ Tcl_SetErrorCode(interp, "TK", "IMAGE", "PHOTO",
+ "NOT_FILE_FORMAT", NULL);
+ return TCL_ERROR;
+ }
+ }
+ if (formatPtr->fileMatchProc != NULL) {
+ (void) Tcl_Seek(chan, Tcl_LongAsWide(0L), SEEK_SET);
+
+ if (formatPtr->fileMatchProc(chan, fileName, formatObj,
+ widthPtr, heightPtr, interp)) {
+ if (*widthPtr < 1) {
+ *widthPtr = 1;
+ }
+ if (*heightPtr < 1) {
+ *heightPtr = 1;
+ }
+ break;
+ }
+ }
+ }
+ if (formatPtr == NULL) {
+ useoldformat = 1;
+ for (formatPtr = tsdPtr->oldFormatList; formatPtr != NULL;
+ formatPtr = formatPtr->nextPtr) {
+ if (formatString != NULL) {
+ if (strncasecmp(formatString,
+ formatPtr->name, strlen(formatPtr->name)) != 0) {
+ continue;
+ }
+ matched = 1;
+ if (formatPtr->fileMatchProc == NULL) {
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "-file option isn't supported for %s images",
+ formatString));
+ Tcl_SetErrorCode(interp, "TK", "IMAGE", "PHOTO",
+ "NOT_FILE_FORMAT", NULL);
+ return TCL_ERROR;
+ }
+ }
+ if (formatPtr->fileMatchProc != NULL) {
+ (void) Tcl_Seek(chan, Tcl_LongAsWide(0L), SEEK_SET);
+ if (formatPtr->fileMatchProc(chan, fileName, (Tcl_Obj *)
+ formatString, widthPtr, heightPtr, interp)) {
+ if (*widthPtr < 1) {
+ *widthPtr = 1;
+ }
+ if (*heightPtr < 1) {
+ *heightPtr = 1;
+ }
+ break;
+ }
+ }
+ }
+ }
+
+ if (formatPtr == NULL) {
+ if ((formatObj != NULL) && !matched) {
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "image file format \"%s\" is not supported",
+ formatString));
+ Tcl_SetErrorCode(interp, "TK", "LOOKUP", "PHOTO_FORMAT",
+ formatString, NULL);
+ } else {
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "couldn't recognize data in image file \"%s\"",
+ fileName));
+ Tcl_SetErrorCode(interp, "TK", "PHOTO", "IMAGE",
+ "UNRECOGNIZED_DATA", NULL);
+ }
+ return TCL_ERROR;
+ }
+
+ *imageFormatPtr = formatPtr;
+ *oldformat = useoldformat;
+ (void) Tcl_Seek(chan, Tcl_LongAsWide(0L), SEEK_SET);
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * MatchStringFormat --
+ *
+ * This function is called to find a photo image file format handler
+ * which can parse the image data in the given string. If a
+ * user-specified format string is provided, only handlers whose names
+ * match a prefix of the format string are tried.
+ *
+ * Results:
+ * A standard TCL return value. If the return value is TCL_OK, a pointer
+ * to the image format record is returned in *imageFormatPtr, and the
+ * width and height of the image are returned in *widthPtr and
+ * *heightPtr.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+MatchStringFormat(
+ Tcl_Interp *interp, /* Interpreter to use for reporting errors. */
+ Tcl_Obj *data, /* Object containing the image data. */
+ Tcl_Obj *formatObj, /* User-specified format string, or NULL. */
+ Tk_PhotoImageFormat **imageFormatPtr,
+ /* A pointer to the photo image format record
+ * is returned here. */
+ int *widthPtr, int *heightPtr,
+ /* The dimensions of the image are returned
+ * here. */
+ int *oldformat) /* Returns 1 if the old image API is used. */
+{
+ int matched = 0, useoldformat = 0;
+ Tk_PhotoImageFormat *formatPtr;
+ ThreadSpecificData *tsdPtr =
+ Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
+ const char *formatString = NULL;
+
+ if (formatObj) {
+ formatString = Tcl_GetString(formatObj);
+ }
+
+ /*
+ * Scan through the table of file format handlers to find one which can
+ * handle the image.
+ */
+
+ for (formatPtr = tsdPtr->formatList; formatPtr != NULL;
+ formatPtr = formatPtr->nextPtr) {
+ if (formatObj != NULL) {
+ if (strncasecmp(formatString,
+ formatPtr->name, strlen(formatPtr->name)) != 0) {
+ continue;
+ }
+ matched = 1;
+ if (formatPtr->stringMatchProc == NULL) {
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "-data option isn't supported for %s images",
+ formatString));
+ Tcl_SetErrorCode(interp, "TK", "IMAGE", "PHOTO",
+ "NOT_DATA_FORMAT", NULL);
+ return TCL_ERROR;
+ }
+ }
+ if ((formatPtr->stringMatchProc != NULL)
+ && (formatPtr->stringReadProc != NULL)
+ && formatPtr->stringMatchProc(data, formatObj,
+ widthPtr, heightPtr, interp)) {
+ break;
+ }
+ }
+
+ if (formatPtr == NULL) {
+ useoldformat = 1;
+ for (formatPtr = tsdPtr->oldFormatList; formatPtr != NULL;
+ formatPtr = formatPtr->nextPtr) {
+ if (formatObj != NULL) {
+ if (strncasecmp(formatString,
+ formatPtr->name, strlen(formatPtr->name)) != 0) {
+ continue;
+ }
+ matched = 1;
+ if (formatPtr->stringMatchProc == NULL) {
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "-data option isn't supported for %s images",
+ formatString));
+ Tcl_SetErrorCode(interp, "TK", "IMAGE", "PHOTO",
+ "NOT_DATA_FORMAT", 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_SetObjResult(interp, Tcl_ObjPrintf(
+ "image format \"%s\" is not supported", formatString));
+ Tcl_SetErrorCode(interp, "TK", "LOOKUP", "PHOTO_FORMAT",
+ formatString, NULL);
+ } else {
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "couldn't recognize image data", -1));
+ Tcl_SetErrorCode(interp, "TK", "IMAGE", "PHOTO",
+ "UNRECOGNIZED_DATA", NULL);
+ }
+ return TCL_ERROR;
+ }
+
+ *imageFormatPtr = formatPtr;
+ *oldformat = useoldformat;
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_FindPhoto --
+ *
+ * This function is called to get an opaque handle (actually a
+ * PhotoMaster *) for a given image, which can be used in subsequent
+ * calls to Tk_PhotoPutBlock, etc. The `name' parameter is the name of
+ * the image.
+ *
+ * Results:
+ * The handle for the photo image, or NULL if there is no photo image
+ * with the name given.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+Tk_PhotoHandle
+Tk_FindPhoto(
+ Tcl_Interp *interp, /* Interpreter (application) in which image
+ * exists. */
+ const char *imageName) /* Name of the desired photo image. */
+{
+ const Tk_ImageType *typePtr;
+ ClientData clientData =
+ Tk_GetImageMasterData(interp, imageName, &typePtr);
+
+ if ((typePtr == NULL) || (typePtr->name != tkPhotoImageType.name)) {
+ return NULL;
+ }
+ return clientData;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_PhotoPutBlock --
+ *
+ * This function is called to put image data into a photo image.
+ *
+ * Results:
+ * A standard Tcl result code.
+ *
+ * Side effects:
+ * The image data is stored. The image may be expanded. The Tk image code
+ * is informed that the image has changed. If the result code is
+ * TCL_ERROR, an error message will be placed in the interpreter (if
+ * non-NULL).
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tk_PhotoPutBlock(
+ Tcl_Interp *interp, /* Interpreter for passing back error
+ * messages, or NULL. */
+ Tk_PhotoHandle handle, /* Opaque handle for the photo image to be
+ * updated. */
+ register Tk_PhotoImageBlock *blockPtr,
+ /* Pointer to a structure describing the pixel
+ * data to be copied into the image. */
+ int x, int y, /* Coordinates of the top-left pixel to be
+ * updated in the image. */
+ int width, int height, /* Dimensions of the area of the image to be
+ * updated. */
+ int compRule) /* Compositing rule to use when processing
+ * transparent pixels. */
+{
+ register PhotoMaster *masterPtr = (PhotoMaster *) handle;
+ int xEnd, yEnd, greenOffset, blueOffset, alphaOffset;
+ int wLeft, hLeft, wCopy, hCopy, pitch;
+ unsigned char *srcPtr, *srcLinePtr, *destPtr, *destLinePtr;
+ int sourceIsSimplePhoto = compRule & SOURCE_IS_SIMPLE_ALPHA_PHOTO;
+ XRectangle rect;
+
+ /*
+ * Zero-sized blocks never cause any changes. [Bug 3078902]
+ */
+
+ if (blockPtr->height == 0 || blockPtr->width == 0) {
+ return TCL_OK;
+ }
+
+ compRule &= ~SOURCE_IS_SIMPLE_ALPHA_PHOTO;
+
+ if ((masterPtr->userWidth != 0) && ((x + width) > masterPtr->userWidth)) {
+ width = masterPtr->userWidth - x;
+ }
+ if ((masterPtr->userHeight != 0)
+ && ((y + height) > masterPtr->userHeight)) {
+ height = masterPtr->userHeight - y;
+ }
+ if ((width <= 0) || (height <= 0)) {
+ return TCL_OK;
+ }
+
+ xEnd = x + width;
+ yEnd = y + height;
+ if ((xEnd > masterPtr->width) || (yEnd > masterPtr->height)) {
+ int sameSrc = (blockPtr->pixelPtr == masterPtr->pix32);
+
+ if (ImgPhotoSetSize(masterPtr, MAX(xEnd, masterPtr->width),
+ MAX(yEnd, masterPtr->height)) == TCL_ERROR) {
+ if (interp != NULL) {
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ TK_PHOTO_ALLOC_FAILURE_MESSAGE, -1));
+ Tcl_SetErrorCode(interp, "TK", "MALLOC", NULL);
+ }
+ return TCL_ERROR;
+ }
+ if (sameSrc) {
+ blockPtr->pixelPtr = masterPtr->pix32;
+ blockPtr->pitch = masterPtr->width * 4;
+ }
+ }
+
+ if ((y < masterPtr->ditherY) || ((y == masterPtr->ditherY)
+ && (x < masterPtr->ditherX))) {
+ /*
+ * The dithering isn't correct past the start of this block.
+ */
+
+ masterPtr->ditherX = x;
+ masterPtr->ditherY = y;
+ }
+
+ /*
+ * If this image block could have different red, green and blue
+ * components, mark it as a color image.
+ */
+
+ greenOffset = blockPtr->offset[1] - blockPtr->offset[0];
+ blueOffset = blockPtr->offset[2] - blockPtr->offset[0];
+ alphaOffset = blockPtr->offset[3];
+ if ((alphaOffset >= blockPtr->pixelSize) || (alphaOffset < 0)) {
+ alphaOffset = 0;
+ sourceIsSimplePhoto = 1;
+ } else {
+ alphaOffset -= blockPtr->offset[0];
+ }
+ if ((greenOffset != 0) || (blueOffset != 0)) {
+ masterPtr->flags |= COLOR_IMAGE;
+ }
+
+ /*
+ * Copy the data into our local 32-bit/pixel array. If we can do it with a
+ * single memmove, we do.
+ */
+
+ destLinePtr = masterPtr->pix32 + (y * masterPtr->width + x) * 4;
+ pitch = masterPtr->width * 4;
+
+ /*
+ * Test to see if we can do the whole write in a single copy. This test is
+ * probably too restrictive. We should also be able to do a memmove if
+ * pixelSize == 3 and alphaOffset == 0. Maybe other cases too.
+ */
+
+ if ((blockPtr->pixelSize == 4)
+ && (greenOffset == 1) && (blueOffset == 2) && (alphaOffset == 3)
+ && (width <= blockPtr->width) && (height <= blockPtr->height)
+ && ((height == 1) || ((x == 0) && (width == masterPtr->width)
+ && (blockPtr->pitch == pitch)))
+ && (compRule == TK_PHOTO_COMPOSITE_SET)) {
+ memmove(destLinePtr, blockPtr->pixelPtr + blockPtr->offset[0],
+ ((size_t)height * width * 4));
+
+ /*
+ * We know there's an alpha offset and we're setting the data, so skip
+ * directly to the point when we recompute the photo validity region.
+ */
+
+ goto recalculateValidRegion;
+ }
+
+ /*
+ * Copy and merge pixels according to the compositing rule.
+ */
+
+ for (hLeft = height; hLeft > 0;) {
+ int pixelSize = blockPtr->pixelSize;
+ int compRuleSet = (compRule == TK_PHOTO_COMPOSITE_SET);
+
+ srcLinePtr = blockPtr->pixelPtr + blockPtr->offset[0];
+ hCopy = MIN(hLeft, blockPtr->height);
+ hLeft -= hCopy;
+ for (; hCopy > 0; --hCopy) {
+ /*
+ * If the layout of the source line matches our memory layout and
+ * we're setting, we can just copy the bytes directly, which is
+ * much faster.
+ */
+
+ if ((pixelSize == 4) && (greenOffset == 1)
+ && (blueOffset == 2) && (alphaOffset == 3)
+ && (width <= blockPtr->width)
+ && compRuleSet) {
+ memcpy(destLinePtr, srcLinePtr, ((size_t)width * 4));
+ srcLinePtr += blockPtr->pitch;
+ destLinePtr += pitch;
+ continue;
+ }
+
+ /*
+ * Have to copy the slow way.
+ */
+
+ destPtr = destLinePtr;
+ for (wLeft = width; wLeft > 0;) {
+ wCopy = MIN(wLeft, blockPtr->width);
+ wLeft -= wCopy;
+ srcPtr = srcLinePtr;
+
+ /*
+ * But we might be lucky and be able to use fairly fast loops.
+ * It's worth checking...
+ */
+
+ if (alphaOffset == 0) {
+ /*
+ * This is the non-alpha case, so can still be fairly
+ * fast. Note that in the non-alpha-source case, the
+ * compositing rule doesn't apply.
+ */
+
+ for (; wCopy>0 ; --wCopy, srcPtr+=pixelSize) {
+ *destPtr++ = srcPtr[0];
+ *destPtr++ = srcPtr[greenOffset];
+ *destPtr++ = srcPtr[blueOffset];
+ *destPtr++ = 255;
+ }
+ continue;
+ } else if (compRuleSet) {
+ /*
+ * This is the SET compositing rule, which just replaces
+ * what was there before with the new data. This is
+ * another fairly fast case. No point in doing a memcpy();
+ * the order of channels is probably wrong.
+ */
+
+ for (; wCopy>0 ; --wCopy, srcPtr+=pixelSize) {
+ *destPtr++ = srcPtr[0];
+ *destPtr++ = srcPtr[greenOffset];
+ *destPtr++ = srcPtr[blueOffset];
+ *destPtr++ = srcPtr[alphaOffset];
+ }
+ continue;
+ }
+
+ /*
+ * Bother; need to consider the alpha value of each pixel to
+ * know what to do.
+ */
+
+ for (; wCopy>0 ; --wCopy, srcPtr+=pixelSize) {
+ int alpha = srcPtr[alphaOffset];
+
+ if (alpha == 255 || !destPtr[3]) {
+ /*
+ * Either the source is 100% opaque, or the
+ * destination is entirely blank. In all cases, we
+ * just set the destination to the source.
+ */
+
+ *destPtr++ = srcPtr[0];
+ *destPtr++ = srcPtr[greenOffset];
+ *destPtr++ = srcPtr[blueOffset];
+ *destPtr++ = alpha;
+ continue;
+ }
+
+ /*
+ * Can still skip doing work if the source is 100%
+ * transparent at this point.
+ */
+
+ if (alpha) {
+ int Alpha = destPtr[3];
+
+ /*
+ * OK, there's real work to be done. Luckily, there's
+ * a substantial literature on what to do in this
+ * case. In particular, Porter and Duff have done a
+ * taxonomy of compositing rules, and the right one is
+ * the "Source Over" rule. This code implements that.
+ */
+
+ destPtr[0] = PD_SRC_OVER(srcPtr[0], alpha, destPtr[0],
+ Alpha);
+ destPtr[1] = PD_SRC_OVER(srcPtr[greenOffset], alpha,
+ destPtr[1], Alpha);
+ destPtr[2] = PD_SRC_OVER(srcPtr[blueOffset], alpha,
+ destPtr[2], Alpha);
+ destPtr[3] = PD_SRC_OVER_ALPHA(alpha, Alpha);
+ }
+
+ destPtr += 4;
+ }
+ }
+ srcLinePtr += blockPtr->pitch;
+ destLinePtr += pitch;
+ }
+ }
+
+ /*
+ * Add this new block to the region which specifies which data is valid.
+ */
+
+ if (alphaOffset) {
+ /*
+ * This block is grossly inefficient. For each row in the image, it
+ * finds each continguous string of nontransparent pixels, then marks
+ * those areas as valid in the validRegion mask. This makes drawing
+ * very efficient, because of the way we use X: we just say, here's
+ * your mask, and here's your data. We need not worry about the
+ * current background color, etc. But this costs us a lot on the image
+ * setup. Still, image setup only happens once, whereas the drawing
+ * happens many times, so this might be the best way to go.
+ *
+ * An alternative might be to not set up this mask, and instead, at
+ * drawing time, for each transparent pixel, set its color to the
+ * color of the background behind that pixel. This is what I suspect
+ * most of programs do. However, they don't have to deal with the
+ * canvas, which could have many different background colors.
+ * Determining the correct bg color for a given pixel might be
+ * expensive.
+ */
+
+ if (compRule != TK_PHOTO_COMPOSITE_OVERLAY) {
+ TkRegion workRgn;
+
+ /*
+ * Don't need this when using the OVERLAY compositing rule, which
+ * always strictly increases the valid region.
+ */
+
+ recalculateValidRegion:
+ workRgn = TkCreateRegion();
+ rect.x = x;
+ rect.y = y;
+ rect.width = width;
+ rect.height = height;
+ TkUnionRectWithRegion(&rect, workRgn, workRgn);
+ TkSubtractRegion(masterPtr->validRegion, workRgn,
+ masterPtr->validRegion);
+ TkDestroyRegion(workRgn);
+ }
+
+ /*
+ * Factorize out the main part of the building of the region data to
+ * allow for more efficient per-platform implementations. [Bug 919066]
+ */
+
+ TkpBuildRegionFromAlphaData(masterPtr->validRegion, (unsigned) x,
+ (unsigned) y, (unsigned) width, (unsigned) height,
+ masterPtr->pix32 + (y * masterPtr->width + x) * 4 + 3,
+ 4, (unsigned) masterPtr->width * 4);
+ } else {
+ rect.x = x;
+ rect.y = y;
+ rect.width = width;
+ rect.height = height;
+ TkUnionRectWithRegion(&rect, masterPtr->validRegion,
+ masterPtr->validRegion);
+ }
+
+ /*
+ * Check if display code needs alpha blending...
+ */
+
+ if (!sourceIsSimplePhoto && (height == 1)) {
+ /*
+ * Optimize the single span case if we can. This speeds up code that
+ * builds up large simple-alpha images by scan-lines or individual
+ * pixels. We don't negate COMPLEX_ALPHA in this case. [Bug 1409140]
+ * [Patch 1539990]
+ */
+
+ if (!(masterPtr->flags & COMPLEX_ALPHA)) {
+ register int x1;
+
+ for (x1=x ; x1<x+width ; x1++) {
+ register unsigned char newAlpha;
+
+ destLinePtr = masterPtr->pix32 + (y*masterPtr->width + x1)*4;
+ newAlpha = destLinePtr[3];
+ if (newAlpha && newAlpha != 255) {
+ masterPtr->flags |= COMPLEX_ALPHA;
+ break;
+ }
+ }
+ }
+ } else if ((alphaOffset != 0) || (masterPtr->flags & COMPLEX_ALPHA)) {
+ /*
+ * Check for partial transparency if alpha pixels are specified, or
+ * rescan if we already knew such pixels existed. To restrict this
+ * Toggle to only checking the changed pixels requires knowing where
+ * the alpha pixels are.
+ */
+
+ ToggleComplexAlphaIfNeeded(masterPtr);
+ }
+
+ /*
+ * Update each instance.
+ */
+
+ Tk_DitherPhoto((Tk_PhotoHandle)masterPtr, x, y, width, height);
+
+ /*
+ * Tell the core image code that this image has changed.
+ */
+
+ Tk_ImageChanged(masterPtr->tkMaster, x, y, width, height,
+ masterPtr->width, masterPtr->height);
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_PhotoPutZoomedBlock --
+ *
+ * This function is called to put image data into a photo image, with
+ * possible subsampling and/or zooming of the pixels.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The image data is stored. The image may be expanded. The Tk image code
+ * is informed that the image has changed.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tk_PhotoPutZoomedBlock(
+ Tcl_Interp *interp, /* Interpreter for passing back error
+ * messages, or NULL. */
+ Tk_PhotoHandle handle, /* Opaque handle for the photo image to be
+ * updated. */
+ register Tk_PhotoImageBlock *blockPtr,
+ /* Pointer to a structure describing the pixel
+ * data to be copied into the image. */
+ int x, int y, /* Coordinates of the top-left pixel to be
+ * updated in the image. */
+ int width, int height, /* Dimensions of the area of the image to be
+ * updated. */
+ int zoomX, int zoomY, /* Zoom factors for the X and Y axes. */
+ int subsampleX, int subsampleY,
+ /* Subsampling factors for the X and Y
+ * axes. */
+ int compRule) /* Compositing rule to use when processing
+ * transparent pixels. */
+{
+ register PhotoMaster *masterPtr = (PhotoMaster *) handle;
+ int xEnd, yEnd, greenOffset, blueOffset, alphaOffset;
+ int wLeft, hLeft, wCopy, hCopy, blockWid, blockHt;
+ unsigned char *srcPtr, *srcLinePtr, *srcOrigPtr, *destPtr, *destLinePtr;
+ int pitch, xRepeat, yRepeat, blockXSkip, blockYSkip, sourceIsSimplePhoto;
+ XRectangle rect;
+
+ /*
+ * Zero-sized blocks never cause any changes. [Bug 3078902]
+ */
+
+ if (blockPtr->height == 0 || blockPtr->width == 0) {
+ return TCL_OK;
+ }
+
+ if (zoomX==1 && zoomY==1 && subsampleX==1 && subsampleY==1) {
+ return Tk_PhotoPutBlock(interp, handle, blockPtr, x, y, width, height,
+ compRule);
+ }
+
+ sourceIsSimplePhoto = compRule & SOURCE_IS_SIMPLE_ALPHA_PHOTO;
+ compRule &= ~SOURCE_IS_SIMPLE_ALPHA_PHOTO;
+
+ if (zoomX <= 0 || zoomY <= 0) {
+ return TCL_OK;
+ }
+ if ((masterPtr->userWidth != 0) && ((x + width) > masterPtr->userWidth)) {
+ width = masterPtr->userWidth - x;
+ }
+ if ((masterPtr->userHeight != 0)
+ && ((y + height) > masterPtr->userHeight)) {
+ height = masterPtr->userHeight - y;
+ }
+ if (width <= 0 || height <= 0) {
+ return TCL_OK;
+ }
+
+ xEnd = x + width;
+ yEnd = y + height;
+ if ((xEnd > masterPtr->width) || (yEnd > masterPtr->height)) {
+ int sameSrc = (blockPtr->pixelPtr == masterPtr->pix32);
+
+ if (ImgPhotoSetSize(masterPtr, MAX(xEnd, masterPtr->width),
+ MAX(yEnd, masterPtr->height)) == TCL_ERROR) {
+ if (interp != NULL) {
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ TK_PHOTO_ALLOC_FAILURE_MESSAGE, -1));
+ Tcl_SetErrorCode(interp, "TK", "MALLOC", NULL);
+ }
+ return TCL_ERROR;
+ }
+ if (sameSrc) {
+ blockPtr->pixelPtr = masterPtr->pix32;
+ blockPtr->pitch = masterPtr->width * 4;
+ }
+ }
+
+ if ((y < masterPtr->ditherY) || ((y == masterPtr->ditherY)
+ && (x < masterPtr->ditherX))) {
+ /*
+ * The dithering isn't correct past the start of this block.
+ */
+
+ masterPtr->ditherX = x;
+ masterPtr->ditherY = y;
+ }
+
+ /*
+ * If this image block could have different red, green and blue
+ * components, mark it as a color image.
+ */
+
+ greenOffset = blockPtr->offset[1] - blockPtr->offset[0];
+ blueOffset = blockPtr->offset[2] - blockPtr->offset[0];
+ alphaOffset = blockPtr->offset[3];
+ if ((alphaOffset >= blockPtr->pixelSize) || (alphaOffset < 0)) {
+ alphaOffset = 0;
+ sourceIsSimplePhoto = 1;
+ } else {
+ alphaOffset -= blockPtr->offset[0];
+ }
+ if ((greenOffset != 0) || (blueOffset != 0)) {
+ masterPtr->flags |= COLOR_IMAGE;
+ }
+
+ /*
+ * Work out what area the pixel data in the block expands to after
+ * subsampling and zooming.
+ */
+
+ blockXSkip = subsampleX * blockPtr->pixelSize;
+ blockYSkip = subsampleY * blockPtr->pitch;
+ if (subsampleX > 0) {
+ blockWid = ((blockPtr->width + subsampleX - 1) / subsampleX) * zoomX;
+ } else if (subsampleX == 0) {
+ blockWid = width;
+ } else {
+ blockWid = ((blockPtr->width - subsampleX - 1) / -subsampleX) * zoomX;
+ }
+ if (subsampleY > 0) {
+ blockHt = ((blockPtr->height + subsampleY - 1) / subsampleY) * zoomY;
+ } else if (subsampleY == 0) {
+ blockHt = height;
+ } else {
+ blockHt = ((blockPtr->height - subsampleY - 1) / -subsampleY) * zoomY;
+ }
+
+ /*
+ * Copy the data into our local 32-bit/pixel array.
+ */
+
+ destLinePtr = masterPtr->pix32 + (y * masterPtr->width + x) * 4;
+ srcOrigPtr = blockPtr->pixelPtr + blockPtr->offset[0];
+ if (subsampleX < 0) {
+ srcOrigPtr += (blockPtr->width - 1) * blockPtr->pixelSize;
+ }
+ if (subsampleY < 0) {
+ srcOrigPtr += (blockPtr->height - 1) * blockPtr->pitch;
+ }
+
+ pitch = masterPtr->width * 4;
+ for (hLeft = height; hLeft > 0; ) {
+ hCopy = MIN(hLeft, blockHt);
+ hLeft -= hCopy;
+ yRepeat = zoomY;
+ srcLinePtr = srcOrigPtr;
+ for (; hCopy > 0; --hCopy) {
+ destPtr = destLinePtr;
+ for (wLeft = width; wLeft > 0;) {
+ wCopy = MIN(wLeft, blockWid);
+ wLeft -= wCopy;
+ srcPtr = srcLinePtr;
+ for (; wCopy > 0; wCopy -= zoomX) {
+ for (xRepeat = MIN(wCopy, zoomX); xRepeat > 0; xRepeat--) {
+ int alpha = srcPtr[alphaOffset];/* Source alpha. */
+
+ /*
+ * Common case (solid pixels) first
+ */
+
+ if (!alphaOffset || (alpha == 255)) {
+ *destPtr++ = srcPtr[0];
+ *destPtr++ = srcPtr[greenOffset];
+ *destPtr++ = srcPtr[blueOffset];
+ *destPtr++ = 255;
+ continue;
+ }
+
+ if (compRule==TK_PHOTO_COMPOSITE_SET || !destPtr[3]) {
+ /*
+ * Either this is the SET rule (we overwrite
+ * whatever is there) or the destination is
+ * entirely blank. In both cases, we just set the
+ * destination to the source.
+ */
+
+ *destPtr++ = srcPtr[0];
+ *destPtr++ = srcPtr[greenOffset];
+ *destPtr++ = srcPtr[blueOffset];
+ *destPtr++ = alpha;
+ } else if (alpha) {
+ int Alpha = destPtr[3]; /* Destination
+ * alpha. */
+
+ destPtr[0] = PD_SRC_OVER(srcPtr[0], alpha,
+ destPtr[0], Alpha);
+ destPtr[1] = PD_SRC_OVER(srcPtr[greenOffset],alpha,
+ destPtr[1], Alpha);
+ destPtr[2] = PD_SRC_OVER(srcPtr[blueOffset], alpha,
+ destPtr[2], Alpha);
+ destPtr[3] = PD_SRC_OVER_ALPHA(alpha, Alpha);
+
+ destPtr += 4;
+ } else {
+ destPtr += 4;
+ }
+ }
+ srcPtr += blockXSkip;
+ }
+ }
+ destLinePtr += pitch;
+ yRepeat--;
+ if (yRepeat <= 0) {
+ srcLinePtr += blockYSkip;
+ yRepeat = zoomY;
+ }
+ }
+ }
+
+ /*
+ * Recompute the region of data for which we have valid pixels to plot.
+ */
+
+ if (alphaOffset) {
+ if (compRule != TK_PHOTO_COMPOSITE_OVERLAY) {
+ /*
+ * Don't need this when using the OVERLAY compositing rule, which
+ * always strictly increases the valid region.
+ */
+
+ TkRegion workRgn = TkCreateRegion();
+
+ rect.x = x;
+ rect.y = y;
+ rect.width = width;
+ rect.height = 1;
+ TkUnionRectWithRegion(&rect, workRgn, workRgn);
+ TkSubtractRegion(masterPtr->validRegion, workRgn,
+ masterPtr->validRegion);
+ TkDestroyRegion(workRgn);
+ }
+
+ TkpBuildRegionFromAlphaData(masterPtr->validRegion,
+ (unsigned)x, (unsigned)y, (unsigned)width, (unsigned)height,
+ &masterPtr->pix32[(y * masterPtr->width + x) * 4 + 3], 4,
+ (unsigned) masterPtr->width * 4);
+ } else {
+ rect.x = x;
+ rect.y = y;
+ rect.width = width;
+ rect.height = height;
+ TkUnionRectWithRegion(&rect, masterPtr->validRegion,
+ masterPtr->validRegion);
+ }
+
+ /*
+ * Check if display code needs alpha blending...
+ */
+
+ if (!sourceIsSimplePhoto && (width == 1) && (height == 1)) {
+ /*
+ * Optimize the single pixel case if we can. This speeds up code that
+ * builds up large simple-alpha images by single pixels. We don't
+ * negate COMPLEX_ALPHA in this case. [Bug 1409140]
+ */
+ if (!(masterPtr->flags & COMPLEX_ALPHA)) {
+ unsigned char newAlpha;
+
+ destLinePtr = masterPtr->pix32 + (y * masterPtr->width + x) * 4;
+ newAlpha = destLinePtr[3];
+
+ if (newAlpha && newAlpha != 255) {
+ masterPtr->flags |= COMPLEX_ALPHA;
+ }
+ }
+ } else if ((alphaOffset != 0) || (masterPtr->flags & COMPLEX_ALPHA)) {
+ /*
+ * Check for partial transparency if alpha pixels are specified, or
+ * rescan if we already knew such pixels existed. To restrict this
+ * Toggle to only checking the changed pixels requires knowing where
+ * the alpha pixels are.
+ */
+ ToggleComplexAlphaIfNeeded(masterPtr);
+ }
+
+ /*
+ * Update each instance.
+ */
+
+ Tk_DitherPhoto((Tk_PhotoHandle) masterPtr, x, y, width, height);
+
+ /*
+ * Tell the core image code that this image has changed.
+ */
+
+ Tk_ImageChanged(masterPtr->tkMaster, x, y, width, height, masterPtr->width,
+ masterPtr->height);
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_DitherPhoto --
+ *
+ * This function is called to update an area of each instance's pixmap by
+ * dithering the corresponding area of the image master.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The pixmap of each instance of this image gets updated. The fields in
+ * *masterPtr indicating which area of the image is correctly dithered
+ * get updated.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tk_DitherPhoto(
+ Tk_PhotoHandle photo, /* Image master whose instances are to be
+ * updated. */
+ int x, int y, /* Coordinates of the top-left pixel in the
+ * area to be dithered. */
+ int width, int height) /* Dimensions of the area to be dithered. */
+{
+ PhotoMaster *masterPtr = (PhotoMaster *) photo;
+ PhotoInstance *instancePtr;
+
+ if ((width <= 0) || (height <= 0)) {
+ return;
+ }
+
+ for (instancePtr = masterPtr->instancePtr; instancePtr != NULL;
+ instancePtr = instancePtr->nextPtr) {
+ TkImgDitherInstance(instancePtr, x, y, width, height);
+ }
+
+ /*
+ * Work out whether this block will be correctly dithered and whether it
+ * will extend the correctly dithered region.
+ */
+
+ if (((y < masterPtr->ditherY)
+ || ((y == masterPtr->ditherY) && (x <= masterPtr->ditherX)))
+ && ((y + height) > (masterPtr->ditherY))) {
+ /*
+ * This block starts inside (or immediately after) the correctly
+ * dithered region, so the first scan line at least will be right.
+ * Furthermore this block extends into scanline masterPtr->ditherY.
+ */
+
+ if ((x == 0) && (width == masterPtr->width)) {
+ /*
+ * We are doing the full width, therefore the dithering will be
+ * correct to the end.
+ */
+
+ masterPtr->ditherX = 0;
+ masterPtr->ditherY = y + height;
+ } else {
+ /*
+ * We are doing partial scanlines, therefore the
+ * correctly-dithered region will be extended by at most one scan
+ * line.
+ */
+
+ if (x <= masterPtr->ditherX) {
+ masterPtr->ditherX = x + width;
+ if (masterPtr->ditherX >= masterPtr->width) {
+ masterPtr->ditherX = 0;
+ masterPtr->ditherY++;
+ }
+ }
+ }
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_PhotoBlank --
+ *
+ * This function is called to clear an entire photo image.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The valid region for the image is set to the null region. The generic
+ * image code is notified that the image has changed.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tk_PhotoBlank(
+ Tk_PhotoHandle handle) /* Handle for the image to be blanked. */
+{
+ PhotoMaster *masterPtr = (PhotoMaster *) handle;
+ PhotoInstance *instancePtr;
+
+ masterPtr->ditherX = masterPtr->ditherY = 0;
+ masterPtr->flags = 0;
+
+ /*
+ * The image has valid data nowhere.
+ */
+
+ if (masterPtr->validRegion != NULL) {
+ TkDestroyRegion(masterPtr->validRegion);
+ }
+ masterPtr->validRegion = TkCreateRegion();
+
+ /*
+ * Clear out the 32-bit pixel storage array. Clear out the dithering error
+ * arrays for each instance.
+ */
+
+ memset(masterPtr->pix32, 0,
+ ((size_t)masterPtr->width * masterPtr->height * 4));
+ for (instancePtr = masterPtr->instancePtr; instancePtr != NULL;
+ instancePtr = instancePtr->nextPtr) {
+ TkImgResetDither(instancePtr);
+ }
+
+ /*
+ * Tell the core image code that this image has changed.
+ */
+
+ Tk_ImageChanged(masterPtr->tkMaster, 0, 0, masterPtr->width,
+ masterPtr->height, masterPtr->width, masterPtr->height);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_PhotoExpand --
+ *
+ * This function is called to request that a photo image be expanded if
+ * necessary to be at least `width' pixels wide and `height' pixels high.
+ * If the user has declared a definite image size (using the -width and
+ * -height configuration options) then this call has no effect.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The size of the photo image may change; if so the generic image code
+ * is informed.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tk_PhotoExpand(
+ Tcl_Interp *interp, /* Interpreter for passing back error
+ * messages, or NULL. */
+ Tk_PhotoHandle handle, /* Handle for the image to be expanded. */
+ int width, int height) /* Desired minimum dimensions of the image. */
+{
+ PhotoMaster *masterPtr = (PhotoMaster *) handle;
+
+ if (width <= masterPtr->width) {
+ width = masterPtr->width;
+ }
+ if (height <= masterPtr->height) {
+ height = masterPtr->height;
+ }
+ if ((width != masterPtr->width) || (height != masterPtr->height)) {
+ if (ImgPhotoSetSize(masterPtr, MAX(width, masterPtr->width),
+ MAX(height, masterPtr->height)) == TCL_ERROR) {
+ if (interp != NULL) {
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ TK_PHOTO_ALLOC_FAILURE_MESSAGE, -1));
+ Tcl_SetErrorCode(interp, "TK", "MALLOC", NULL);
+ }
+ return TCL_ERROR;
+ }
+ Tk_ImageChanged(masterPtr->tkMaster, 0, 0, 0, 0, masterPtr->width,
+ masterPtr->height);
+ }
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_PhotoGetSize --
+ *
+ * This function is called to obtain the current size of a photo image.
+ *
+ * Results:
+ * The image's width and height are returned in *widthp and *heightp.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tk_PhotoGetSize(
+ Tk_PhotoHandle handle, /* Handle for the image whose dimensions are
+ * requested. */
+ int *widthPtr, int *heightPtr)
+ /* The dimensions of the image are returned
+ * here. */
+{
+ PhotoMaster *masterPtr = (PhotoMaster *) handle;
+
+ *widthPtr = masterPtr->width;
+ *heightPtr = masterPtr->height;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_PhotoSetSize --
+ *
+ * This function is called to set size of a photo image. This call is
+ * equivalent to using the -width and -height configuration options.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The size of the image may change; if so the generic image code is
+ * informed.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tk_PhotoSetSize(
+ Tcl_Interp *interp, /* Interpreter for passing back error
+ * messages, or NULL. */
+ Tk_PhotoHandle handle, /* Handle for the image whose size is to be
+ * set. */
+ int width, int height) /* New dimensions for the image. */
+{
+ PhotoMaster *masterPtr = (PhotoMaster *) handle;
+
+ masterPtr->userWidth = width;
+ masterPtr->userHeight = height;
+ if (ImgPhotoSetSize(masterPtr, ((width > 0) ? width: masterPtr->width),
+ ((height > 0) ? height: masterPtr->height)) == TCL_ERROR) {
+ if (interp != NULL) {
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ TK_PHOTO_ALLOC_FAILURE_MESSAGE, -1));
+ Tcl_SetErrorCode(interp, "TK", "MALLOC", NULL);
+ }
+ return TCL_ERROR;
+ }
+ Tk_ImageChanged(masterPtr->tkMaster, 0, 0, 0, 0,
+ masterPtr->width, masterPtr->height);
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkGetPhotoValidRegion --
+ *
+ * This function is called to get the part of the photo where there is
+ * valid data. Or, conversely, the part of the photo which is
+ * transparent.
+ *
+ * Results:
+ * A TkRegion value that indicates the current area of the photo that is
+ * valid. This value should not be used after any modification to the
+ * photo image.
+ *
+ * Side Effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+TkRegion
+TkPhotoGetValidRegion(
+ Tk_PhotoHandle handle) /* Handle for the image whose valid region is
+ * to obtained. */
+{
+ PhotoMaster *masterPtr = (PhotoMaster *) handle;
+
+ return masterPtr->validRegion;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ImgGetPhoto --
+ *
+ * This function is called to obtain image data from a photo image. This
+ * function fills in the Tk_PhotoImageBlock structure pointed to by
+ * `blockPtr' with details of the address and layout of the image data in
+ * memory.
+ *
+ * Results:
+ * A pointer to the allocated data which should be freed later. NULL if
+ * there is no need to free data because blockPtr->pixelPtr points
+ * directly to the image data.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static char *
+ImgGetPhoto(
+ PhotoMaster *masterPtr, /* Handle for the photo image from which image
+ * data is desired. */
+ Tk_PhotoImageBlock *blockPtr,
+ /* Information about the address and layout of
+ * the image data is returned here. */
+ struct SubcommandOptions *optPtr)
+{
+ unsigned char *pixelPtr;
+ int x, y, greenOffset, blueOffset, alphaOffset;
+
+ Tk_PhotoGetImage((Tk_PhotoHandle) masterPtr, blockPtr);
+ blockPtr->pixelPtr += optPtr->fromY * blockPtr->pitch
+ + optPtr->fromX * blockPtr->pixelSize;
+ blockPtr->width = optPtr->fromX2 - optPtr->fromX;
+ blockPtr->height = optPtr->fromY2 - optPtr->fromY;
+
+ if (!(masterPtr->flags & COLOR_IMAGE) &&
+ (!(optPtr->options & OPT_BACKGROUND)
+ || ((optPtr->background->red == optPtr->background->green)
+ && (optPtr->background->red == optPtr->background->blue)))) {
+ blockPtr->offset[0] = blockPtr->offset[1] = blockPtr->offset[2];
+ }
+ alphaOffset = 0;
+ for (y = 0; y < blockPtr->height; y++) {
+ pixelPtr = blockPtr->pixelPtr + (y * blockPtr->pitch)
+ + blockPtr->pixelSize - 1;
+ for (x = 0; x < blockPtr->width; x++) {
+ if (*pixelPtr != 255) {
+ alphaOffset = 3;
+ break;
+ }
+ pixelPtr += blockPtr->pixelSize;
+ }
+ if (alphaOffset) {
+ break;
+ }
+ }
+ if (!alphaOffset) {
+ blockPtr->offset[3]= -1; /* Tell caller alpha need not be read */
+ }
+ greenOffset = blockPtr->offset[1] - blockPtr->offset[0];
+ blueOffset = blockPtr->offset[2] - blockPtr->offset[0];
+ if (((optPtr->options & OPT_BACKGROUND) && alphaOffset) ||
+ ((optPtr->options & OPT_GRAYSCALE) && (greenOffset||blueOffset))) {
+ int newPixelSize,x,y;
+ unsigned char *srcPtr, *destPtr;
+ char *data;
+
+ newPixelSize = (!(optPtr->options & OPT_BACKGROUND) && alphaOffset)
+ ? 2 : 1;
+ if ((greenOffset||blueOffset) && !(optPtr->options & OPT_GRAYSCALE)) {
+ newPixelSize += 2;
+ }
+
+ if (blockPtr->height > (int)((UINT_MAX/newPixelSize)/blockPtr->width)) {
+ return NULL;
+ }
+ data = attemptckalloc(newPixelSize*blockPtr->width*blockPtr->height);
+ if (data == NULL) {
+ return NULL;
+ }
+ srcPtr = blockPtr->pixelPtr + blockPtr->offset[0];
+ destPtr = (unsigned char *) data;
+ if (!greenOffset && !blueOffset) {
+ for (y = blockPtr->height; y > 0; y--) {
+ for (x = blockPtr->width; x > 0; x--) {
+ *destPtr = *srcPtr;
+ srcPtr += blockPtr->pixelSize;
+ destPtr += newPixelSize;
+ }
+ srcPtr += blockPtr->pitch -
+ blockPtr->width * blockPtr->pixelSize;
+ }
+ } else if (optPtr->options & OPT_GRAYSCALE) {
+ for (y = blockPtr->height; y > 0; y--) {
+ for (x = blockPtr->width; x > 0; x--) {
+ *destPtr = (unsigned char) ((srcPtr[0]*11 + srcPtr[1]*16
+ + srcPtr[2]*5 + 16) >> 5);
+ srcPtr += blockPtr->pixelSize;
+ destPtr += newPixelSize;
+ }
+ srcPtr += blockPtr->pitch -
+ blockPtr->width * blockPtr->pixelSize;
+ }
+ } else {
+ for (y = blockPtr->height; y > 0; y--) {
+ for (x = blockPtr->width; x > 0; x--) {
+ destPtr[0] = srcPtr[0];
+ destPtr[1] = srcPtr[1];
+ destPtr[2] = srcPtr[2];
+ srcPtr += blockPtr->pixelSize;
+ destPtr += newPixelSize;
+ }
+ srcPtr += blockPtr->pitch -
+ blockPtr->width * blockPtr->pixelSize;
+ }
+ }
+ srcPtr = blockPtr->pixelPtr + alphaOffset;
+ destPtr = (unsigned char *) data;
+ if (!alphaOffset) {
+ /*
+ * Nothing to be done.
+ */
+ } else if (optPtr->options & OPT_BACKGROUND) {
+ if (newPixelSize > 2) {
+ int red = optPtr->background->red>>8;
+ int green = optPtr->background->green>>8;
+ int blue = optPtr->background->blue>>8;
+
+ for (y = blockPtr->height; y > 0; y--) {
+ for (x = blockPtr->width; x > 0; x--) {
+ destPtr[0] += (unsigned char) (((255 - *srcPtr) *
+ (red-destPtr[0])) / 255);
+ destPtr[1] += (unsigned char) (((255 - *srcPtr) *
+ (green-destPtr[1])) / 255);
+ destPtr[2] += (unsigned char) (((255 - *srcPtr) *
+ (blue-destPtr[2])) / 255);
+ srcPtr += blockPtr->pixelSize;
+ destPtr += newPixelSize;
+ }
+ srcPtr += blockPtr->pitch -
+ blockPtr->width * blockPtr->pixelSize;
+ }
+ } else {
+ int gray = (unsigned char) (((optPtr->background->red>>8) * 11
+ + (optPtr->background->green>>8) * 16
+ + (optPtr->background->blue>>8) * 5 + 16) >> 5);
+
+ for (y = blockPtr->height; y > 0; y--) {
+ for (x = blockPtr->width; x > 0; x--) {
+ destPtr[0] += ((255 - *srcPtr) *
+ (gray-destPtr[0])) / 255;
+ srcPtr += blockPtr->pixelSize;
+ destPtr += newPixelSize;
+ }
+ srcPtr += blockPtr->pitch -
+ blockPtr->width * blockPtr->pixelSize;
+ }
+ }
+ } else {
+ destPtr += newPixelSize-1;
+ for (y = blockPtr->height; y > 0; y--) {
+ for (x = blockPtr->width; x > 0; x--) {
+ *destPtr = *srcPtr;
+ srcPtr += blockPtr->pixelSize;
+ destPtr += newPixelSize;
+ }
+ srcPtr += blockPtr->pitch -
+ blockPtr->width * blockPtr->pixelSize;
+ }
+ }
+ blockPtr->pixelPtr = (unsigned char *) data;
+ blockPtr->pixelSize = newPixelSize;
+ blockPtr->pitch = newPixelSize * blockPtr->width;
+ blockPtr->offset[0] = 0;
+ if (newPixelSize > 2) {
+ blockPtr->offset[1] = 1;
+ blockPtr->offset[2] = 2;
+ blockPtr->offset[3]= 3;
+ } else {
+ blockPtr->offset[1] = 0;
+ blockPtr->offset[2] = 0;
+ blockPtr->offset[3]= 1;
+ }
+ return data;
+ }
+ return NULL;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ImgStringWrite --
+ *
+ * Default string write function. The data is formatted in the default
+ * format as accepted by the "<img> put" command.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * See the user documentation.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+ImgStringWrite(
+ Tcl_Interp *interp,
+ Tcl_Obj *formatString,
+ Tk_PhotoImageBlock *blockPtr)
+{
+ int greenOffset, blueOffset;
+ Tcl_Obj *data;
+
+ greenOffset = blockPtr->offset[1] - blockPtr->offset[0];
+ blueOffset = blockPtr->offset[2] - blockPtr->offset[0];
+
+ data = Tcl_NewObj();
+ if ((blockPtr->width > 0) && (blockPtr->height > 0)) {
+ int row, col;
+
+ for (row=0; row<blockPtr->height; row++) {
+ Tcl_Obj *line = Tcl_NewObj();
+ unsigned char *pixelPtr = blockPtr->pixelPtr + blockPtr->offset[0]
+ + row * blockPtr->pitch;
+
+ for (col=0; col<blockPtr->width; col++) {
+ Tcl_AppendPrintfToObj(line, "%s#%02x%02x%02x",
+ col ? " " : "", *pixelPtr,
+ pixelPtr[greenOffset], pixelPtr[blueOffset]);
+ pixelPtr += blockPtr->pixelSize;
+ }
+ Tcl_ListObjAppendElement(NULL, data, line);
+ }
+ }
+ Tcl_SetObjResult(interp, data);
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_PhotoGetImage --
+ *
+ * This function is called to obtain image data from a photo image. This
+ * function fills in the Tk_PhotoImageBlock structure pointed to by
+ * `blockPtr' with details of the address and layout of the image data in
+ * memory.
+ *
+ * Results:
+ * TRUE (1) indicating that image data is available, for backwards
+ * compatibility with the old photo widget.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tk_PhotoGetImage(
+ Tk_PhotoHandle handle, /* Handle for the photo image from which image
+ * data is desired. */
+ Tk_PhotoImageBlock *blockPtr)
+ /* Information about the address and layout of
+ * the image data is returned here. */
+{
+ PhotoMaster *masterPtr = (PhotoMaster *) handle;
+
+ blockPtr->pixelPtr = masterPtr->pix32;
+ blockPtr->width = masterPtr->width;
+ blockPtr->height = masterPtr->height;
+ blockPtr->pitch = masterPtr->width * 4;
+ blockPtr->pixelSize = 4;
+ blockPtr->offset[0] = 0;
+ blockPtr->offset[1] = 1;
+ blockPtr->offset[2] = 2;
+ blockPtr->offset[3] = 3;
+ return 1;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * TkPostscriptPhoto --
+ *
+ * This function 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 clientData, /* Handle for the photo image. */
+ Tcl_Interp *interp, /* Interpreter. */
+ Tk_Window tkwin, /* (unused) */
+ Tk_PostscriptInfo psInfo, /* Postscript info. */
+ int x, int y, /* First pixel to output. */
+ int width, int height, /* Width and height of area. */
+ int prepass) /* (unused) */
+{
+ Tk_PhotoImageBlock block;
+
+ Tk_PhotoGetImage(clientData, &block);
+ block.pixelPtr += y * block.pitch + x * block.pixelSize;
+
+ return Tk_PostscriptPhoto(interp, &block, psInfo, width, height);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_PhotoPutBlock_NoComposite, Tk_PhotoPutZoomedBlock_NoComposite --
+ *
+ * These backward-compatability functions just exist to fill slots in stubs
+ * table. For the behaviour of *_NoComposite, refer to the corresponding
+ * function without the extra suffix, except that the compositing rule is
+ * always "overlay" and the function always panics on memory-allocation
+ * failure.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tk_PhotoPutBlock_NoComposite(
+ Tk_PhotoHandle handle,
+ Tk_PhotoImageBlock *blockPtr,
+ int x, int y, int width, int height)
+{
+ if (Tk_PhotoPutBlock(NULL, handle, blockPtr, x, y, width, height,
+ TK_PHOTO_COMPOSITE_OVERLAY) != TCL_OK) {
+ Tcl_Panic(TK_PHOTO_ALLOC_FAILURE_MESSAGE);
+ }
+}
+
+void
+Tk_PhotoPutZoomedBlock_NoComposite(
+ Tk_PhotoHandle handle,
+ Tk_PhotoImageBlock *blockPtr,
+ int x, int y, int width, int height,
+ int zoomX, int zoomY, int subsampleX, int subsampleY)
+{
+ if (Tk_PhotoPutZoomedBlock(NULL, handle, blockPtr, x, y, width, height,
+ zoomX, zoomY, subsampleX, subsampleY,
+ TK_PHOTO_COMPOSITE_OVERLAY) != TCL_OK) {
+ Tcl_Panic(TK_PHOTO_ALLOC_FAILURE_MESSAGE);
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_PhotoExpand_Panic, Tk_PhotoPutBlock_Panic,
+ * Tk_PhotoPutZoomedBlock_Panic, Tk_PhotoSetSize_Panic
+ *
+ * Backward compatability functions for preserving the old behaviour (i.e.
+ * panic on memory allocation failure) so that extensions do not need to be
+ * significantly updated to take account of TIP #116. These call the new
+ * interface (i.e. the interface without the extra suffix), but panic if an
+ * error condition is returned.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tk_PhotoExpand_Panic(
+ Tk_PhotoHandle handle,
+ int width, int height)
+{
+ if (Tk_PhotoExpand(NULL, handle, width, height) != TCL_OK) {
+ Tcl_Panic(TK_PHOTO_ALLOC_FAILURE_MESSAGE);
+ }
+}
+
+void
+Tk_PhotoPutBlock_Panic(
+ Tk_PhotoHandle handle,
+ Tk_PhotoImageBlock *blockPtr,
+ int x, int y, int width, int height, int compRule)
+{
+ if (Tk_PhotoPutBlock(NULL, handle, blockPtr, x, y, width, height,
+ compRule) != TCL_OK) {
+ Tcl_Panic(TK_PHOTO_ALLOC_FAILURE_MESSAGE);
+ }
+}
+
+void
+Tk_PhotoPutZoomedBlock_Panic(
+ Tk_PhotoHandle handle, Tk_PhotoImageBlock *blockPtr,
+ int x, int y, int width, int height,
+ int zoomX, int zoomY, int subsampleX, int subsampleY,
+ int compRule)
+{
+ if (Tk_PhotoPutZoomedBlock(NULL, handle, blockPtr, x, y, width, height,
+ zoomX, zoomY, subsampleX, subsampleY, compRule) != TCL_OK) {
+ Tcl_Panic(TK_PHOTO_ALLOC_FAILURE_MESSAGE);
+ }
+}
+
+void
+Tk_PhotoSetSize_Panic(
+ Tk_PhotoHandle handle,
+ int width, int height)
+{
+ if (Tk_PhotoSetSize(NULL, handle, width, height) != TCL_OK) {
+ Tcl_Panic(TK_PHOTO_ALLOC_FAILURE_MESSAGE);
+ }
+}
+
+/*
+ * Local Variables:
+ * mode: c
+ * c-basic-offset: 4
+ * fill-column: 78
+ * End:
+ */
diff --git a/tk8.6/generic/tkImgPhoto.h b/tk8.6/generic/tkImgPhoto.h
new file mode 100644
index 0000000..36bc6cb
--- /dev/null
+++ b/tk8.6/generic/tkImgPhoto.h
@@ -0,0 +1,262 @@
+/*
+ * tkImgPhoto.h --
+ *
+ * Declarations for images of type "photo" for Tk.
+ *
+ * Copyright (c) 1994 The Australian National University.
+ * Copyright (c) 1994-1997 Sun Microsystems, Inc.
+ * Copyright (c) 2002-2008 Donal K. Fellows
+ * Copyright (c) 2003 ActiveState Corporation.
+ *
+ * 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.
+ */
+
+#include "tkInt.h"
+#ifdef _WIN32
+#include "tkWinInt.h"
+#elif defined(__CYGWIN__)
+#include "tkUnixInt.h"
+#endif
+
+/*
+ * Forward declarations of the structures we define.
+ */
+
+typedef struct ColorTableId ColorTableId;
+typedef struct ColorTable ColorTable;
+typedef struct PhotoInstance PhotoInstance;
+typedef struct PhotoMaster PhotoMaster;
+
+/*
+ * A signed 8-bit integral type. If chars are unsigned and the compiler isn't
+ * an ANSI one, then we have to use short instead (which wastes space) to get
+ * signed behavior.
+ */
+
+#if defined(__STDC__) || defined(_AIX)
+ typedef signed char schar;
+#else
+# ifndef __CHAR_UNSIGNED__
+ typedef char schar;
+# else
+ typedef short schar;
+# endif
+#endif
+
+/*
+ * An unsigned 32-bit integral type, used for pixel values. We use int rather
+ * than long here to accommodate those systems where longs are 64 bits.
+ */
+
+typedef unsigned int pixel;
+
+/*
+ * The maximum number of pixels to transmit to the server in a single
+ * XPutImage call.
+ */
+
+#define MAX_PIXELS 65536
+
+/*
+ * The set of colors required to display a photo image in a window depends on:
+ * - the visual used by the window
+ * - the palette, which specifies how many levels of each primary color to
+ * use, and
+ * - the gamma value for the image.
+ *
+ * Pixel values allocated for specific colors are valid only for the colormap
+ * in which they were allocated. Sets of pixel values allocated for displaying
+ * photos are re-used in other windows if possible, that is, if the display,
+ * colormap, palette and gamma values match. A hash table is used to locate
+ * these sets of pixel values, using the following data structure as key:
+ */
+
+struct ColorTableId {
+ Display *display; /* Qualifies the colormap resource ID. */
+ Colormap colormap; /* Colormap that the windows are using. */
+ double gamma; /* Gamma exponent value for images. */
+ Tk_Uid palette; /* Specifies how many shades of each primary
+ * we want to allocate. */
+};
+
+/*
+ * For a particular (display, colormap, palette, gamma) combination, a data
+ * structure of the following type is used to store the allocated pixel values
+ * and other information:
+ */
+
+struct ColorTable {
+ ColorTableId id; /* Information used in selecting this color
+ * table. */
+ int flags; /* See below. */
+ int refCount; /* Number of instances using this map. */
+ int liveRefCount; /* Number of instances which are actually in
+ * use, using this map. */
+ int numColors; /* Number of colors allocated for this map. */
+
+ XVisualInfo visualInfo; /* Information about the visual for windows
+ * using this color table. */
+
+ pixel redValues[256]; /* Maps 8-bit values of red intensity to a
+ * pixel value or index in pixelMap. */
+ pixel greenValues[256]; /* Ditto for green intensity. */
+ pixel blueValues[256]; /* Ditto for blue intensity. */
+ unsigned long *pixelMap; /* Actual pixel values allocated. */
+
+ unsigned char colorQuant[3][256];
+ /* Maps 8-bit intensities to quantized
+ * intensities. The first index is 0 for red,
+ * 1 for green, 2 for blue. */
+};
+
+/*
+ * Bit definitions for the flags field of a ColorTable.
+ * BLACK_AND_WHITE: 1 means only black and white colors are
+ * available.
+ * COLOR_WINDOW: 1 means a full 3-D color cube has been
+ * allocated.
+ * DISPOSE_PENDING: 1 means a call to DisposeColorTable has been
+ * scheduled as an idle handler, but it hasn't
+ * been invoked yet.
+ * MAP_COLORS: 1 means pixel values should be mapped through
+ * pixelMap.
+ */
+
+#ifdef COLOR_WINDOW
+#undef COLOR_WINDOW
+#endif
+
+#define BLACK_AND_WHITE 1
+#define COLOR_WINDOW 2
+#define DISPOSE_PENDING 4
+#define MAP_COLORS 8
+
+/*
+ * Definition of the data associated with each photo image master.
+ */
+
+struct PhotoMaster {
+ Tk_ImageMaster tkMaster; /* Tk's token for image master. NULL means the
+ * image is being deleted. */
+ Tcl_Interp *interp; /* Interpreter associated with the application
+ * using this image. */
+ Tcl_Command imageCmd; /* Token for image command (used to delete it
+ * when the image goes away). NULL means the
+ * image command has already been deleted. */
+ int flags; /* Sundry flags, defined below. */
+ int width, height; /* Dimensions of image. */
+ int userWidth, userHeight; /* User-declared image dimensions. */
+ Tk_Uid palette; /* User-specified default palette for
+ * instances of this image. */
+ double gamma; /* Display gamma value to correct for. */
+ char *fileString; /* Name of file to read into image. */
+ Tcl_Obj *dataString; /* Object to use as contents of image. */
+ Tcl_Obj *format; /* User-specified format of data in image file
+ * or string value. */
+ unsigned char *pix32; /* Local storage for 32-bit image. */
+ int ditherX, ditherY; /* Location of first incorrectly dithered
+ * pixel in image. */
+ TkRegion validRegion; /* Tk region indicating which parts of the
+ * image have valid image data. */
+ PhotoInstance *instancePtr; /* First in the list of instances associated
+ * with this master. */
+};
+
+/*
+ * Bit definitions for the flags field of a PhotoMaster.
+ * COLOR_IMAGE: 1 means that the image has different color
+ * components.
+ * IMAGE_CHANGED: 1 means that the instances of this image need
+ * to be redithered.
+ * COMPLEX_ALPHA: 1 means that the instances of this image have
+ * alpha values that aren't 0 or 255, and so need
+ * the copy-merge-replace renderer .
+ */
+
+#define COLOR_IMAGE 1
+#define IMAGE_CHANGED 2
+#define COMPLEX_ALPHA 4
+
+/*
+ * Flag to OR with the compositing rule to indicate that the source, despite
+ * having an alpha channel, has simple alpha.
+ */
+
+#define SOURCE_IS_SIMPLE_ALPHA_PHOTO 0x10000000
+
+/*
+ * The following data structure represents all of the instances of a photo
+ * image in windows on a given screen that are using the same colormap.
+ */
+
+struct PhotoInstance {
+ PhotoMaster *masterPtr; /* Pointer to master for image. */
+ Display *display; /* Display for windows using this instance. */
+ Colormap colormap; /* The image may only be used in windows with
+ * this particular colormap. */
+ PhotoInstance *nextPtr; /* Pointer to the next instance in the list of
+ * instances associated with this master. */
+ int refCount; /* Number of instances using this structure. */
+ Tk_Uid palette; /* Palette for these particular instances. */
+ double gamma; /* Gamma value for these instances. */
+ Tk_Uid defaultPalette; /* Default palette to use if a palette is not
+ * specified for the master. */
+ ColorTable *colorTablePtr; /* Pointer to information about colors
+ * allocated for image display in windows like
+ * this one. */
+ Pixmap pixels; /* X pixmap containing dithered image. */
+ int width, height; /* Dimensions of the pixmap. */
+ schar *error; /* Error image, used in dithering. */
+ XImage *imagePtr; /* Image structure for converted pixels. */
+ XVisualInfo visualInfo; /* Information about the visual that these
+ * windows are using. */
+ GC gc; /* Graphics context for writing images to the
+ * pixmap. */
+};
+
+/*
+ * Implementation of the Porter-Duff Source-Over compositing rule.
+ */
+
+#define PD_SRC_OVER(srcColor, srcAlpha, dstColor, dstAlpha) \
+ (srcColor*srcAlpha/255) + dstAlpha*(255-srcAlpha)/255*dstColor/255
+#define PD_SRC_OVER_ALPHA(srcAlpha, dstAlpha) \
+ (srcAlpha + (255-srcAlpha)*dstAlpha/255)
+
+#undef MIN
+#define MIN(a, b) ((a) < (b)? (a): (b))
+#undef MAX
+#define MAX(a, b) ((a) > (b)? (a): (b))
+
+/*
+ * Declarations of functions shared between the different parts of the
+ * photo image implementation.
+ */
+
+MODULE_SCOPE void TkImgPhotoConfigureInstance(
+ PhotoInstance *instancePtr);
+MODULE_SCOPE void TkImgDisposeInstance(ClientData clientData);
+MODULE_SCOPE void TkImgPhotoInstanceSetSize(PhotoInstance *instancePtr);
+MODULE_SCOPE ClientData TkImgPhotoGet(Tk_Window tkwin, ClientData clientData);
+MODULE_SCOPE void TkImgDitherInstance(PhotoInstance *instancePtr, int x,
+ int y, int width, int height);
+MODULE_SCOPE void TkImgPhotoDisplay(ClientData clientData,
+ Display *display, Drawable drawable,
+ int imageX, int imageY, int width, int height,
+ int drawableX, int drawableY);
+MODULE_SCOPE void TkImgPhotoFree(ClientData clientData,
+ Display *display);
+MODULE_SCOPE void TkImgResetDither(PhotoInstance *instancePtr);
+
+/*
+ * Local Variables:
+ * mode: c
+ * c-basic-offset: 4
+ * fill-column: 78
+ * End:
+ */
diff --git a/tk8.6/generic/tkImgUtil.c b/tk8.6/generic/tkImgUtil.c
new file mode 100644
index 0000000..5487165
--- /dev/null
+++ b/tk8.6/generic/tkImgUtil.c
@@ -0,0 +1,83 @@
+/*
+ * tkImgUtil.c --
+ *
+ * This file contains image related utility functions.
+ *
+ * Copyright (c) 1995 Sun Microsystems, Inc.
+ *
+ * See the file "license.terms" for information on usage and redistribution of
+ * this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ */
+
+#include "tkInt.h"
+#include "xbytes.h"
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkAlignImageData --
+ *
+ * This function takes an image and copies the data into an aligned
+ * buffer, performing any necessary bit swapping.
+ *
+ * Results:
+ * Returns a newly allocated buffer that should be freed by the caller.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+char *
+TkAlignImageData(
+ XImage *image, /* Image to be aligned. */
+ int alignment, /* Number of bytes to which the data should be
+ * aligned (e.g. 2 or 4) */
+ int bitOrder) /* Desired bit order: LSBFirst or MSBFirst. */
+{
+ long dataWidth;
+ char *data, *srcPtr, *destPtr;
+ int i, j;
+
+ if (image->bits_per_pixel != 1) {
+ Tcl_Panic(
+ "TkAlignImageData: Can't handle image depths greater than 1.");
+ }
+
+ /*
+ * Compute line width for output data buffer.
+ */
+
+ dataWidth = image->bytes_per_line;
+ if (dataWidth % alignment) {
+ dataWidth += (alignment - (dataWidth % alignment));
+ }
+
+ data = ckalloc(dataWidth * image->height);
+
+ destPtr = data;
+ for (i = 0; i < image->height; i++) {
+ srcPtr = &image->data[i * image->bytes_per_line];
+ for (j = 0; j < dataWidth; j++) {
+ if (j >= image->bytes_per_line) {
+ *destPtr = 0;
+ } else if (image->bitmap_bit_order != bitOrder) {
+ *destPtr = xBitReverseTable[(unsigned char)(*(srcPtr++))];
+ } else {
+ *destPtr = *(srcPtr++);
+ }
+ destPtr++;
+ }
+ }
+ return data;
+}
+
+/*
+ * Local Variables:
+ * mode: c
+ * c-basic-offset: 4
+ * fill-column: 78
+ * End:
+ */
diff --git a/tk8.6/generic/tkInt.decls b/tk8.6/generic/tkInt.decls
new file mode 100644
index 0000000..586b407
--- /dev/null
+++ b/tk8.6/generic/tkInt.decls
@@ -0,0 +1,1774 @@
+# 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.
+# Copyright (c) 2007 Daniel A. Steffen <das@users.sourceforge.net>
+#
+# See the file "license.terms" for information on usage and redistribution
+# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+
+library tk
+
+##############################################################################
+
+# Define the unsupported generic interfaces.
+
+interface tkInt
+scspec EXTERN
+
+# 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 {
+ TkWindow *TkAllocWindow(TkDisplay *dispPtr, int screenNum,
+ TkWindow *parentPtr)
+}
+declare 1 {
+ void TkBezierPoints(double control[], int numSteps, double *coordPtr)
+}
+declare 2 {
+ void TkBezierScreenPoints(Tk_Canvas canvas, double control[],
+ int numSteps, XPoint *xPointPtr)
+}
+#
+# Slot 3 unused (WAS: TkBindDeadWindow)
+#
+declare 4 {
+ void TkBindEventProc(TkWindow *winPtr, XEvent *eventPtr)
+}
+declare 5 {
+ void TkBindFree(TkMainInfo *mainPtr)
+}
+declare 6 {
+ void TkBindInit(TkMainInfo *mainPtr)
+}
+declare 7 {
+ void TkChangeEventWindow(XEvent *eventPtr, TkWindow *winPtr)
+}
+declare 8 {
+ int TkClipInit(Tcl_Interp *interp, TkDisplay *dispPtr)
+}
+declare 9 {
+ void TkComputeAnchor(Tk_Anchor anchor, Tk_Window tkwin, int padX, int padY,
+ int innerWidth, int innerHeight, int *xPtr, int *yPtr)
+}
+#
+# Slot 10 unused (WAS: TkCopyAndGlobalEval)
+# Slot 11 unused (WAS: TkCreateBindingProcedure)
+#
+declare 12 {
+ TkCursor *TkCreateCursorFromData(Tk_Window tkwin,
+ const char *source, const char *mask, int width, int height,
+ int xHot, int yHot, XColor fg, XColor bg)
+}
+declare 13 {
+ int TkCreateFrame(ClientData clientData, Tcl_Interp *interp,
+ int argc, const char *const *argv, int toplevel, const char *appName)
+}
+declare 14 {
+ Tk_Window TkCreateMainWindow(Tcl_Interp *interp,
+ const char *screenName, const char *baseName)
+}
+declare 15 {
+ Time TkCurrentTime(TkDisplay *dispPtr)
+}
+declare 16 {
+ void TkDeleteAllImages(TkMainInfo *mainPtr)
+}
+declare 17 {
+ void TkDoConfigureNotify(TkWindow *winPtr)
+}
+declare 18 {
+ void TkDrawInsetFocusHighlight(Tk_Window tkwin, GC gc, int width,
+ Drawable drawable, int padding)
+}
+declare 19 {
+ void TkEventDeadWindow(TkWindow *winPtr)
+}
+declare 20 {
+ void TkFillPolygon(Tk_Canvas canvas, double *coordPtr, int numPoints,
+ Display *display, Drawable drawable, GC gc, GC outlineGC)
+}
+declare 21 {
+ int TkFindStateNum(Tcl_Interp *interp, const char *option,
+ const TkStateMap *mapPtr, const char *strKey)
+}
+declare 22 {
+ CONST86 char *TkFindStateString(const TkStateMap *mapPtr, int numKey)
+}
+declare 23 {
+ void TkFocusDeadWindow(TkWindow *winPtr)
+}
+declare 24 {
+ int TkFocusFilterEvent(TkWindow *winPtr, XEvent *eventPtr)
+}
+declare 25 {
+ TkWindow *TkFocusKeyEvent(TkWindow *winPtr, XEvent *eventPtr)
+}
+declare 26 {
+ void TkFontPkgInit(TkMainInfo *mainPtr)
+}
+declare 27 {
+ void TkFontPkgFree(TkMainInfo *mainPtr)
+}
+declare 28 {
+ void TkFreeBindingTags(TkWindow *winPtr)
+}
+
+# Name change only, TkFreeCursor in Tcl 8.0.x now TkpFreeCursor
+declare 29 {
+ void TkpFreeCursor(TkCursor *cursorPtr)
+}
+declare 30 {
+ char *TkGetBitmapData(Tcl_Interp *interp, const char *string,
+ const char *fileName, int *widthPtr, int *heightPtr,
+ int *hotXPtr, int *hotYPtr)
+}
+declare 31 {
+ void TkGetButtPoints(double p1[], double p2[],
+ double width, int project, double m1[], double m2[])
+}
+declare 32 {
+ TkCursor *TkGetCursorByName(Tcl_Interp *interp,
+ Tk_Window tkwin, Tk_Uid string)
+}
+declare 33 {
+ const char *TkGetDefaultScreenName(Tcl_Interp *interp,
+ const char *screenName)
+}
+declare 34 {
+ TkDisplay *TkGetDisplay(Display *display)
+}
+declare 35 {
+ int TkGetDisplayOf(Tcl_Interp *interp, int objc, Tcl_Obj *const objv[],
+ Tk_Window *tkwinPtr)
+}
+declare 36 {
+ TkWindow *TkGetFocusWin(TkWindow *winPtr)
+}
+declare 37 {
+ int TkGetInterpNames(Tcl_Interp *interp, Tk_Window tkwin)
+}
+declare 38 {
+ int TkGetMiterPoints(double p1[], double p2[], double p3[],
+ double width, double m1[], double m2[])
+}
+declare 39 {
+ void TkGetPointerCoords(Tk_Window tkwin, int *xPtr, int *yPtr)
+}
+declare 40 {
+ void TkGetServerInfo(Tcl_Interp *interp, Tk_Window tkwin)
+}
+declare 41 {
+ void TkGrabDeadWindow(TkWindow *winPtr)
+}
+declare 42 {
+ int TkGrabState(TkWindow *winPtr)
+}
+declare 43 {
+ void TkIncludePoint(Tk_Item *itemPtr, double *pointPtr)
+}
+declare 44 {
+ void TkInOutEvents(XEvent *eventPtr, TkWindow *sourcePtr,
+ TkWindow *destPtr, int leaveType, int enterType,
+ Tcl_QueuePosition position)
+}
+declare 45 {
+ void TkInstallFrameMenu(Tk_Window tkwin)
+}
+declare 46 {
+ CONST86 char *TkKeysymToString(KeySym keysym)
+}
+declare 47 {
+ int TkLineToArea(double end1Ptr[], double end2Ptr[], double rectPtr[])
+}
+declare 48 {
+ double TkLineToPoint(double end1Ptr[], double end2Ptr[], double pointPtr[])
+}
+declare 49 {
+ int TkMakeBezierCurve(Tk_Canvas canvas, double *pointPtr, int numPoints,
+ int numSteps, XPoint xPoints[], double dblPoints[])
+}
+declare 50 {
+ void TkMakeBezierPostscript(Tcl_Interp *interp,
+ Tk_Canvas canvas, double *pointPtr, int numPoints)
+}
+declare 51 {
+ void TkOptionClassChanged(TkWindow *winPtr)
+}
+declare 52 {
+ void TkOptionDeadWindow(TkWindow *winPtr)
+}
+declare 53 {
+ int TkOvalToArea(double *ovalPtr, double *rectPtr)
+}
+declare 54 {
+ double TkOvalToPoint(double ovalPtr[],
+ double width, int filled, double pointPtr[])
+}
+declare 55 {
+ int TkpChangeFocus(TkWindow *winPtr, int force)
+}
+declare 56 {
+ void TkpCloseDisplay(TkDisplay *dispPtr)
+}
+declare 57 {
+ void TkpClaimFocus(TkWindow *topLevelPtr, int force)
+}
+declare 58 {
+ void TkpDisplayWarning(const char *msg, const char *title)
+}
+declare 59 {
+ void TkpGetAppName(Tcl_Interp *interp, Tcl_DString *name)
+}
+declare 60 {
+ TkWindow *TkpGetOtherWindow(TkWindow *winPtr)
+}
+declare 61 {
+ TkWindow *TkpGetWrapperWindow(TkWindow *winPtr)
+}
+declare 62 {
+ int TkpInit(Tcl_Interp *interp)
+}
+declare 63 {
+ void TkpInitializeMenuBindings(Tcl_Interp *interp,
+ Tk_BindingTable bindingTable)
+}
+declare 64 {
+ void TkpMakeContainer(Tk_Window tkwin)
+}
+declare 65 {
+ void TkpMakeMenuWindow(Tk_Window tkwin, int transient)
+}
+declare 66 {
+ Window TkpMakeWindow(TkWindow *winPtr, Window parent)
+}
+declare 67 {
+ void TkpMenuNotifyToplevelCreate(Tcl_Interp *interp, const char *menuName)
+}
+declare 68 {
+ TkDisplay *TkpOpenDisplay(const char *display_name)
+}
+declare 69 {
+ int TkPointerEvent(XEvent *eventPtr, TkWindow *winPtr)
+}
+declare 70 {
+ int TkPolygonToArea(double *polyPtr, int numPoints, double *rectPtr)
+}
+declare 71 {
+ double TkPolygonToPoint(double *polyPtr, int numPoints, double *pointPtr)
+}
+declare 72 {
+ int TkPositionInTree(TkWindow *winPtr, TkWindow *treePtr)
+}
+declare 73 {
+ void TkpRedirectKeyEvent(TkWindow *winPtr, XEvent *eventPtr)
+}
+declare 74 {
+ void TkpSetMainMenubar(Tcl_Interp *interp, Tk_Window tkwin, const char *menuName)
+}
+declare 75 {
+ int TkpUseWindow(Tcl_Interp *interp, Tk_Window tkwin, const char *string)
+}
+#
+# Slot 76 unused (WAS: TkpWindowWasRecentlyDeleted)
+#
+declare 77 {
+ void TkQueueEventForAllChildren(TkWindow *winPtr, XEvent *eventPtr)
+}
+declare 78 {
+ 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 {
+ int TkScrollWindow(Tk_Window tkwin, GC gc, int x, int y,
+ int width, int height, int dx, int dy, TkRegion damageRgn)
+}
+declare 80 {
+ void TkSelDeadWindow(TkWindow *winPtr)
+}
+declare 81 {
+ void TkSelEventProc(Tk_Window tkwin, XEvent *eventPtr)
+}
+declare 82 {
+ void TkSelInit(Tk_Window tkwin)
+}
+declare 83 {
+ void TkSelPropProc(XEvent *eventPtr)
+}
+
+# Exported publically as Tk_SetClassProcs in 8.4a2
+#declare 84 {
+# void TkSetClassProcs(Tk_Window tkwin,
+# TkClassProcs *procs, ClientData instanceData)
+#}
+declare 85 {
+ void TkSetWindowMenuBar(Tcl_Interp *interp, Tk_Window tkwin,
+ const char *oldMenuName, const char *menuName)
+}
+declare 86 {
+ KeySym TkStringToKeysym(const char *name)
+}
+declare 87 {
+ int TkThickPolyLineToArea(double *coordPtr, int numPoints,
+ double width, int capStyle, int joinStyle, double *rectPtr)
+}
+declare 88 {
+ void TkWmAddToColormapWindows(TkWindow *winPtr)
+}
+declare 89 {
+ void TkWmDeadWindow(TkWindow *winPtr)
+}
+declare 90 {
+ TkWindow *TkWmFocusToplevel(TkWindow *winPtr)
+}
+declare 91 {
+ void TkWmMapWindow(TkWindow *winPtr)
+}
+declare 92 {
+ void TkWmNewWindow(TkWindow *winPtr)
+}
+declare 93 {
+ void TkWmProtocolEventProc(TkWindow *winPtr, XEvent *evenvPtr)
+}
+declare 94 {
+ void TkWmRemoveFromColormapWindows(TkWindow *winPtr)
+}
+declare 95 {
+ void TkWmRestackToplevel(TkWindow *winPtr, int aboveBelow,
+ TkWindow *otherPtr)
+}
+declare 96 {
+ void TkWmSetClass(TkWindow *winPtr)
+}
+declare 97 {
+ void TkWmUnmapWindow(TkWindow *winPtr)
+}
+
+# new for 8.1
+
+declare 98 {
+ Tcl_Obj *TkDebugBitmap(Tk_Window tkwin, const char *name)
+}
+declare 99 {
+ Tcl_Obj *TkDebugBorder(Tk_Window tkwin, const char *name)
+}
+declare 100 {
+ Tcl_Obj *TkDebugCursor(Tk_Window tkwin, const char *name)
+}
+declare 101 {
+ Tcl_Obj *TkDebugColor(Tk_Window tkwin, const char *name)
+}
+declare 102 {
+ Tcl_Obj *TkDebugConfig(Tcl_Interp *interp, Tk_OptionTable table)
+}
+declare 103 {
+ Tcl_Obj *TkDebugFont(Tk_Window tkwin, const char *name)
+}
+declare 104 {
+ int TkFindStateNumObj(Tcl_Interp *interp, Tcl_Obj *optionPtr,
+ const TkStateMap *mapPtr, Tcl_Obj *keyPtr)
+}
+declare 105 {
+ Tcl_HashTable *TkGetBitmapPredefTable(void)
+}
+declare 106 {
+ TkDisplay *TkGetDisplayList(void)
+}
+declare 107 {
+ TkMainInfo *TkGetMainInfoList(void)
+}
+declare 108 {
+ int TkGetWindowFromObj(Tcl_Interp *interp, Tk_Window tkwin,
+ Tcl_Obj *objPtr, Tk_Window *windowPtr)
+}
+declare 109 {
+ CONST86 char *TkpGetString(TkWindow *winPtr, XEvent *eventPtr, Tcl_DString *dsPtr)
+}
+declare 110 {
+ void TkpGetSubFonts(Tcl_Interp *interp, Tk_Font tkfont)
+}
+declare 111 {
+ Tcl_Obj *TkpGetSystemDefault(Tk_Window tkwin,
+ const char *dbName, const char *className)
+}
+declare 112 {
+ void TkpMenuThreadInit(void)
+}
+declare 113 {
+ void TkClipBox(TkRegion rgn, XRectangle *rect_return)
+}
+declare 114 {
+ TkRegion TkCreateRegion(void)
+}
+declare 115 {
+ void TkDestroyRegion(TkRegion rgn)
+}
+declare 116 {
+ void TkIntersectRegion(TkRegion sra, TkRegion srcb, TkRegion dr_return)
+}
+declare 117 {
+ int TkRectInRegion(TkRegion rgn, int x, int y, unsigned int width,
+ unsigned int height)
+}
+declare 118 {
+ void TkSetRegion(Display *display, GC gc, TkRegion rgn)
+}
+declare 119 {
+ void TkUnionRectWithRegion(XRectangle *rect,
+ TkRegion src, TkRegion dr_return)
+}
+declare 121 aqua {
+ Pixmap TkpCreateNativeBitmap(Display *display, const void *source)
+}
+declare 122 aqua {
+ void TkpDefineNativeBitmaps(void)
+}
+declare 124 aqua {
+ Pixmap TkpGetNativeAppBitmap(Display *display,
+ const char *name, int *width, int *height)
+}
+declare 135 {
+ void TkpDrawHighlightBorder(Tk_Window tkwin, GC fgGC, GC bgGC,
+ int highlightWidth, Drawable drawable)
+}
+declare 136 {
+ void TkSetFocusWin(TkWindow *winPtr, int force)
+}
+declare 137 {
+ void TkpSetKeycodeAndState(Tk_Window tkwin, KeySym keySym,
+ XEvent *eventPtr)
+}
+declare 138 {
+ KeySym TkpGetKeySym(TkDisplay *dispPtr, XEvent *eventPtr)
+}
+declare 139 {
+ void TkpInitKeymapInfo(TkDisplay *dispPtr)
+}
+declare 140 {
+ TkRegion TkPhotoGetValidRegion(Tk_PhotoHandle handle)
+}
+declare 141 {
+ TkWindow **TkWmStackorderToplevel(TkWindow *parentPtr)
+}
+declare 142 {
+ void TkFocusFree(TkMainInfo *mainPtr)
+}
+declare 143 {
+ void TkClipCleanup(TkDisplay *dispPtr)
+}
+declare 144 {
+ void TkGCCleanup(TkDisplay *dispPtr)
+}
+declare 145 {
+ void TkSubtractRegion(TkRegion sra, TkRegion srcb, TkRegion dr_return)
+}
+declare 146 {
+ void TkStylePkgInit(TkMainInfo *mainPtr)
+}
+declare 147 {
+ void TkStylePkgFree(TkMainInfo *mainPtr)
+}
+declare 148 {
+ Tk_Window TkToplevelWindowForCommand(Tcl_Interp *interp,
+ const char *cmdName)
+}
+declare 149 {
+ const Tk_OptionSpec *TkGetOptionSpec(const char *name,
+ Tk_OptionTable optionTable)
+}
+
+# TIP#168
+declare 150 {
+ int TkMakeRawCurve(Tk_Canvas canvas, double *pointPtr, int numPoints,
+ int numSteps, XPoint xPoints[], double dblPoints[])
+}
+declare 151 {
+ void TkMakeRawCurvePostscript(Tcl_Interp *interp,
+ Tk_Canvas canvas, double *pointPtr, int numPoints)
+}
+declare 152 {
+ void TkpDrawFrame(Tk_Window tkwin, Tk_3DBorder border,
+ int highlightWidth, int borderWidth, int relief)
+}
+declare 153 {
+ void TkCreateThreadExitHandler(Tcl_ExitProc *proc, ClientData clientData)
+}
+declare 154 {
+ void TkDeleteThreadExitHandler(Tcl_ExitProc *proc, ClientData clientData)
+}
+
+# entries needed only by tktest:
+declare 156 {
+ int TkpTestembedCmd(ClientData clientData, Tcl_Interp *interp, int objc,
+ Tcl_Obj *const objv[])
+}
+declare 157 {
+ int TkpTesttextCmd(ClientData dummy, Tcl_Interp *interp, int objc,
+ Tcl_Obj *const objv[])
+}
+declare 158 {
+ int TkSelGetSelection(Tcl_Interp *interp, Tk_Window tkwin,
+ Atom selection, Atom target, Tk_GetSelProc *proc,
+ ClientData clientData)
+}
+declare 159 {
+ int TkTextGetIndex(Tcl_Interp *interp, struct TkText *textPtr,
+ const char *string, struct TkTextIndex *indexPtr)
+}
+declare 160 {
+ int TkTextIndexBackBytes(const struct TkText *textPtr,
+ const struct TkTextIndex *srcPtr, int count,
+ struct TkTextIndex *dstPtr)
+}
+declare 161 {
+ int TkTextIndexForwBytes(const struct TkText *textPtr,
+ const struct TkTextIndex *srcPtr, int count,
+ struct TkTextIndex *dstPtr)
+}
+declare 162 {
+ struct TkTextIndex *TkTextMakeByteIndex(TkTextBTree tree,
+ const struct TkText *textPtr, int lineIndex,
+ int byteIndex, struct TkTextIndex *indexPtr)
+}
+declare 163 {
+ int TkTextPrintIndex(const struct TkText *textPtr,
+ const struct TkTextIndex *indexPtr, char *string)
+}
+declare 164 {
+ struct TkTextSegment *TkTextSetMark(struct TkText *textPtr,
+ const char *name, struct TkTextIndex *indexPtr)
+}
+declare 165 {
+ int TkTextXviewCmd(struct TkText *textPtr, Tcl_Interp *interp,
+ int objc, Tcl_Obj *const objv[])
+}
+declare 166 {
+ void TkTextChanged(struct TkSharedText *sharedTextPtr,
+ struct TkText *textPtr, const struct TkTextIndex *index1Ptr,
+ const struct TkTextIndex *index2Ptr)
+}
+declare 167 {
+ int TkBTreeNumLines(TkTextBTree tree,
+ const struct TkText *textPtr)
+}
+declare 168 {
+ void TkTextInsertDisplayProc(struct TkText *textPtr,
+ struct TkTextDispChunk *chunkPtr, int x, int y,
+ int height, int baseline, Display *display,
+ Drawable dst, int screenY)
+}
+# Next group of functions exposed due to [Bug 2768945].
+declare 169 {
+ int TkStateParseProc(ClientData clientData, Tcl_Interp *interp,
+ Tk_Window tkwin, const char *value, char *widgRec, int offset)
+}
+declare 170 {
+ CONST86 char *TkStatePrintProc(ClientData clientData, Tk_Window tkwin,
+ char *widgRec, int offset, Tcl_FreeProc **freeProcPtr)
+}
+declare 171 {
+ int TkCanvasDashParseProc(ClientData clientData, Tcl_Interp *interp,
+ Tk_Window tkwin, const char *value, char *widgRec, int offset)
+}
+declare 172 {
+ CONST86 char *TkCanvasDashPrintProc(ClientData clientData, Tk_Window tkwin,
+ char *widgRec, int offset, Tcl_FreeProc **freeProcPtr)
+}
+declare 173 {
+ int TkOffsetParseProc(ClientData clientData, Tcl_Interp *interp,
+ Tk_Window tkwin, const char *value, char *widgRec, int offset)
+}
+declare 174 {
+ CONST86 char *TkOffsetPrintProc(ClientData clientData, Tk_Window tkwin,
+ char *widgRec, int offset, Tcl_FreeProc **freeProcPtr)
+}
+declare 175 {
+ int TkPixelParseProc(ClientData clientData, Tcl_Interp *interp,
+ Tk_Window tkwin, const char *value, char *widgRec, int offset)
+}
+declare 176 {
+ CONST86 char *TkPixelPrintProc(ClientData clientData, Tk_Window tkwin,
+ char *widgRec, int offset, Tcl_FreeProc **freeProcPtr)
+}
+declare 177 {
+ int TkOrientParseProc(ClientData clientData, Tcl_Interp *interp,
+ Tk_Window tkwin, const char *value, char *widgRec, int offset)
+}
+declare 178 {
+ CONST86 char *TkOrientPrintProc(ClientData clientData, Tk_Window tkwin,
+ char *widgRec, int offset, Tcl_FreeProc **freeProcPtr)
+}
+declare 179 {
+ int TkSmoothParseProc(ClientData clientData, Tcl_Interp *interp,
+ Tk_Window tkwin, const char *value, char *widgRec, int offset)
+}
+declare 180 {
+ CONST86 char *TkSmoothPrintProc(ClientData clientData, Tk_Window tkwin,
+ char *widgRec, int offset, Tcl_FreeProc **freeProcPtr)
+}
+
+# Angled text API, exposed for Emiliano Gavilán's RBC work.
+declare 181 {
+ void TkDrawAngledTextLayout(Display *display, Drawable drawable, GC gc,
+ Tk_TextLayout layout, int x, int y, double angle, int firstChar,
+ int lastChar)
+}
+declare 182 {
+ void TkUnderlineAngledTextLayout(Display *display, Drawable drawable,
+ GC gc, Tk_TextLayout layout, int x, int y, double angle,
+ int underline)
+}
+declare 183 {
+ int TkIntersectAngledTextLayout(Tk_TextLayout layout, int x, int y,
+ int width, int height, double angle)
+}
+declare 184 {
+ void TkDrawAngledChars(Display *display,Drawable drawable, GC gc,
+ Tk_Font tkfont, const char *source, int numBytes, double x,
+ double y, double angle)
+}
+
+##############################################################################
+
+# Define the platform specific internal Tcl interface. These functions are
+# only available on the designated platform.
+
+interface tkIntPlat
+
+################################
+# Unix specific functions
+
+declare 0 x11 {
+ void TkCreateXEventSource(void)
+}
+#
+# Slot 1 unused (WAS: TkFreeWindowId)
+# Slot 2 unused (WAS: TkInitXId)
+#
+declare 3 x11 {
+ int TkpCmapStressed(Tk_Window tkwin, Colormap colormap)
+}
+declare 4 x11 {
+ void TkpSync(Display *display)
+}
+declare 5 x11 {
+ Window TkUnixContainerId(TkWindow *winPtr)
+}
+declare 6 x11 {
+ int TkUnixDoOneXEvent(Tcl_Time *timePtr)
+}
+declare 7 x11 {
+ void TkUnixSetMenubar(Tk_Window tkwin, Tk_Window menubar)
+}
+declare 8 x11 {
+ int TkpScanWindowId(Tcl_Interp *interp, const char *string, Window *idPtr)
+}
+declare 9 x11 {
+ void TkWmCleanup(TkDisplay *dispPtr)
+}
+declare 10 x11 {
+ void TkSendCleanup(TkDisplay *dispPtr)
+}
+#
+# Slot 11 unused (WAS: TkFreeXId)
+#
+declare 12 x11 {
+ int TkpWmSetState(TkWindow *winPtr, int state)
+}
+# only needed by tktest:
+declare 13 x11 {
+ int TkpTestsendCmd(ClientData clientData, Tcl_Interp *interp, int objc,
+ Tcl_Obj *const objv[])
+}
+
+################################
+# Windows specific functions
+
+declare 0 win {
+ char *TkAlignImageData(XImage *image, int alignment, int bitOrder)
+}
+declare 2 win {
+ void TkGenerateActivateEvents(TkWindow *winPtr, int active)
+}
+declare 3 win {
+ unsigned long TkpGetMS(void)
+}
+declare 4 win {
+ void TkPointerDeadWindow(TkWindow *winPtr)
+}
+declare 5 win {
+ void TkpPrintWindowId(char *buf, Window window)
+}
+declare 6 win {
+ int TkpScanWindowId(Tcl_Interp *interp, const char *string, Window *idPtr)
+}
+declare 7 win {
+ void TkpSetCapture(TkWindow *winPtr)
+}
+declare 8 win {
+ void TkpSetCursor(TkpCursor cursor)
+}
+declare 9 win {
+ int 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(ClientData clientData)
+}
+declare 29 win {
+ void TkWinXInit(HINSTANCE hInstance)
+}
+
+# new for 8.1
+
+declare 30 win {
+ void TkWinSetForegroundWindow(TkWindow *winPtr)
+}
+declare 31 win {
+ void TkWinDialogDebug(int debug)
+}
+declare 32 win {
+ Tcl_Obj *TkWinGetMenuSystemDefault(Tk_Window tkwin,
+ const char *dbName, const char *className)
+}
+declare 33 win {
+ int TkWinGetPlatformId(void)
+}
+
+# new for 8.4.1
+
+declare 34 win {
+ void TkWinSetHINSTANCE(HINSTANCE hInstance)
+}
+declare 35 win {
+ int TkWinGetPlatformTheme(void)
+}
+
+# Exported through stub table since Tk 8.4.20/8.5.9
+
+declare 36 win {
+ LRESULT __stdcall TkWinChildProc(HWND hwnd,
+ UINT message, WPARAM wParam, LPARAM lParam)
+}
+
+# new for 8.4.20+/8.5.12+, Cygwin only
+declare 37 win {
+ void TkCreateXEventSource(void)
+}
+declare 38 win {
+ int TkpCmapStressed(Tk_Window tkwin, Colormap colormap)
+}
+declare 39 win {
+ void TkpSync(Display *display)
+}
+declare 40 win {
+ Window TkUnixContainerId(TkWindow *winPtr)
+}
+declare 41 win {
+ int TkUnixDoOneXEvent(Tcl_Time *timePtr)
+}
+declare 42 win {
+ void TkUnixSetMenubar(Tk_Window tkwin, Tk_Window menubar)
+}
+declare 43 win {
+ void TkWmCleanup(TkDisplay *dispPtr)
+}
+declare 44 win {
+ void TkSendCleanup(TkDisplay *dispPtr)
+}
+# only needed by tktest:
+declare 45 win {
+ int TkpTestsendCmd(ClientData clientData, Tcl_Interp *interp, int objc,
+ Tcl_Obj *const objv[])
+}
+
+################################
+# Aqua specific functions
+
+declare 0 aqua {
+ void TkGenerateActivateEvents(TkWindow *winPtr, int active)
+}
+
+# removed duplicates from tkInt table
+#declare 1 aqua {
+# Pixmap TkpCreateNativeBitmap(Display *display, const void *source)
+#}
+#
+#declare 2 aqua {
+# void TkpDefineNativeBitmaps(void)
+#}
+
+declare 3 aqua {
+ void TkPointerDeadWindow(TkWindow *winPtr)
+}
+declare 4 aqua {
+ void TkpSetCapture(TkWindow *winPtr)
+}
+declare 5 aqua {
+ void TkpSetCursor(TkpCursor cursor)
+}
+declare 6 aqua {
+ void TkpWmSetState(TkWindow *winPtr, int state)
+}
+declare 7 aqua {
+ void TkAboutDlg(void)
+}
+declare 8 aqua {
+ unsigned int TkMacOSXButtonKeyState(void)
+}
+declare 9 aqua {
+ void TkMacOSXClearMenubarActive(void)
+}
+declare 10 aqua {
+ int TkMacOSXDispatchMenuEvent(int menuID, int index)
+}
+declare 11 aqua {
+ void TkMacOSXInstallCursor(int resizeOverride)
+}
+declare 12 aqua {
+ void TkMacOSXHandleTearoffMenu(void)
+}
+
+# removed duplicate from tkPlat table(tk.decls)
+#declare 13 aqua {
+# void TkMacOSXInvalClipRgns(TkWindow *winPtr)
+#}
+
+declare 14 aqua {
+ int TkMacOSXDoHLEvent(void *theEvent)
+}
+
+# removed duplicate from tkPlat table(tk.decls)
+#declare 15 aqua {
+# void *TkMacOSXGetDrawablePort(Drawable drawable)
+#}
+
+declare 16 aqua {
+ Window TkMacOSXGetXWindow(void *macWinPtr)
+}
+declare 17 aqua {
+ int TkMacOSXGrowToplevel(void *whichWindow, XPoint start)
+}
+declare 18 aqua {
+ void TkMacOSXHandleMenuSelect(short theMenu, unsigned short theItem,
+ int optionKeyPressed)
+}
+
+# removed duplicates from tkPlat table(tk.decls)
+#declare 19 aqua {
+# void TkMacOSXInitAppleEvents(Tcl_Interp *interp)
+#}
+#
+#declare 20 aqua {
+# void TkMacOSXInitMenus(Tcl_Interp *interp)
+#}
+
+declare 21 aqua {
+ void TkMacOSXInvalidateWindow(MacDrawable *macWin, int flag)
+}
+declare 22 aqua {
+ int TkMacOSXIsCharacterMissing(Tk_Font tkfont, unsigned int searchChar)
+}
+declare 23 aqua {
+ void TkMacOSXMakeRealWindowExist(TkWindow *winPtr)
+}
+declare 24 aqua {
+ void *TkMacOSXMakeStippleMap(Drawable d1, Drawable d2)
+}
+declare 25 aqua {
+ void TkMacOSXMenuClick(void)
+}
+declare 26 aqua {
+ void TkMacOSXRegisterOffScreenWindow(Window window, void *portPtr)
+}
+declare 27 aqua {
+ int TkMacOSXResizable(TkWindow *winPtr)
+}
+declare 28 aqua {
+ void TkMacOSXSetHelpMenuItemCount(void)
+}
+declare 29 aqua {
+ void TkMacOSXSetScrollbarGrow(TkWindow *winPtr, int flag)
+}
+declare 30 aqua {
+ void TkMacOSXSetUpClippingRgn(Drawable drawable)
+}
+declare 31 aqua {
+ void TkMacOSXSetUpGraphicsPort(GC gc, void *destPort)
+}
+declare 32 aqua {
+ void TkMacOSXUpdateClipRgn(TkWindow *winPtr)
+}
+declare 33 aqua {
+ void TkMacOSXUnregisterMacWindow(void *portPtr)
+}
+declare 34 aqua {
+ int TkMacOSXUseMenuID(short macID)
+}
+declare 35 aqua {
+ TkRegion TkMacOSXVisableClipRgn(TkWindow *winPtr)
+}
+declare 36 aqua {
+ void TkMacOSXWinBounds(TkWindow *winPtr, void *geometry)
+}
+declare 37 aqua {
+ void TkMacOSXWindowOffset(void *wRef, int *xOffset, int *yOffset)
+}
+declare 38 aqua {
+ int TkSetMacColor(unsigned long pixel, void *macColor)
+}
+declare 39 aqua {
+ void TkSetWMName(TkWindow *winPtr, Tk_Uid titleUid)
+}
+declare 40 aqua {
+ void TkSuspendClipboard(void)
+}
+declare 41 aqua {
+ int TkMacOSXZoomToplevel(void *whichWindow, short zoomPart)
+}
+declare 42 aqua {
+ Tk_Window Tk_TopCoordsToWindow(Tk_Window tkwin, int rootX, int rootY,
+ int *newX, int *newY)
+}
+declare 43 aqua {
+ MacDrawable *TkMacOSXContainerId(TkWindow *winPtr)
+}
+declare 44 aqua {
+ MacDrawable *TkMacOSXGetHostToplevel(TkWindow *winPtr)
+}
+declare 45 aqua {
+ void TkMacOSXPreprocessMenu(void)
+}
+declare 46 aqua {
+ int TkpIsWindowFloating(void *window)
+}
+declare 47 aqua {
+ Tk_Window TkMacOSXGetCapture(void)
+}
+declare 49 aqua {
+ Window TkGetTransientMaster(TkWindow *winPtr)
+}
+declare 50 aqua {
+ int TkGenerateButtonEvent(int x, int y, Window window, unsigned int state)
+}
+declare 51 aqua {
+ void TkGenWMDestroyEvent(Tk_Window tkwin)
+}
+declare 52 aqua {
+ void TkMacOSXSetDrawingEnabled(TkWindow *winPtr, int flag)
+}
+
+# removed duplicate from tkPlat table (tk.decls)
+#declare 52 aqua {
+# void TkGenWMConfigureEvent(Tk_Window tkwin, int x, int y,
+# int width, int height, int flags)
+#}
+
+declare 53 aqua {
+ unsigned long TkpGetMS(void)
+}
+
+# For Canvas3d, requested by Sean Woods
+declare 54 aqua {
+ void *TkMacOSXDrawable(Drawable drawable)
+}
+declare 55 aqua {
+ int TkpScanWindowId(Tcl_Interp *interp, const char *string, Window *idPtr)
+}
+
+##############################################################################
+
+# Define the platform specific internal Xlib interfaces. These functions are
+# only available on the designated platform.
+
+interface tkIntXlib
+
+################################
+# X functions for Windows
+
+declare 0 win {
+ int XSetDashes(Display *display, GC gc, int dash_offset,
+ _Xconst char *dash_list, int n)
+}
+declare 1 win {
+ XModifierKeymap *XGetModifierMapping(Display *d)
+}
+declare 2 win {
+ XImage *XCreateImage(Display *d, Visual *v, unsigned int ui1, int i1,
+ int i2, char *cp, unsigned int ui2, unsigned int ui3, int i3,
+ int i4)
+}
+declare 3 win {
+ XImage *XGetImage(Display *d, Drawable dr, int i1, int i2,
+ unsigned int ui1, unsigned int ui2, unsigned long ul, int i3)
+}
+declare 4 win {
+ char *XGetAtomName(Display *d, Atom a)
+}
+declare 5 win {
+ char *XKeysymToString(KeySym k)
+}
+declare 6 win {
+ Colormap XCreateColormap(Display *d, Window w, Visual *v, int i)
+}
+declare 7 win {
+ Cursor XCreatePixmapCursor(Display *d, Pixmap p1, Pixmap p2,
+ XColor *x1, XColor *x2, unsigned int ui1, unsigned int ui2)
+}
+declare 8 win {
+ Cursor XCreateGlyphCursor(Display *d, Font f1, Font f2,
+ unsigned int ui1, unsigned int ui2, XColor _Xconst *x1,
+ XColor _Xconst *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 {
+ int XBell(Display *d, int i)
+}
+declare 20 win {
+ int XChangeProperty(Display *d, Window w, Atom a1, Atom a2, int i1,
+ int i2, _Xconst unsigned char *c, int i3)
+}
+declare 21 win {
+ int XChangeWindowAttributes(Display *d, Window w, unsigned long ul,
+ XSetWindowAttributes *x)
+}
+declare 22 win {
+ int XClearWindow(Display *d, Window w)
+}
+declare 23 win {
+ int XConfigureWindow(Display *d, Window w, unsigned int i,
+ XWindowChanges *x)
+}
+declare 24 win {
+ int 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 {
+ int 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 {
+ int XDefineCursor(Display *d, Window w, Cursor c)
+}
+declare 28 win {
+ int XDeleteProperty(Display *d, Window w, Atom a)
+}
+declare 29 win {
+ int XDestroyWindow(Display *d, Window w)
+}
+declare 30 win {
+ int XDrawArc(Display *d, Drawable dr, GC g, int i1, int i2,
+ unsigned int ui1, unsigned int ui2, int i3, int i4)
+}
+declare 31 win {
+ int XDrawLines(Display *d, Drawable dr, GC g, XPoint *x, int i1, int i2)
+}
+declare 32 win {
+ int XDrawRectangle(Display *d, Drawable dr, GC g, int i1, int i2,
+ unsigned int ui1, unsigned int ui2)
+}
+declare 33 win {
+ int XFillArc(Display *d, Drawable dr, GC g, int i1, int i2,
+ unsigned int ui1, unsigned int ui2, int i3, int i4)
+}
+declare 34 win {
+ int XFillPolygon(Display *d, Drawable dr, GC g, XPoint *x,
+ int i1, int i2, int i3)
+}
+declare 35 win {
+ int XFillRectangles(Display *d, Drawable dr, GC g, XRectangle *x, int i)
+}
+declare 36 win {
+ int XForceScreenSaver(Display *d, int i)
+}
+declare 37 win {
+ int XFreeColormap(Display *d, Colormap c)
+}
+declare 38 win {
+ int XFreeColors(Display *d, Colormap c,
+ unsigned long *ulp, int i, unsigned long ul)
+}
+declare 39 win {
+ int XFreeCursor(Display *d, Cursor c)
+}
+declare 40 win {
+ int 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 {
+ int 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 {
+ int XMapWindow(Display *d, Window w)
+}
+declare 50 win {
+ int XMoveResizeWindow(Display *d, Window w, int i1, int i2,
+ unsigned int ui1, unsigned int ui2)
+}
+declare 51 win {
+ int XMoveWindow(Display *d, Window w, int i1, int i2)
+}
+declare 52 win {
+ int XNextEvent(Display *d, XEvent *x)
+}
+declare 53 win {
+ int XPutBackEvent(Display *d, XEvent *x)
+}
+declare 54 win {
+ int 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 {
+ int XRaiseWindow(Display *d, Window w)
+}
+declare 58 win {
+ int XRefreshKeyboardMapping(XMappingEvent *x)
+}
+declare 59 win {
+ int XResizeWindow(Display *d, Window w, unsigned int ui1,
+ unsigned int ui2)
+}
+declare 60 win {
+ int 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 {
+ int XSetCommand(Display *d, Window w, char **c, int i)
+}
+declare 63 win {
+ int XSetIconName(Display *d, Window w, _Xconst char *c)
+}
+declare 64 win {
+ int XSetInputFocus(Display *d, Window w, int i, Time t)
+}
+declare 65 win {
+ int XSetSelectionOwner(Display *d, Atom a, Window w, Time t)
+}
+declare 66 win {
+ int XSetWindowBackground(Display *d, Window w, unsigned long ul)
+}
+declare 67 win {
+ int XSetWindowBackgroundPixmap(Display *d, Window w, Pixmap p)
+}
+declare 68 win {
+ int XSetWindowBorder(Display *d, Window w, unsigned long ul)
+}
+declare 69 win {
+ int XSetWindowBorderPixmap(Display *d, Window w, Pixmap p)
+}
+declare 70 win {
+ int XSetWindowBorderWidth(Display *d, Window w, unsigned int ui)
+}
+declare 71 win {
+ int 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 {
+ int XUngrabKeyboard(Display *d, Time t)
+}
+declare 74 win {
+ int XUngrabPointer(Display *d, Time t)
+}
+declare 75 win {
+ int XUnmapWindow(Display *d, Window w)
+}
+declare 76 win {
+ int 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 {
+ int 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 {
+ int XFreeGC(Display *display, GC gc)
+}
+declare 85 win {
+ Atom XInternAtom(Display *display, _Xconst char *atom_name,
+ Bool only_if_exists)
+}
+declare 86 win {
+ int XSetBackground(Display *display, GC gc, unsigned long foreground)
+}
+declare 87 win {
+ int XSetForeground(Display *display, GC gc, unsigned long foreground)
+}
+declare 88 win {
+ int XSetClipMask(Display *display, GC gc, Pixmap pixmap)
+}
+declare 89 win {
+ int XSetClipOrigin(Display *display, GC gc,
+ int clip_x_origin, int clip_y_origin)
+}
+declare 90 win {
+ int XSetTSOrigin(Display *display, GC gc,
+ int ts_x_origin, int ts_y_origin)
+}
+declare 91 win {
+ int XChangeGC(Display *d, GC gc, unsigned long mask, XGCValues *values)
+}
+declare 92 win {
+ int XSetFont(Display *display, GC gc, Font font)
+}
+declare 93 win {
+ int XSetArcMode(Display *display, GC gc, int arc_mode)
+}
+declare 94 win {
+ int XSetStipple(Display *display, GC gc, Pixmap stipple)
+}
+declare 95 win {
+ int XSetFillRule(Display *display, GC gc, int fill_rule)
+}
+declare 96 win {
+ int XSetFillStyle(Display *display, GC gc, int fill_style)
+}
+declare 97 win {
+ int XSetFunction(Display *display, GC gc, int function)
+}
+declare 98 win {
+ int 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(XIM xim, ...)
+}
+declare 101 win {
+ XVisualInfo *XGetVisualInfo(Display *display, long vinfo_mask,
+ XVisualInfo *vinfo_template, int *nitems_return)
+}
+declare 102 win {
+ void XSetWMClientMachine(Display *display, Window w,
+ XTextProperty *text_prop)
+}
+declare 103 win {
+ Status XStringListToTextProperty(char **list, int count,
+ XTextProperty *text_prop_return)
+}
+declare 104 win {
+ int XDrawLine(Display *d, Drawable dr, GC g, int x1, int y1,
+ int x2, int y2)
+}
+declare 105 win {
+ int XWarpPointer(Display *d, Window s, Window dw, int sx, int sy,
+ unsigned int sw, unsigned int sh, int dx, int dy)
+}
+declare 106 win {
+ int XFillRectangle(Display *display, Drawable d, GC gc,
+ int x, int y, unsigned int width, unsigned int height)
+}
+
+# New in Tk 8.6
+declare 107 win {
+ int XFlush(Display *display)
+}
+declare 108 win {
+ int XGrabServer(Display *display)
+}
+declare 109 win {
+ int XUngrabServer(Display *display)
+}
+declare 110 win {
+ int XFree(void *data)
+}
+declare 111 win {
+ int XNoOp(Display *display)
+}
+declare 112 win {
+ XAfterFunction XSynchronize(Display *display, Bool onoff)
+}
+declare 113 win {
+ int XSync(Display *display, Bool discard)
+}
+declare 114 win {
+ VisualID XVisualIDFromVisual(Visual *visual)
+}
+
+################################
+# X functions for Aqua
+
+declare 0 aqua {
+ int XSetDashes(Display *display, GC gc, int dash_offset,
+ _Xconst char *dash_list, int n)
+}
+declare 1 aqua {
+ XModifierKeymap *XGetModifierMapping(Display *d)
+}
+declare 2 aqua {
+ XImage *XCreateImage(Display *d, Visual *v, unsigned int ui1, int i1,
+ int i2, char *cp, unsigned int ui2, unsigned int ui3, int i3,
+ int i4)
+}
+declare 3 aqua {
+ XImage *XGetImage(Display *d, Drawable dr, int i1, int i2,
+ unsigned int ui1, unsigned int ui2, unsigned long ul, int i3)
+}
+declare 4 aqua {
+ char *XGetAtomName(Display *d, Atom a)
+}
+declare 5 aqua {
+ char *XKeysymToString(KeySym k)
+}
+declare 6 aqua {
+ Colormap XCreateColormap(Display *d, Window w, Visual *v, int i)
+}
+declare 7 aqua {
+ GContext XGContextFromGC(GC g)
+}
+declare 8 aqua {
+ KeySym XKeycodeToKeysym(Display *d, KeyCode k, int i)
+}
+declare 9 aqua {
+ KeySym XStringToKeysym(_Xconst char *c)
+}
+declare 10 aqua {
+ Window XRootWindow(Display *d, int i)
+}
+declare 11 aqua {
+ XErrorHandler XSetErrorHandler(XErrorHandler x)
+}
+declare 12 aqua {
+ Status XAllocColor(Display *d, Colormap c, XColor *xp)
+}
+declare 13 aqua {
+ int XBell(Display *d, int i)
+}
+declare 14 aqua {
+ void XChangeProperty(Display *d, Window w, Atom a1, Atom a2, int i1,
+ int i2, _Xconst unsigned char *c, int i3)
+}
+declare 15 aqua {
+ void XChangeWindowAttributes(Display *d, Window w, unsigned long ul,
+ XSetWindowAttributes *x)
+}
+declare 16 aqua {
+ void XConfigureWindow(Display *d, Window w, unsigned int i,
+ XWindowChanges *x)
+}
+declare 17 aqua {
+ void XCopyArea(Display *d, Drawable dr1, Drawable dr2, GC g, int i1,
+ int i2, unsigned int ui1, unsigned int ui2, int i3, int i4)
+}
+declare 18 aqua {
+ void XCopyPlane(Display *d, Drawable dr1, Drawable dr2, GC g, int i1,
+ int i2, unsigned int ui1,
+ unsigned int ui2, int i3, int i4, unsigned long ul)
+}
+declare 19 aqua {
+ Pixmap XCreateBitmapFromData(Display *display, Drawable d,
+ _Xconst char *data, unsigned int width, unsigned int height)
+}
+declare 20 aqua {
+ int XDefineCursor(Display *d, Window w, Cursor c)
+}
+declare 21 aqua {
+ void XDestroyWindow(Display *d, Window w)
+}
+declare 22 aqua {
+ void XDrawArc(Display *d, Drawable dr, GC g, int i1, int i2,
+ unsigned int ui1, unsigned int ui2, int i3, int i4)
+}
+declare 23 aqua {
+ int XDrawLines(Display *d, Drawable dr, GC g, XPoint *x, int i1, int i2)
+}
+declare 24 aqua {
+ void XDrawRectangle(Display *d, Drawable dr, GC g, int i1, int i2,
+ unsigned int ui1, unsigned int ui2)
+}
+declare 25 aqua {
+ void XFillArc(Display *d, Drawable dr, GC g, int i1, int i2,
+ unsigned int ui1, unsigned int ui2, int i3, int i4)
+}
+declare 26 aqua {
+ void XFillPolygon(Display *d, Drawable dr, GC g, XPoint *x,
+ int i1, int i2, int i3)
+}
+declare 27 aqua {
+ int XFillRectangles(Display *d, Drawable dr, GC g, XRectangle *x, int i)
+}
+declare 28 aqua {
+ int XFreeColormap(Display *d, Colormap c)
+}
+declare 29 aqua {
+ int XFreeColors(Display *d, Colormap c,
+ unsigned long *ulp, int i, unsigned long ul)
+}
+declare 30 aqua {
+ int XFreeModifiermap(XModifierKeymap *x)
+}
+declare 31 aqua {
+ Status XGetGeometry(Display *d, Drawable dr, Window *w, int *i1,
+ int *i2, unsigned int *ui1, unsigned int *ui2, unsigned int *ui3,
+ unsigned int *ui4)
+}
+declare 32 aqua {
+ int XGetWindowProperty(Display *d, Window w, Atom a1, long l1, long l2,
+ Bool b, Atom a2, Atom *ap, int *ip, unsigned long *ulp1,
+ unsigned long *ulp2, unsigned char **cpp)
+}
+declare 33 aqua {
+ int XGrabKeyboard(Display *d, Window w, Bool b, int i1, int i2, Time t)
+}
+declare 34 aqua {
+ int XGrabPointer(Display *d, Window w1, Bool b, unsigned int ui,
+ int i1, int i2, Window w2, Cursor c, Time t)
+}
+declare 35 aqua {
+ KeyCode XKeysymToKeycode(Display *d, KeySym k)
+}
+declare 36 aqua {
+ void XMapWindow(Display *d, Window w)
+}
+declare 37 aqua {
+ void XMoveResizeWindow(Display *d, Window w, int i1, int i2,
+ unsigned int ui1, unsigned int ui2)
+}
+declare 38 aqua {
+ void XMoveWindow(Display *d, Window w, int i1, int i2)
+}
+declare 39 aqua {
+ Bool XQueryPointer(Display *d, Window w1, Window *w2, Window *w3,
+ int *i1, int *i2, int *i3, int *i4, unsigned int *ui)
+}
+declare 40 aqua {
+ void XRaiseWindow(Display *d, Window w)
+}
+declare 41 aqua {
+ void XRefreshKeyboardMapping(XMappingEvent *x)
+}
+declare 42 aqua {
+ void XResizeWindow(Display *d, Window w, unsigned int ui1,
+ unsigned int ui2)
+}
+declare 43 aqua {
+ void XSelectInput(Display *d, Window w, long l)
+}
+declare 44 aqua {
+ Status XSendEvent(Display *d, Window w, Bool b, long l, XEvent *x)
+}
+declare 45 aqua {
+ void XSetIconName(Display *d, Window w, _Xconst char *c)
+}
+declare 46 aqua {
+ void XSetInputFocus(Display *d, Window w, int i, Time t)
+}
+declare 47 aqua {
+ int XSetSelectionOwner(Display *d, Atom a, Window w, Time t)
+}
+declare 48 aqua {
+ void XSetWindowBackground(Display *d, Window w, unsigned long ul)
+}
+declare 49 aqua {
+ void XSetWindowBackgroundPixmap(Display *d, Window w, Pixmap p)
+}
+declare 50 aqua {
+ void XSetWindowBorder(Display *d, Window w, unsigned long ul)
+}
+declare 51 aqua {
+ void XSetWindowBorderPixmap(Display *d, Window w, Pixmap p)
+}
+declare 52 aqua {
+ void XSetWindowBorderWidth(Display *d, Window w, unsigned int ui)
+}
+declare 53 aqua {
+ void XSetWindowColormap(Display *d, Window w, Colormap c)
+}
+declare 54 aqua {
+ void XUngrabKeyboard(Display *d, Time t)
+}
+declare 55 aqua {
+ int XUngrabPointer(Display *d, Time t)
+}
+declare 56 aqua {
+ void XUnmapWindow(Display *d, Window w)
+}
+declare 57 aqua {
+ int 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 aqua {
+ Status XParseColor(Display *display, Colormap map,
+ _Xconst char *spec, XColor *colorPtr)
+}
+declare 59 aqua {
+ GC XCreateGC(Display *display, Drawable d,
+ unsigned long valuemask, XGCValues *values)
+}
+declare 60 aqua {
+ int XFreeGC(Display *display, GC gc)
+}
+declare 61 aqua {
+ Atom XInternAtom(Display *display, _Xconst char *atom_name,
+ Bool only_if_exists)
+}
+declare 62 aqua {
+ int XSetBackground(Display *display, GC gc, unsigned long foreground)
+}
+declare 63 aqua {
+ int XSetForeground(Display *display, GC gc, unsigned long foreground)
+}
+declare 64 aqua {
+ int XSetClipMask(Display *display, GC gc, Pixmap pixmap)
+}
+declare 65 aqua {
+ int XSetClipOrigin(Display *display, GC gc,
+ int clip_x_origin, int clip_y_origin)
+}
+declare 66 aqua {
+ int XSetTSOrigin(Display *display, GC gc,
+ int ts_x_origin, int ts_y_origin)
+}
+declare 67 aqua {
+ int XChangeGC(Display *d, GC gc, unsigned long mask, XGCValues *values)
+}
+declare 68 aqua {
+ int XSetFont(Display *display, GC gc, Font font)
+}
+declare 69 aqua {
+ int XSetArcMode(Display *display, GC gc, int arc_mode)
+}
+declare 70 aqua {
+ int XSetStipple(Display *display, GC gc, Pixmap stipple)
+}
+declare 71 aqua {
+ int XSetFillRule(Display *display, GC gc, int fill_rule)
+}
+declare 72 aqua {
+ int XSetFillStyle(Display *display, GC gc, int fill_style)
+}
+declare 73 aqua {
+ int XSetFunction(Display *display, GC gc, int function)
+}
+declare 74 aqua {
+ int XSetLineAttributes(Display *display, GC gc, unsigned int line_width,
+ int line_style, int cap_style, int join_style)
+}
+declare 75 aqua {
+ int _XInitImageFuncPtrs(XImage *image)
+}
+declare 76 aqua {
+ XIC XCreateIC(void)
+}
+declare 77 aqua {
+ XVisualInfo *XGetVisualInfo(Display *display, long vinfo_mask,
+ XVisualInfo *vinfo_template, int *nitems_return)
+}
+declare 78 aqua {
+ void XSetWMClientMachine(Display *display, Window w,
+ XTextProperty *text_prop)
+}
+declare 79 aqua {
+ Status XStringListToTextProperty(char **list, int count,
+ XTextProperty *text_prop_return)
+}
+declare 80 aqua {
+ void XDrawSegments(Display *display, Drawable d, GC gc,
+ XSegment *segments, int nsegments)
+}
+declare 81 aqua {
+ void XForceScreenSaver(Display *display, int mode)
+}
+declare 82 aqua {
+ int XDrawLine(Display *d, Drawable dr, GC g, int x1, int y1,
+ int x2, int y2)
+}
+declare 83 aqua {
+ int XFillRectangle(Display *display, Drawable d, GC gc,
+ int x, int y, unsigned int width, unsigned int height)
+}
+declare 84 aqua {
+ void XClearWindow(Display *d, Window w)
+}
+declare 85 aqua {
+ void XDrawPoint(Display *display, Drawable d, GC gc, int x, int y)
+}
+declare 86 aqua {
+ void XDrawPoints(Display *display, Drawable d, GC gc, XPoint *points,
+ int npoints, int mode)
+}
+declare 87 aqua {
+ int XWarpPointer(Display *display, Window src_w, Window dest_w,
+ int src_x, int src_y, unsigned int src_width,
+ unsigned int src_height, int dest_x, int dest_y)
+}
+declare 88 aqua {
+ void XQueryColor(Display *display, Colormap colormap, XColor *def_in_out)
+}
+declare 89 aqua {
+ void XQueryColors(Display *display, Colormap colormap,
+ XColor *defs_in_out, int ncolors)
+}
+declare 90 aqua {
+ Status XQueryTree(Display *d, Window w1, Window *w2, Window *w3,
+ Window **w4, unsigned int *ui)
+}
+declare 91 aqua {
+ int XSync(Display *display, Bool flag)
+}
+
+# Local Variables:
+# mode: tcl
+# End:
diff --git a/tk8.6/generic/tkInt.h b/tk8.6/generic/tkInt.h
new file mode 100644
index 0000000..dd5dcad
--- /dev/null
+++ b/tk8.6/generic/tkInt.h
@@ -0,0 +1,1264 @@
+/*
+ * tkInt.h --
+ *
+ * Declarations for things used internally by the Tk functions but not
+ * exported outside the module.
+ *
+ * Copyright (c) 1990-1994 The Regents of the University of California.
+ * Copyright (c) 1994-1997 Sun Microsystems, Inc.
+ * Copyright (c) 1998 by Scriptics Corporation.
+ *
+ * See the file "license.terms" for information on usage and redistribution of
+ * this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ */
+
+#ifndef _TKINT
+#define _TKINT
+
+#ifndef _TKPORT
+#include "tkPort.h"
+#endif
+
+/*
+ * Ensure WORDS_BIGENDIAN is defined correctly:
+ * Needs to happen here in addition to configure to work with fat compiles on
+ * Darwin (where configure runs only once for multiple architectures).
+ */
+
+#include <stdio.h>
+#ifdef HAVE_SYS_TYPES_H
+# include <sys/types.h>
+#endif
+#ifdef HAVE_SYS_PARAM_H
+# include <sys/param.h>
+#endif
+#ifdef BYTE_ORDER
+# ifdef BIG_ENDIAN
+# if BYTE_ORDER == BIG_ENDIAN
+# undef WORDS_BIGENDIAN
+# define WORDS_BIGENDIAN 1
+# endif
+# endif
+# ifdef LITTLE_ENDIAN
+# if BYTE_ORDER == LITTLE_ENDIAN
+# undef WORDS_BIGENDIAN
+# endif
+# endif
+#endif
+
+/*
+ * Used to tag functions that are only to be visible within the module being
+ * built and not outside it (where this is supported by the linker).
+ */
+
+#ifndef MODULE_SCOPE
+# ifdef __cplusplus
+# define MODULE_SCOPE extern "C"
+# else
+# define MODULE_SCOPE extern
+# endif
+#endif
+
+/*
+ * Macros used to cast between pointers and integers (e.g. when storing an int
+ * in ClientData), on 64-bit architectures they avoid gcc warning about "cast
+ * to/from pointer from/to integer of different size".
+ */
+
+#if !defined(INT2PTR) && !defined(PTR2INT)
+# if defined(HAVE_INTPTR_T) || defined(intptr_t)
+# define INT2PTR(p) ((void*)(intptr_t)(p))
+# define PTR2INT(p) ((int)(intptr_t)(p))
+# else
+# define INT2PTR(p) ((void*)(p))
+# define PTR2INT(p) ((int)(p))
+# endif
+#endif
+#if !defined(UINT2PTR) && !defined(PTR2UINT)
+# if defined(HAVE_UINTPTR_T) || defined(uintptr_t)
+# define UINT2PTR(p) ((void*)(uintptr_t)(p))
+# define PTR2UINT(p) ((unsigned int)(uintptr_t)(p))
+# else
+# define UINT2PTR(p) ((void*)(p))
+# define PTR2UINT(p) ((unsigned int)(p))
+# endif
+#endif
+
+/*
+ * Opaque type declarations:
+ */
+
+typedef struct TkColormap TkColormap;
+typedef struct TkFontAttributes TkFontAttributes;
+typedef struct TkGrabEvent TkGrabEvent;
+typedef struct TkpCursor_ *TkpCursor;
+typedef struct TkRegion_ *TkRegion;
+typedef struct TkStressedCmap TkStressedCmap;
+typedef struct TkBindInfo_ *TkBindInfo;
+typedef struct Busy *TkBusy;
+
+/*
+ * One of the following structures is maintained for each cursor in use in the
+ * system. This structure is used by tkCursor.c and the various system-
+ * specific cursor files.
+ */
+
+typedef struct TkCursor {
+ Tk_Cursor cursor; /* System specific identifier for cursor. */
+ Display *display; /* Display containing cursor. Needed for
+ * disposal and retrieval of cursors. */
+ int resourceRefCount; /* Number of active uses of this cursor (each
+ * active use corresponds to a call to
+ * Tk_AllocPreserveFromObj or Tk_Preserve). If
+ * this count is 0, then this structure is no
+ * longer valid and it isn't present in a hash
+ * table: it is being kept around only because
+ * there are objects referring to it. The
+ * structure is freed when resourceRefCount
+ * and objRefCount are both 0. */
+ int objRefCount; /* Number of Tcl objects that reference this
+ * structure.. */
+ Tcl_HashTable *otherTable; /* Second table (other than idTable) used to
+ * index this entry. */
+ Tcl_HashEntry *hashPtr; /* Entry in otherTable for this structure
+ * (needed when deleting). */
+ Tcl_HashEntry *idHashPtr; /* Entry in idTable for this structure (needed
+ * when deleting). */
+ struct TkCursor *nextPtr; /* Points to the next TkCursor structure with
+ * the same name. Cursors with the same name
+ * but different displays are chained together
+ * off a single hash table entry. */
+} TkCursor;
+
+/*
+ * The following structure is kept one-per-TkDisplay to maintain information
+ * about the caret (cursor location) on this display. This is used to dictate
+ * global focus location (Windows Accessibility guidelines) and to position
+ * the IME or XIM over-the-spot window.
+ */
+
+typedef struct TkCaret {
+ struct TkWindow *winPtr; /* The window on which we requested caret
+ * placement. */
+ int x; /* Relative x coord of the caret. */
+ int y; /* Relative y coord of the caret. */
+ int height; /* Specified height of the window. */
+} TkCaret;
+
+/*
+ * One of the following structures is maintained for each display containing a
+ * window managed by Tk. In part, the structure is used to store thread-
+ * specific data, since each thread will have its own TkDisplay structure.
+ */
+
+typedef struct TkDisplay {
+ Display *display; /* Xlib's info about display. */
+ struct TkDisplay *nextPtr; /* Next in list of all displays. */
+ char *name; /* Name of display (with any screen identifier
+ * removed). Malloc-ed. */
+ Time lastEventTime; /* Time of last event received for this
+ * display. */
+
+ /*
+ * Information used primarily by tk3d.c:
+ */
+
+ int borderInit; /* 0 means borderTable needs initializing. */
+ Tcl_HashTable borderTable; /* Maps from color name to TkBorder
+ * structure. */
+
+ /*
+ * Information used by tkAtom.c only:
+ */
+
+ int atomInit; /* 0 means stuff below hasn't been initialized
+ * yet. */
+ Tcl_HashTable nameTable; /* Maps from names to Atom's. */
+ Tcl_HashTable atomTable; /* Maps from Atom's back to names. */
+
+ /*
+ * Information used primarily by tkBind.c:
+ */
+
+ int bindInfoStale; /* Non-zero means the variables in this part
+ * of the structure are potentially incorrect
+ * and should be recomputed. */
+ unsigned int modeModMask; /* Has one bit set to indicate the modifier
+ * corresponding to "mode shift". If no such
+ * modifier, than this is zero. */
+ unsigned int metaModMask; /* Has one bit set to indicate the modifier
+ * corresponding to the "Meta" key. If no such
+ * modifier, then this is zero. */
+ unsigned int altModMask; /* Has one bit set to indicate the modifier
+ * corresponding to the "Meta" key. If no such
+ * modifier, then this is zero. */
+ enum {LU_IGNORE, LU_CAPS, LU_SHIFT} lockUsage;
+ /* Indicates how to interpret lock
+ * modifier. */
+ int numModKeyCodes; /* Number of entries in modKeyCodes array
+ * below. */
+ KeyCode *modKeyCodes; /* Pointer to an array giving keycodes for all
+ * of the keys that have modifiers associated
+ * with them. Malloc'ed, but may be NULL. */
+
+ /*
+ * Information used by tkBitmap.c only:
+ */
+
+ int bitmapInit; /* 0 means tables above need initializing. */
+ int bitmapAutoNumber; /* Used to number bitmaps. */
+ Tcl_HashTable bitmapNameTable;
+ /* Maps from name of bitmap to the first
+ * TkBitmap record for that name. */
+ Tcl_HashTable bitmapIdTable;/* Maps from bitmap id to the TkBitmap
+ * structure for the bitmap. */
+ Tcl_HashTable bitmapDataTable;
+ /* Used by Tk_GetBitmapFromData to map from a
+ * collection of in-core data about a bitmap
+ * to a reference giving an automatically-
+ * generated name for the bitmap. */
+
+ /*
+ * Information used by tkCanvas.c only:
+ */
+
+ int numIdSearches;
+ int numSlowSearches;
+
+ /*
+ * Used by tkColor.c only:
+ */
+
+ int colorInit; /* 0 means color module needs initializing. */
+ TkStressedCmap *stressPtr; /* First in list of colormaps that have filled
+ * up, so we have to pick an approximate
+ * color. */
+ Tcl_HashTable colorNameTable;
+ /* Maps from color name to TkColor structure
+ * for that color. */
+ Tcl_HashTable colorValueTable;
+ /* Maps from integer RGB values to TkColor
+ * structures. */
+
+ /*
+ * Used by tkCursor.c only:
+ */
+
+ int cursorInit; /* 0 means cursor module need initializing. */
+ Tcl_HashTable cursorNameTable;
+ /* Maps from a string name to a cursor to the
+ * TkCursor record for the cursor. */
+ Tcl_HashTable cursorDataTable;
+ /* Maps from a collection of in-core data
+ * about a cursor to a TkCursor structure. */
+ Tcl_HashTable cursorIdTable;
+ /* Maps from a cursor id to the TkCursor
+ * structure for the cursor. */
+ char cursorString[20]; /* Used to store a cursor id string. */
+ Font cursorFont; /* Font to use for standard cursors. None
+ * means font not loaded yet. */
+
+ /*
+ * Information used by tkError.c only:
+ */
+
+ struct TkErrorHandler *errorPtr;
+ /* First in list of error handlers for this
+ * display. NULL means no handlers exist at
+ * present. */
+ int deleteCount; /* Counts # of handlers deleted since last
+ * time inactive handlers were garbage-
+ * collected. When this number gets big,
+ * handlers get cleaned up. */
+
+ /*
+ * Used by tkEvent.c only:
+ */
+
+ struct TkWindowEvent *delayedMotionPtr;
+ /* Points to a malloc-ed motion event whose
+ * processing has been delayed in the hopes
+ * that another motion event will come along
+ * right away and we can merge the two of them
+ * together. NULL means that there is no
+ * delayed motion event. */
+
+ /*
+ * Information used by tkFocus.c only:
+ */
+
+ int focusDebug; /* 1 means collect focus debugging
+ * statistics. */
+ struct TkWindow *implicitWinPtr;
+ /* If the focus arrived at a toplevel window
+ * implicitly via an Enter event (rather than
+ * via a FocusIn event), this points to the
+ * toplevel window. Otherwise it is NULL. */
+ struct TkWindow *focusPtr; /* Points to the window on this display that
+ * should be receiving keyboard events. When
+ * multiple applications on the display have
+ * the focus, this will refer to the innermost
+ * window in the innermost application. This
+ * information isn't used on Windows, but it's
+ * needed on the Mac, and also on X11 when XIM
+ * processing is being done. */
+
+ /*
+ * Information used by tkGC.c only:
+ */
+
+ Tcl_HashTable gcValueTable; /* Maps from a GC's values to a TkGC structure
+ * describing a GC with those values. */
+ Tcl_HashTable gcIdTable; /* Maps from a GC to a TkGC. */
+ int gcInit; /* 0 means the tables below need
+ * initializing. */
+
+ /*
+ * Information used by tkGeometry.c only:
+ */
+
+ Tcl_HashTable maintainHashTable;
+ /* Hash table that maps from a master's
+ * Tk_Window token to a list of slaves managed
+ * by that master. */
+ int geomInit;
+
+ /*
+ * Information used by tkGet.c only:
+ */
+
+ Tcl_HashTable uidTable; /* Stores all Tk_Uid used in a thread. */
+ int uidInit; /* 0 means uidTable needs initializing. */
+
+ /*
+ * Information used by tkGrab.c only:
+ */
+
+ struct TkWindow *grabWinPtr;/* Window in which the pointer is currently
+ * grabbed, or NULL if none. */
+ struct TkWindow *eventualGrabWinPtr;
+ /* Value that grabWinPtr will have once the
+ * grab event queue (below) has been
+ * completely emptied. */
+ struct TkWindow *buttonWinPtr;
+ /* Window in which first mouse button was
+ * pressed while grab was in effect, or NULL
+ * if no such press in effect. */
+ struct TkWindow *serverWinPtr;
+ /* If no application contains the pointer then
+ * this is NULL. Otherwise it contains the
+ * last window for which we've gotten an Enter
+ * or Leave event from the server (i.e. the
+ * last window known to have contained the
+ * pointer). Doesn't reflect events that were
+ * synthesized in tkGrab.c. */
+ TkGrabEvent *firstGrabEventPtr;
+ /* First in list of enter/leave events
+ * synthesized by grab code. These events must
+ * be processed in order before any other
+ * events are processed. NULL means no such
+ * events. */
+ TkGrabEvent *lastGrabEventPtr;
+ /* Last in list of synthesized events, or NULL
+ * if list is empty. */
+ int grabFlags; /* Miscellaneous flag values. See definitions
+ * in tkGrab.c. */
+
+ /*
+ * Information used by tkGrid.c only:
+ */
+
+ int gridInit; /* 0 means table below needs initializing. */
+ Tcl_HashTable gridHashTable;/* Maps from Tk_Window tokens to corresponding
+ * Grid structures. */
+
+ /*
+ * Information used by tkImage.c only:
+ */
+
+ int imageId; /* Value used to number image ids. */
+
+ /*
+ * Information used by tkMacWinMenu.c only:
+ */
+
+ int postCommandGeneration;
+
+ /*
+ * Information used by tkPack.c only.
+ */
+
+ int packInit; /* 0 means table below needs initializing. */
+ Tcl_HashTable packerHashTable;
+ /* Maps from Tk_Window tokens to corresponding
+ * Packer structures. */
+
+ /*
+ * Information used by tkPlace.c only.
+ */
+
+ int placeInit; /* 0 means tables below need initializing. */
+ Tcl_HashTable masterTable; /* Maps from Tk_Window toke to the Master
+ * structure for the window, if it exists. */
+ Tcl_HashTable slaveTable; /* Maps from Tk_Window toke to the Slave
+ * structure for the window, if it exists. */
+
+ /*
+ * Information used by tkSelect.c and tkClipboard.c only:
+ */
+
+ struct TkSelectionInfo *selectionInfoPtr;
+ /* First in list of selection information
+ * records. Each entry contains information
+ * about the current owner of a particular
+ * selection on this display. */
+ Atom multipleAtom; /* Atom for MULTIPLE. None means selection
+ * stuff isn't initialized. */
+ Atom incrAtom; /* Atom for INCR. */
+ Atom targetsAtom; /* Atom for TARGETS. */
+ Atom timestampAtom; /* Atom for TIMESTAMP. */
+ Atom textAtom; /* Atom for TEXT. */
+ Atom compoundTextAtom; /* Atom for COMPOUND_TEXT. */
+ Atom applicationAtom; /* Atom for TK_APPLICATION. */
+ Atom windowAtom; /* Atom for TK_WINDOW. */
+ Atom clipboardAtom; /* Atom for CLIPBOARD. */
+ Atom utf8Atom; /* Atom for UTF8_STRING. */
+
+ Tk_Window clipWindow; /* Window used for clipboard ownership and to
+ * retrieve selections between processes. NULL
+ * means clipboard info hasn't been
+ * initialized. */
+ int clipboardActive; /* 1 means we currently own the clipboard
+ * selection, 0 means we don't. */
+ struct TkMainInfo *clipboardAppPtr;
+ /* Last application that owned clipboard. */
+ struct TkClipboardTarget *clipTargetPtr;
+ /* First in list of clipboard type information
+ * records. Each entry contains information
+ * about the buffers for a given selection
+ * target. */
+
+ /*
+ * Information used by tkSend.c only:
+ */
+
+ Tk_Window commTkwin; /* Window used for communication between
+ * interpreters during "send" commands. NULL
+ * means send info hasn't been initialized
+ * yet. */
+ Atom commProperty; /* X's name for comm property. */
+ Atom registryProperty; /* X's name for property containing registry
+ * of interpreter names. */
+ Atom appNameProperty; /* X's name for property used to hold the
+ * application name on each comm window. */
+
+ /*
+ * Information used by tkUnixWm.c and tkWinWm.c only:
+ */
+
+ struct TkWmInfo *firstWmPtr;/* Points to first top-level window. */
+ struct TkWmInfo *foregroundWmPtr;
+ /* Points to the foreground window. */
+
+ /*
+ * Information used by tkVisual.c only:
+ */
+
+ TkColormap *cmapPtr; /* First in list of all non-default colormaps
+ * allocated for this display. */
+
+ /*
+ * Miscellaneous information:
+ */
+
+#ifdef TK_USE_INPUT_METHODS
+ XIM inputMethod; /* Input method for this display. */
+ XIMStyle inputStyle; /* Input style selected for this display. */
+ XFontSet inputXfs; /* XFontSet cached for over-the-spot XIM. */
+#endif /* TK_USE_INPUT_METHODS */
+ Tcl_HashTable winTable; /* Maps from X window ids to TkWindow ptrs. */
+
+ int refCount; /* Reference count of how many Tk applications
+ * are using this display. Used to clean up
+ * the display when we no longer have any Tk
+ * applications using it. */
+
+ /*
+ * The following field were all added for Tk8.3
+ */
+
+ int mouseButtonState; /* Current mouse button state for this
+ * display. */
+ Window mouseButtonWindow; /* Window the button state was set in, added
+ * in Tk 8.4. */
+ Tk_Window warpWindow;
+ Tk_Window warpMainwin; /* For finding the root window for warping
+ * purposes. */
+ int warpX;
+ int warpY;
+
+ /*
+ * The following field(s) were all added for Tk8.4
+ */
+
+ unsigned int flags; /* Various flag values: these are all defined
+ * in below. */
+ TkCaret caret; /* Information about the caret for this
+ * display. This is not a pointer. */
+
+ int iconDataSize; /* Size of default iconphoto image data. */
+ unsigned char *iconDataPtr; /* Default iconphoto image data, if set. */
+} TkDisplay;
+
+/*
+ * Flag values for TkDisplay flags.
+ * TK_DISPLAY_COLLAPSE_MOTION_EVENTS: (default on)
+ * Indicates that we should collapse motion events on this display
+ * TK_DISPLAY_USE_IM: (default on, set via tk.tcl)
+ * Whether to use input methods for this display
+ * TK_DISPLAY_WM_TRACING: (default off)
+ * Whether we should do wm tracing on this display.
+ * TK_DISPLAY_IN_WARP: (default off)
+ * Indicates that we are in a pointer warp
+ */
+
+#define TK_DISPLAY_COLLAPSE_MOTION_EVENTS (1 << 0)
+#define TK_DISPLAY_USE_IM (1 << 1)
+#define TK_DISPLAY_WM_TRACING (1 << 3)
+#define TK_DISPLAY_IN_WARP (1 << 4)
+#define TK_DISPLAY_USE_XKB (1 << 5)
+
+/*
+ * One of the following structures exists for each error handler created by a
+ * call to Tk_CreateErrorHandler. The structure is managed by tkError.c.
+ */
+
+typedef struct TkErrorHandler {
+ TkDisplay *dispPtr; /* Display to which handler applies. */
+ unsigned long firstRequest; /* Only errors with serial numbers >= to this
+ * are considered. */
+ unsigned long lastRequest; /* Only errors with serial numbers <= to this
+ * are considered. This field is filled in
+ * when XUnhandle is called. -1 means
+ * XUnhandle hasn't been called yet. */
+ int error; /* Consider only errors with this error_code
+ * (-1 means consider all errors). */
+ int request; /* Consider only errors with this major
+ * request code (-1 means consider all major
+ * codes). */
+ int minorCode; /* Consider only errors with this minor
+ * request code (-1 means consider all minor
+ * codes). */
+ Tk_ErrorProc *errorProc; /* Function to invoke when a matching error
+ * occurs. NULL means just ignore errors. */
+ ClientData clientData; /* Arbitrary value to pass to errorProc. */
+ struct TkErrorHandler *nextPtr;
+ /* Pointer to next older handler for this
+ * display, or NULL for end of list. */
+} TkErrorHandler;
+
+/*
+ * One of the following structures exists for each event handler created by
+ * calling Tk_CreateEventHandler. This information is used by tkEvent.c only.
+ */
+
+typedef struct TkEventHandler {
+ unsigned long mask; /* Events for which to invoke proc. */
+ Tk_EventProc *proc; /* Function to invoke when an event in mask
+ * occurs. */
+ ClientData clientData; /* Argument to pass to proc. */
+ struct TkEventHandler *nextPtr;
+ /* Next in list of handlers associated with
+ * window (NULL means end of list). */
+} TkEventHandler;
+
+/*
+ * Tk keeps one of the following data structures for each main window (created
+ * by a call to TkCreateMainWindow). It stores information that is shared by
+ * all of the windows associated with a particular main window.
+ */
+
+typedef struct TkMainInfo {
+ int refCount; /* Number of windows whose "mainPtr" fields
+ * point here. When this becomes zero, can
+ * free up the structure (the reference count
+ * is zero because windows can get deleted in
+ * almost any order; the main window isn't
+ * necessarily the last one deleted). */
+ struct TkWindow *winPtr; /* Pointer to main window. */
+ Tcl_Interp *interp; /* Interpreter associated with application. */
+ Tcl_HashTable nameTable; /* Hash table mapping path names to TkWindow
+ * structs for all windows related to this
+ * main window. Managed by tkWindow.c. */
+ long deletionEpoch; /* Incremented by window deletions. */
+ Tk_BindingTable bindingTable;
+ /* Used in conjunction with "bind" command to
+ * bind events to Tcl commands. */
+ TkBindInfo bindInfo; /* Information used by tkBind.c on a per
+ * application basis. */
+ struct TkFontInfo *fontInfoPtr;
+ /* Information used by tkFont.c on a per
+ * application basis. */
+
+ /*
+ * Information used only by tkFocus.c and tk*Embed.c:
+ */
+
+ struct TkToplevelFocusInfo *tlFocusPtr;
+ /* First in list of records containing focus
+ * information for each top-level in the
+ * application. Used only by tkFocus.c. */
+ struct TkDisplayFocusInfo *displayFocusPtr;
+ /* First in list of records containing focus
+ * information for each display that this
+ * application has ever used. Used only by
+ * tkFocus.c. */
+
+ struct ElArray *optionRootPtr;
+ /* Top level of option hierarchy for this main
+ * window. NULL means uninitialized. Managed
+ * by tkOption.c. */
+ Tcl_HashTable imageTable; /* Maps from image names to Tk_ImageMaster
+ * structures. Managed by tkImage.c. */
+ int strictMotif; /* This is linked to the tk_strictMotif global
+ * variable. */
+ int alwaysShowSelection; /* This is linked to the
+ * ::tk::AlwaysShowSelection variable. */
+ struct TkMainInfo *nextPtr; /* Next in list of all main windows managed by
+ * this process. */
+ Tcl_HashTable busyTable; /* Information used by [tk busy] command. */
+} TkMainInfo;
+
+/*
+ * Tk keeps the following data structure for each of it's builtin bitmaps.
+ * This structure is only used by tkBitmap.c and other platform specific
+ * bitmap files.
+ */
+
+typedef struct {
+ const void *source; /* Bits for bitmap. */
+ int width, height; /* Dimensions of bitmap. */
+ int native; /* 0 means generic (X style) bitmap, 1 means
+ * native style bitmap. */
+} TkPredefBitmap;
+
+/*
+ * Tk keeps one of the following structures for each window. Some of the
+ * information (like size and location) is a shadow of information managed by
+ * the X server, and some is special information used here, such as event and
+ * geometry management information. This information is (mostly) managed by
+ * tkWindow.c. WARNING: the declaration below must be kept consistent with the
+ * Tk_FakeWin structure in tk.h. If you change one, be sure to change the
+ * other!
+ */
+
+typedef struct TkWindow {
+ /*
+ * Structural information:
+ */
+
+ Display *display; /* Display containing window. */
+ TkDisplay *dispPtr; /* Tk's information about display for
+ * window. */
+ int screenNum; /* Index of screen for window, among all those
+ * for dispPtr. */
+ Visual *visual; /* Visual to use for window. If not default,
+ * MUST be set before X window is created. */
+ int depth; /* Number of bits/pixel. */
+ Window window; /* X's id for window. NULL means window hasn't
+ * actually been created yet, or it's been
+ * deleted. */
+ struct TkWindow *childList; /* First in list of child windows, or NULL if
+ * no children. List is in stacking order,
+ * lowest window first.*/
+ struct TkWindow *lastChildPtr;
+ /* Last in list of child windows (highest in
+ * stacking order), or NULL if no children. */
+ struct TkWindow *parentPtr; /* Pointer to parent window (logical parent,
+ * not necessarily X parent). NULL means
+ * either this is the main window, or the
+ * window's parent has already been deleted. */
+ struct TkWindow *nextPtr; /* Next higher sibling (in stacking order) in
+ * list of children with same parent. NULL
+ * means end of list. */
+ TkMainInfo *mainPtr; /* Information shared by all windows
+ * associated with a particular main window.
+ * NULL means this window is a rogue that is
+ * not associated with any application (at
+ * present, this only happens for the dummy
+ * windows used for "send" communication). */
+
+ /*
+ * Name and type information for the window:
+ */
+
+ char *pathName; /* Path name of window (concatenation of all
+ * names between this window and its top-level
+ * ancestor). This is a pointer into an entry
+ * in mainPtr->nameTable. NULL means that the
+ * window hasn't been completely created
+ * yet. */
+ Tk_Uid nameUid; /* Name of the window within its parent
+ * (unique within the parent). */
+ Tk_Uid classUid; /* Class of the window. NULL means window
+ * hasn't been given a class yet. */
+
+ /*
+ * Geometry and other attributes of window. This information may not be
+ * updated on the server immediately; stuff that hasn't been reflected in
+ * the server yet is called "dirty". At present, information can be dirty
+ * only if the window hasn't yet been created.
+ */
+
+ XWindowChanges changes; /* Geometry and other info about window. */
+ unsigned int dirtyChanges; /* Bits indicate fields of "changes" that are
+ * dirty. */
+ XSetWindowAttributes atts; /* Current attributes of window. */
+ unsigned long dirtyAtts; /* Bits indicate fields of "atts" that are
+ * dirty. */
+
+ unsigned int flags; /* Various flag values: these are all defined
+ * in tk.h (confusing, but they're needed
+ * there for some query macros). */
+
+ /*
+ * Information kept by the event manager (tkEvent.c):
+ */
+
+ TkEventHandler *handlerList;/* First in list of event handlers declared
+ * for this window, or NULL if none. */
+#ifdef TK_USE_INPUT_METHODS
+ XIC inputContext; /* XIM input context. */
+#endif /* TK_USE_INPUT_METHODS */
+
+ /*
+ * Information used for event bindings (see "bind" and "bindtags" commands
+ * in tkCmds.c):
+ */
+
+ ClientData *tagPtr; /* Points to array of tags used for bindings
+ * on this window. Each tag is a Tk_Uid.
+ * Malloc'ed. NULL means no tags. */
+ int numTags; /* Number of tags at *tagPtr. */
+
+ /*
+ * Information used by tkOption.c to manage options for the window.
+ */
+
+ int optionLevel; /* -1 means no option information is currently
+ * cached for this window. Otherwise this
+ * gives the level in the option stack at
+ * which info is cached. */
+ /*
+ * Information used by tkSelect.c to manage the selection.
+ */
+
+ struct TkSelHandler *selHandlerList;
+ /* First in list of handlers for returning the
+ * selection in various forms. */
+
+ /*
+ * Information used by tkGeometry.c for geometry management.
+ */
+
+ const Tk_GeomMgr *geomMgrPtr;
+ /* Information about geometry manager for this
+ * window. */
+ ClientData geomData; /* Argument for geometry manager functions. */
+ int reqWidth, reqHeight; /* Arguments from last call to
+ * Tk_GeometryRequest, or 0's if
+ * Tk_GeometryRequest hasn't been called. */
+ int internalBorderLeft; /* Width of internal border of window (0 means
+ * no internal border). Geometry managers
+ * should not normally place children on top
+ * of the border. Fields for the other three
+ * sides are found below. */
+
+ /*
+ * Information maintained by tkWm.c for window manager communication.
+ */
+
+ struct TkWmInfo *wmInfoPtr; /* For top-level windows (and also for special
+ * Unix menubar and wrapper windows), points
+ * to structure with wm-related info (see
+ * tkWm.c). For other windows, this is
+ * NULL. */
+
+ /*
+ * Information used by widget classes.
+ */
+
+ const Tk_ClassProcs *classProcsPtr;
+ ClientData instanceData;
+
+ /*
+ * Platform specific information private to each port.
+ */
+
+ struct TkWindowPrivate *privatePtr;
+
+ /*
+ * More information used by tkGeometry.c for geometry management.
+ */
+
+ /* The remaining fields of internal border. */
+ int internalBorderRight;
+ int internalBorderTop;
+ int internalBorderBottom;
+
+ int minReqWidth; /* Minimum requested width. */
+ int minReqHeight; /* Minimum requested height. */
+ char *geometryMaster;
+} TkWindow;
+
+/*
+ * Real definition of some events. Note that these events come from outside
+ * but have internally generated pieces added to them.
+ */
+
+typedef struct {
+ XKeyEvent keyEvent; /* The real event from X11. */
+ char *charValuePtr; /* A pointer to a string that holds the key's
+ * %A substitution text (before backslash
+ * adding), or NULL if that has not been
+ * computed yet. If non-NULL, this string was
+ * allocated with ckalloc(). */
+ int charValueLen; /* Length of string in charValuePtr when that
+ * is non-NULL. */
+ KeySym keysym; /* Key symbol computed after input methods
+ * have been invoked */
+} TkKeyEvent;
+
+/*
+ * Flags passed to TkpMakeMenuWindow's 'transient' argument.
+ */
+
+#define TK_MAKE_MENU_TEAROFF 0 /* Only non-transient case. */
+#define TK_MAKE_MENU_POPUP 1
+#define TK_MAKE_MENU_DROPDOWN 2
+
+/*
+ * The following structure is used with TkMakeEnsemble to create ensemble
+ * commands and optionally to create sub-ensembles.
+ */
+
+typedef struct TkEnsemble {
+ const char *name;
+ Tcl_ObjCmdProc *proc;
+ const struct TkEnsemble *subensemble;
+} TkEnsemble;
+
+/*
+ * The following structure is used as a two way map between integers and
+ * strings, usually to map between an internal C representation and the
+ * strings used in Tcl.
+ */
+
+typedef struct TkStateMap {
+ int numKey; /* Integer representation of a value. */
+ const char *strKey; /* String representation of a value. */
+} TkStateMap;
+
+/*
+ * This structure is used by the Mac and Window porting layers as the internal
+ * representation of a clip_mask in a GC.
+ */
+
+typedef struct TkpClipMask {
+ int type; /* TKP_CLIP_PIXMAP or TKP_CLIP_REGION. */
+ union {
+ Pixmap pixmap;
+ TkRegion region;
+ } value;
+} TkpClipMask;
+
+#define TKP_CLIP_PIXMAP 0
+#define TKP_CLIP_REGION 1
+
+/*
+ * Return values from TkGrabState:
+ */
+
+#define TK_GRAB_NONE 0
+#define TK_GRAB_IN_TREE 1
+#define TK_GRAB_ANCESTOR 2
+#define TK_GRAB_EXCLUDED 3
+
+/*
+ * Additional flag for TkpMeasureCharsInContext. Coordinate with other flags
+ * for this routine, but don't make public until TkpMeasureCharsInContext is
+ * made public, too.
+ */
+
+#define TK_ISOLATE_END 32
+
+/*
+ * The macro below is used to modify a "char" value (e.g. by casting it to an
+ * unsigned character) so that it can be used safely with macros such as
+ * isspace().
+ */
+
+#define UCHAR(c) ((unsigned char) (c))
+
+/*
+ * The following symbol is used in the mode field of FocusIn events generated
+ * by an embedded application to request the input focus from its container.
+ */
+
+#define EMBEDDED_APP_WANTS_FOCUS (NotifyNormal + 20)
+
+/*
+ * The following special modifier mask bits are defined, to indicate logical
+ * modifiers such as Meta and Alt that may float among the actual modifier
+ * bits.
+ */
+
+#define META_MASK (AnyModifier<<1)
+#define ALT_MASK (AnyModifier<<2)
+#define EXTENDED_MASK (AnyModifier<<3)
+
+/*
+ * Object types not declared in tkObj.c need to be mentioned here so they can
+ * be properly registered with Tcl:
+ */
+
+MODULE_SCOPE const Tcl_ObjType tkBorderObjType;
+MODULE_SCOPE const Tcl_ObjType tkBitmapObjType;
+MODULE_SCOPE const Tcl_ObjType tkColorObjType;
+MODULE_SCOPE const Tcl_ObjType tkCursorObjType;
+MODULE_SCOPE const Tcl_ObjType tkFontObjType;
+MODULE_SCOPE const Tcl_ObjType tkStateKeyObjType;
+MODULE_SCOPE const Tcl_ObjType tkTextIndexType;
+
+/*
+ * Miscellaneous variables shared among Tk modules but not exported to the
+ * outside world:
+ */
+
+MODULE_SCOPE const Tk_SmoothMethod tkBezierSmoothMethod;
+MODULE_SCOPE Tk_ImageType tkBitmapImageType;
+MODULE_SCOPE Tk_PhotoImageFormat tkImgFmtGIF;
+MODULE_SCOPE void (*tkHandleEventProc) (XEvent* eventPtr);
+MODULE_SCOPE Tk_PhotoImageFormat tkImgFmtPNG;
+MODULE_SCOPE Tk_PhotoImageFormat tkImgFmtPPM;
+MODULE_SCOPE TkMainInfo *tkMainWindowList;
+MODULE_SCOPE Tk_ImageType tkPhotoImageType;
+MODULE_SCOPE Tcl_HashTable tkPredefBitmapTable;
+
+MODULE_SCOPE const char *const tkWebColors[20];
+
+/*
+ * The definition of pi, at least from the perspective of double-precision
+ * floats.
+ */
+
+#ifndef PI
+#ifdef M_PI
+#define PI M_PI
+#else
+#define PI 3.14159265358979323846
+#endif
+#endif
+
+/*
+ * Support for Clang Static Analyzer <http://clang-analyzer.llvm.org>
+ */
+
+#if defined(PURIFY) && defined(__clang__)
+#if __has_feature(attribute_analyzer_noreturn) && \
+ !defined(Tcl_Panic) && defined(Tcl_Panic_TCL_DECLARED)
+void Tcl_Panic(const char *, ...) __attribute__((analyzer_noreturn));
+#endif
+#if !defined(CLANG_ASSERT)
+#include <assert.h>
+#define CLANG_ASSERT(x) assert(x)
+#endif
+#elif !defined(CLANG_ASSERT)
+#define CLANG_ASSERT(x)
+#endif /* PURIFY && __clang__ */
+
+/*
+ * The following magic value is stored in the "send_event" field of FocusIn
+ * and FocusOut events. This allows us to separate "real" events coming from
+ * the server from those that we generated.
+ */
+
+#define GENERATED_FOCUS_EVENT_MAGIC ((Bool) 0x547321ac)
+
+/*
+ * Exported internals.
+ */
+
+#include "tkIntDecls.h"
+
+/*
+ * Themed widget set init function:
+ */
+
+MODULE_SCOPE int Ttk_Init(Tcl_Interp *interp);
+
+/*
+ * Internal functions shared among Tk modules but not exported to the outside
+ * world:
+ */
+
+MODULE_SCOPE int Tk_BellObjCmd(ClientData clientData,
+ Tcl_Interp *interp, int objc,
+ Tcl_Obj *const objv[]);
+MODULE_SCOPE int Tk_BindObjCmd(ClientData clientData,
+ Tcl_Interp *interp, int objc,
+ Tcl_Obj *const objv[]);
+MODULE_SCOPE int Tk_BindtagsObjCmd(ClientData clientData,
+ Tcl_Interp *interp, int objc,
+ Tcl_Obj *const objv[]);
+MODULE_SCOPE int Tk_BusyObjCmd(ClientData clientData,
+ Tcl_Interp *interp, int objc,
+ Tcl_Obj *const objv[]);
+MODULE_SCOPE int Tk_ButtonObjCmd(ClientData clientData,
+ Tcl_Interp *interp, int objc,
+ Tcl_Obj *const objv[]);
+MODULE_SCOPE int Tk_CanvasObjCmd(ClientData clientData,
+ Tcl_Interp *interp, int argc,
+ Tcl_Obj *const objv[]);
+MODULE_SCOPE int Tk_CheckbuttonObjCmd(ClientData clientData,
+ Tcl_Interp *interp, int objc,
+ Tcl_Obj *const objv[]);
+MODULE_SCOPE int Tk_ClipboardObjCmd(ClientData clientData,
+ Tcl_Interp *interp, int objc,
+ Tcl_Obj *const objv[]);
+MODULE_SCOPE int Tk_ChooseColorObjCmd(ClientData clientData,
+ Tcl_Interp *interp, int objc,
+ Tcl_Obj *const objv[]);
+MODULE_SCOPE int Tk_ChooseDirectoryObjCmd(ClientData clientData,
+ Tcl_Interp *interp, int objc,
+ Tcl_Obj *const objv[]);
+MODULE_SCOPE int Tk_DestroyObjCmd(ClientData clientData,
+ Tcl_Interp *interp, int objc,
+ Tcl_Obj *const objv[]);
+MODULE_SCOPE int Tk_EntryObjCmd(ClientData clientData,
+ Tcl_Interp *interp, int objc,
+ Tcl_Obj *const objv[]);
+MODULE_SCOPE int Tk_EventObjCmd(ClientData clientData,
+ Tcl_Interp *interp, int objc,
+ Tcl_Obj *const objv[]);
+MODULE_SCOPE int Tk_FrameObjCmd(ClientData clientData,
+ Tcl_Interp *interp, int objc,
+ Tcl_Obj *const objv[]);
+MODULE_SCOPE int Tk_FocusObjCmd(ClientData clientData,
+ Tcl_Interp *interp, int objc,
+ Tcl_Obj *const objv[]);
+MODULE_SCOPE int Tk_FontObjCmd(ClientData clientData,
+ Tcl_Interp *interp, int objc,
+ Tcl_Obj *const objv[]);
+MODULE_SCOPE int Tk_GetOpenFileObjCmd(ClientData clientData,
+ Tcl_Interp *interp, int objc,
+ Tcl_Obj *const objv[]);
+MODULE_SCOPE int Tk_GetSaveFileObjCmd(ClientData clientData,
+ Tcl_Interp *interp, int objc,
+ Tcl_Obj *const objv[]);
+MODULE_SCOPE int Tk_GrabObjCmd(ClientData clientData,
+ Tcl_Interp *interp, int objc,
+ Tcl_Obj *const objv[]);
+MODULE_SCOPE int Tk_GridObjCmd(ClientData clientData,
+ Tcl_Interp *interp, int objc,
+ Tcl_Obj *const objv[]);
+MODULE_SCOPE int Tk_ImageObjCmd(ClientData clientData,
+ Tcl_Interp *interp, int objc,
+ Tcl_Obj *const objv[]);
+MODULE_SCOPE int Tk_LabelObjCmd(ClientData clientData,
+ Tcl_Interp *interp, int objc,
+ Tcl_Obj *const objv[]);
+MODULE_SCOPE int Tk_LabelframeObjCmd(ClientData clientData,
+ Tcl_Interp *interp, int objc,
+ Tcl_Obj *const objv[]);
+MODULE_SCOPE int Tk_ListboxObjCmd(ClientData clientData,
+ Tcl_Interp *interp, int objc,
+ Tcl_Obj *const objv[]);
+MODULE_SCOPE int Tk_LowerObjCmd(ClientData clientData,
+ Tcl_Interp *interp, int objc,
+ Tcl_Obj *const objv[]);
+MODULE_SCOPE int Tk_MenuObjCmd(ClientData clientData,
+ Tcl_Interp *interp, int objc,
+ Tcl_Obj *const objv[]);
+MODULE_SCOPE int Tk_MenubuttonObjCmd(ClientData clientData,
+ Tcl_Interp *interp, int objc,
+ Tcl_Obj *const objv[]);
+MODULE_SCOPE int Tk_MessageBoxObjCmd(ClientData clientData,
+ Tcl_Interp *interp, int objc,
+ Tcl_Obj *const objv[]);
+MODULE_SCOPE int Tk_MessageObjCmd(ClientData clientData,
+ Tcl_Interp *interp, int objc,
+ Tcl_Obj *const objv[]);
+MODULE_SCOPE int Tk_PanedWindowObjCmd(ClientData clientData,
+ Tcl_Interp *interp, int objc,
+ Tcl_Obj *const objv[]);
+MODULE_SCOPE int Tk_OptionObjCmd(ClientData clientData,
+ Tcl_Interp *interp, int objc,
+ Tcl_Obj *const objv[]);
+MODULE_SCOPE int Tk_PackObjCmd(ClientData clientData,
+ Tcl_Interp *interp, int objc,
+ Tcl_Obj *const objv[]);
+MODULE_SCOPE int Tk_PlaceObjCmd(ClientData clientData,
+ Tcl_Interp *interp, int objc,
+ Tcl_Obj *const objv[]);
+MODULE_SCOPE int Tk_RadiobuttonObjCmd(ClientData clientData,
+ Tcl_Interp *interp, int objc,
+ Tcl_Obj *const objv[]);
+MODULE_SCOPE int Tk_RaiseObjCmd(ClientData clientData,
+ Tcl_Interp *interp, int objc,
+ Tcl_Obj *const objv[]);
+MODULE_SCOPE int Tk_ScaleObjCmd(ClientData clientData,
+ Tcl_Interp *interp, int objc,
+ Tcl_Obj *const objv[]);
+MODULE_SCOPE int Tk_ScrollbarObjCmd(ClientData clientData,
+ Tcl_Interp *interp, int objc,
+ Tcl_Obj *const objv[]);
+MODULE_SCOPE int Tk_SelectionObjCmd(ClientData clientData,
+ Tcl_Interp *interp, int objc,
+ Tcl_Obj *const objv[]);
+MODULE_SCOPE int Tk_SendObjCmd(ClientData clientData,
+ Tcl_Interp *interp,int objc,
+ Tcl_Obj *const objv[]);
+MODULE_SCOPE int Tk_SendObjCmd(ClientData clientData,
+ Tcl_Interp *interp, int objc,
+ Tcl_Obj *const objv[]);
+MODULE_SCOPE int Tk_SpinboxObjCmd(ClientData clientData,
+ Tcl_Interp *interp, int objc,
+ Tcl_Obj *const objv[]);
+MODULE_SCOPE int Tk_TextObjCmd(ClientData clientData,
+ Tcl_Interp *interp, int objc,
+ Tcl_Obj *const objv[]);
+MODULE_SCOPE int Tk_TkwaitObjCmd(ClientData clientData,
+ Tcl_Interp *interp, int objc,
+ Tcl_Obj *const objv[]);
+MODULE_SCOPE int Tk_ToplevelObjCmd(ClientData clientData,
+ Tcl_Interp *interp, int objc,
+ Tcl_Obj *const objv[]);
+MODULE_SCOPE int Tk_UpdateObjCmd(ClientData clientData,
+ Tcl_Interp *interp, int objc,
+ Tcl_Obj *const objv[]);
+MODULE_SCOPE int Tk_WinfoObjCmd(ClientData clientData,
+ Tcl_Interp *interp, int objc,
+ Tcl_Obj *const objv[]);
+MODULE_SCOPE int Tk_WmObjCmd(ClientData clientData, Tcl_Interp *interp,
+ int objc, Tcl_Obj *const objv[]);
+
+MODULE_SCOPE int Tk_GetDoublePixelsFromObj(Tcl_Interp *interp,
+ Tk_Window tkwin, Tcl_Obj *objPtr,
+ double *doublePtr);
+MODULE_SCOPE int TkSetGeometryMaster(Tcl_Interp *interp,
+ Tk_Window tkwin, const char *master);
+MODULE_SCOPE void TkFreeGeometryMaster(Tk_Window tkwin,
+ const char *master);
+
+MODULE_SCOPE void TkEventInit(void);
+MODULE_SCOPE void TkRegisterObjTypes(void);
+MODULE_SCOPE int TkDeadAppObjCmd(ClientData clientData,
+ Tcl_Interp *interp, int objc, Tcl_Obj *const argv[]);
+MODULE_SCOPE int TkCanvasGetCoordObj(Tcl_Interp *interp,
+ Tk_Canvas canvas, Tcl_Obj *obj,
+ double *doublePtr);
+MODULE_SCOPE int TkGetDoublePixels(Tcl_Interp *interp, Tk_Window tkwin,
+ const char *string, double *doublePtr);
+MODULE_SCOPE int TkPostscriptImage(Tcl_Interp *interp, Tk_Window tkwin,
+ Tk_PostscriptInfo psInfo, XImage *ximage,
+ int x, int y, int width, int height);
+MODULE_SCOPE void TkMapTopFrame(Tk_Window tkwin);
+MODULE_SCOPE XEvent * TkpGetBindingXEvent(Tcl_Interp *interp);
+MODULE_SCOPE void TkCreateExitHandler(Tcl_ExitProc *proc,
+ ClientData clientData);
+MODULE_SCOPE void TkDeleteExitHandler(Tcl_ExitProc *proc,
+ ClientData clientData);
+MODULE_SCOPE Tcl_ExitProc TkFinalize;
+MODULE_SCOPE Tcl_ExitProc TkFinalizeThread;
+MODULE_SCOPE void TkpBuildRegionFromAlphaData(TkRegion region,
+ unsigned x, unsigned y, unsigned width,
+ unsigned height, unsigned char *dataPtr,
+ unsigned pixelStride, unsigned lineStride);
+MODULE_SCOPE void TkAppendPadAmount(Tcl_Obj *bufferObj,
+ const char *buffer, int pad1, int pad2);
+MODULE_SCOPE int TkParsePadAmount(Tcl_Interp *interp,
+ Tk_Window tkwin, Tcl_Obj *objPtr,
+ int *pad1Ptr, int *pad2Ptr);
+MODULE_SCOPE void TkFocusSplit(TkWindow *winPtr);
+MODULE_SCOPE void TkFocusJoin(TkWindow *winPtr);
+MODULE_SCOPE int TkpAlwaysShowSelection(Tk_Window tkwin);
+MODULE_SCOPE void TkpDrawCharsInContext(Display * display,
+ Drawable drawable, GC gc, Tk_Font tkfont,
+ const char *source, int numBytes, int rangeStart,
+ int rangeLength, int x, int y);
+MODULE_SCOPE int TkpMeasureCharsInContext(Tk_Font tkfont,
+ const char *source, int numBytes, int rangeStart,
+ int rangeLength, int maxLength, int flags,
+ int *lengthPtr);
+MODULE_SCOPE void TkUnderlineCharsInContext(Display *display,
+ Drawable drawable, GC gc, Tk_Font tkfont,
+ const char *string, int numBytes, int x, int y,
+ int firstByte, int lastByte);
+MODULE_SCOPE void TkpGetFontAttrsForChar(Tk_Window tkwin, Tk_Font tkfont,
+ Tcl_UniChar c, struct TkFontAttributes *faPtr);
+MODULE_SCOPE Tcl_Obj * TkNewWindowObj(Tk_Window tkwin);
+MODULE_SCOPE void TkpShowBusyWindow(TkBusy busy);
+MODULE_SCOPE void TkpHideBusyWindow(TkBusy busy);
+MODULE_SCOPE void TkpMakeTransparentWindowExist(Tk_Window tkwin,
+ Window parent);
+MODULE_SCOPE void TkpCreateBusy(Tk_FakeWin *winPtr, Tk_Window tkRef,
+ Window *parentPtr, Tk_Window tkParent,
+ TkBusy busy);
+MODULE_SCOPE int TkBackgroundEvalObjv(Tcl_Interp *interp,
+ int objc, Tcl_Obj *const *objv, int flags);
+MODULE_SCOPE void TkSendVirtualEvent(Tk_Window tgtWin,
+ const char *eventName, Tcl_Obj *detail);
+MODULE_SCOPE Tcl_Command TkMakeEnsemble(Tcl_Interp *interp,
+ const char *nsname, const char *name,
+ ClientData clientData, const TkEnsemble *map);
+MODULE_SCOPE int TkInitTkCmd(Tcl_Interp *interp,
+ ClientData clientData);
+MODULE_SCOPE int TkInitFontchooser(Tcl_Interp *interp,
+ ClientData clientData);
+MODULE_SCOPE void TkpWarpPointer(TkDisplay *dispPtr);
+MODULE_SCOPE int TkListCreateFrame(ClientData clientData,
+ Tcl_Interp *interp, Tcl_Obj *listObj,
+ int toplevel, Tcl_Obj *nameObj);
+
+#ifdef _WIN32
+#define TkParseColor XParseColor
+#else
+MODULE_SCOPE Status TkParseColor (Display * display,
+ Colormap map, const char* spec,
+ XColor * colorPtr);
+#endif
+#ifdef HAVE_XFT
+MODULE_SCOPE void TkUnixSetXftClipRegion(TkRegion clipRegion);
+#endif
+
+/*
+ * Unsupported commands.
+ */
+
+MODULE_SCOPE int TkUnsupported1ObjCmd(ClientData clientData,
+ Tcl_Interp *interp, int objc,
+ Tcl_Obj *const objv[]);
+
+/*
+ * For Tktest.
+ */
+MODULE_SCOPE int SquareObjCmd(ClientData clientData,
+ Tcl_Interp *interp, int objc,
+ Tcl_Obj * const objv[]);
+MODULE_SCOPE int TkOldTestInit(Tcl_Interp *interp);
+#if !(defined(_WIN32) || defined(MAC_OSX_TK))
+#define TkplatformtestInit(x) TCL_OK
+#else
+MODULE_SCOPE int TkplatformtestInit(Tcl_Interp *interp);
+#endif
+
+#endif /* _TKINT */
+
+/*
+ * Local Variables:
+ * mode: c
+ * c-basic-offset: 4
+ * fill-column: 78
+ * End:
+ */
diff --git a/tk8.6/generic/tkIntDecls.h b/tk8.6/generic/tkIntDecls.h
new file mode 100644
index 0000000..b8addbd
--- /dev/null
+++ b/tk8.6/generic/tkIntDecls.h
@@ -0,0 +1,1179 @@
+/*
+ * 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.
+ */
+
+#ifndef _TKINTDECLS
+#define _TKINTDECLS
+
+#ifdef BUILD_tk
+#undef TCL_STORAGE_CLASS
+#define TCL_STORAGE_CLASS DLLEXPORT
+#endif
+
+struct TkText;
+typedef struct TkTextBTree_ *TkTextBTree;
+struct TkTextDispChunk;
+struct TkTextIndex;
+struct TkTextSegment;
+struct TkSharedText;
+
+/*
+ * 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. */
+
+#ifdef __cplusplus
+extern "C" {
+#endif
+
+/*
+ * Exported function declarations:
+ */
+
+/* 0 */
+EXTERN TkWindow * TkAllocWindow(TkDisplay *dispPtr, int screenNum,
+ TkWindow *parentPtr);
+/* 1 */
+EXTERN void TkBezierPoints(double control[], int numSteps,
+ double *coordPtr);
+/* 2 */
+EXTERN void TkBezierScreenPoints(Tk_Canvas canvas,
+ double control[], int numSteps,
+ XPoint *xPointPtr);
+/* Slot 3 is reserved */
+/* 4 */
+EXTERN void TkBindEventProc(TkWindow *winPtr, XEvent *eventPtr);
+/* 5 */
+EXTERN void TkBindFree(TkMainInfo *mainPtr);
+/* 6 */
+EXTERN void TkBindInit(TkMainInfo *mainPtr);
+/* 7 */
+EXTERN void TkChangeEventWindow(XEvent *eventPtr,
+ TkWindow *winPtr);
+/* 8 */
+EXTERN int TkClipInit(Tcl_Interp *interp, TkDisplay *dispPtr);
+/* 9 */
+EXTERN void TkComputeAnchor(Tk_Anchor anchor, Tk_Window tkwin,
+ int padX, int padY, int innerWidth,
+ int innerHeight, int *xPtr, int *yPtr);
+/* Slot 10 is reserved */
+/* Slot 11 is reserved */
+/* 12 */
+EXTERN TkCursor * TkCreateCursorFromData(Tk_Window tkwin,
+ const char *source, const char *mask,
+ int width, int height, int xHot, int yHot,
+ XColor fg, XColor bg);
+/* 13 */
+EXTERN int TkCreateFrame(ClientData clientData,
+ Tcl_Interp *interp, int argc,
+ const char *const *argv, int toplevel,
+ const char *appName);
+/* 14 */
+EXTERN Tk_Window TkCreateMainWindow(Tcl_Interp *interp,
+ const char *screenName, const char *baseName);
+/* 15 */
+EXTERN Time TkCurrentTime(TkDisplay *dispPtr);
+/* 16 */
+EXTERN void TkDeleteAllImages(TkMainInfo *mainPtr);
+/* 17 */
+EXTERN void TkDoConfigureNotify(TkWindow *winPtr);
+/* 18 */
+EXTERN void TkDrawInsetFocusHighlight(Tk_Window tkwin, GC gc,
+ int width, Drawable drawable, int padding);
+/* 19 */
+EXTERN void TkEventDeadWindow(TkWindow *winPtr);
+/* 20 */
+EXTERN void TkFillPolygon(Tk_Canvas canvas, double *coordPtr,
+ int numPoints, Display *display,
+ Drawable drawable, GC gc, GC outlineGC);
+/* 21 */
+EXTERN int TkFindStateNum(Tcl_Interp *interp,
+ const char *option, const TkStateMap *mapPtr,
+ const char *strKey);
+/* 22 */
+EXTERN CONST86 char * TkFindStateString(const TkStateMap *mapPtr,
+ int numKey);
+/* 23 */
+EXTERN void TkFocusDeadWindow(TkWindow *winPtr);
+/* 24 */
+EXTERN int TkFocusFilterEvent(TkWindow *winPtr,
+ XEvent *eventPtr);
+/* 25 */
+EXTERN TkWindow * TkFocusKeyEvent(TkWindow *winPtr, XEvent *eventPtr);
+/* 26 */
+EXTERN void TkFontPkgInit(TkMainInfo *mainPtr);
+/* 27 */
+EXTERN void TkFontPkgFree(TkMainInfo *mainPtr);
+/* 28 */
+EXTERN void TkFreeBindingTags(TkWindow *winPtr);
+/* 29 */
+EXTERN void TkpFreeCursor(TkCursor *cursorPtr);
+/* 30 */
+EXTERN char * TkGetBitmapData(Tcl_Interp *interp,
+ const char *string, const char *fileName,
+ int *widthPtr, int *heightPtr, int *hotXPtr,
+ int *hotYPtr);
+/* 31 */
+EXTERN void TkGetButtPoints(double p1[], double p2[],
+ double width, int project, double m1[],
+ double m2[]);
+/* 32 */
+EXTERN TkCursor * TkGetCursorByName(Tcl_Interp *interp,
+ Tk_Window tkwin, Tk_Uid string);
+/* 33 */
+EXTERN const char * TkGetDefaultScreenName(Tcl_Interp *interp,
+ const char *screenName);
+/* 34 */
+EXTERN TkDisplay * TkGetDisplay(Display *display);
+/* 35 */
+EXTERN int TkGetDisplayOf(Tcl_Interp *interp, int objc,
+ Tcl_Obj *const objv[], Tk_Window *tkwinPtr);
+/* 36 */
+EXTERN TkWindow * TkGetFocusWin(TkWindow *winPtr);
+/* 37 */
+EXTERN int TkGetInterpNames(Tcl_Interp *interp, Tk_Window tkwin);
+/* 38 */
+EXTERN int TkGetMiterPoints(double p1[], double p2[],
+ double p3[], double width, double m1[],
+ double m2[]);
+/* 39 */
+EXTERN void TkGetPointerCoords(Tk_Window tkwin, int *xPtr,
+ int *yPtr);
+/* 40 */
+EXTERN void TkGetServerInfo(Tcl_Interp *interp, Tk_Window tkwin);
+/* 41 */
+EXTERN void TkGrabDeadWindow(TkWindow *winPtr);
+/* 42 */
+EXTERN int TkGrabState(TkWindow *winPtr);
+/* 43 */
+EXTERN void TkIncludePoint(Tk_Item *itemPtr, double *pointPtr);
+/* 44 */
+EXTERN void TkInOutEvents(XEvent *eventPtr, TkWindow *sourcePtr,
+ TkWindow *destPtr, int leaveType,
+ int enterType, Tcl_QueuePosition position);
+/* 45 */
+EXTERN void TkInstallFrameMenu(Tk_Window tkwin);
+/* 46 */
+EXTERN CONST86 char * TkKeysymToString(KeySym keysym);
+/* 47 */
+EXTERN int TkLineToArea(double end1Ptr[], double end2Ptr[],
+ double rectPtr[]);
+/* 48 */
+EXTERN double TkLineToPoint(double end1Ptr[], double end2Ptr[],
+ double pointPtr[]);
+/* 49 */
+EXTERN int TkMakeBezierCurve(Tk_Canvas canvas, double *pointPtr,
+ int numPoints, int numSteps,
+ XPoint xPoints[], double dblPoints[]);
+/* 50 */
+EXTERN void TkMakeBezierPostscript(Tcl_Interp *interp,
+ Tk_Canvas canvas, double *pointPtr,
+ int numPoints);
+/* 51 */
+EXTERN void TkOptionClassChanged(TkWindow *winPtr);
+/* 52 */
+EXTERN void TkOptionDeadWindow(TkWindow *winPtr);
+/* 53 */
+EXTERN int TkOvalToArea(double *ovalPtr, double *rectPtr);
+/* 54 */
+EXTERN double TkOvalToPoint(double ovalPtr[], double width,
+ int filled, double pointPtr[]);
+/* 55 */
+EXTERN int TkpChangeFocus(TkWindow *winPtr, int force);
+/* 56 */
+EXTERN void TkpCloseDisplay(TkDisplay *dispPtr);
+/* 57 */
+EXTERN void TkpClaimFocus(TkWindow *topLevelPtr, int force);
+/* 58 */
+EXTERN void TkpDisplayWarning(const char *msg, const char *title);
+/* 59 */
+EXTERN void TkpGetAppName(Tcl_Interp *interp, Tcl_DString *name);
+/* 60 */
+EXTERN TkWindow * TkpGetOtherWindow(TkWindow *winPtr);
+/* 61 */
+EXTERN TkWindow * TkpGetWrapperWindow(TkWindow *winPtr);
+/* 62 */
+EXTERN int TkpInit(Tcl_Interp *interp);
+/* 63 */
+EXTERN void TkpInitializeMenuBindings(Tcl_Interp *interp,
+ Tk_BindingTable bindingTable);
+/* 64 */
+EXTERN void TkpMakeContainer(Tk_Window tkwin);
+/* 65 */
+EXTERN void TkpMakeMenuWindow(Tk_Window tkwin, int transient);
+/* 66 */
+EXTERN Window TkpMakeWindow(TkWindow *winPtr, Window parent);
+/* 67 */
+EXTERN void TkpMenuNotifyToplevelCreate(Tcl_Interp *interp,
+ const char *menuName);
+/* 68 */
+EXTERN TkDisplay * TkpOpenDisplay(const char *display_name);
+/* 69 */
+EXTERN int TkPointerEvent(XEvent *eventPtr, TkWindow *winPtr);
+/* 70 */
+EXTERN int TkPolygonToArea(double *polyPtr, int numPoints,
+ double *rectPtr);
+/* 71 */
+EXTERN double TkPolygonToPoint(double *polyPtr, int numPoints,
+ double *pointPtr);
+/* 72 */
+EXTERN int TkPositionInTree(TkWindow *winPtr, TkWindow *treePtr);
+/* 73 */
+EXTERN void TkpRedirectKeyEvent(TkWindow *winPtr,
+ XEvent *eventPtr);
+/* 74 */
+EXTERN void TkpSetMainMenubar(Tcl_Interp *interp,
+ Tk_Window tkwin, const char *menuName);
+/* 75 */
+EXTERN int TkpUseWindow(Tcl_Interp *interp, Tk_Window tkwin,
+ const char *string);
+/* Slot 76 is reserved */
+/* 77 */
+EXTERN void TkQueueEventForAllChildren(TkWindow *winPtr,
+ XEvent *eventPtr);
+/* 78 */
+EXTERN 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);
+/* 79 */
+EXTERN int TkScrollWindow(Tk_Window tkwin, GC gc, int x, int y,
+ int width, int height, int dx, int dy,
+ TkRegion damageRgn);
+/* 80 */
+EXTERN void TkSelDeadWindow(TkWindow *winPtr);
+/* 81 */
+EXTERN void TkSelEventProc(Tk_Window tkwin, XEvent *eventPtr);
+/* 82 */
+EXTERN void TkSelInit(Tk_Window tkwin);
+/* 83 */
+EXTERN void TkSelPropProc(XEvent *eventPtr);
+/* Slot 84 is reserved */
+/* 85 */
+EXTERN void TkSetWindowMenuBar(Tcl_Interp *interp,
+ Tk_Window tkwin, const char *oldMenuName,
+ const char *menuName);
+/* 86 */
+EXTERN KeySym TkStringToKeysym(const char *name);
+/* 87 */
+EXTERN int TkThickPolyLineToArea(double *coordPtr,
+ int numPoints, double width, int capStyle,
+ int joinStyle, double *rectPtr);
+/* 88 */
+EXTERN void TkWmAddToColormapWindows(TkWindow *winPtr);
+/* 89 */
+EXTERN void TkWmDeadWindow(TkWindow *winPtr);
+/* 90 */
+EXTERN TkWindow * TkWmFocusToplevel(TkWindow *winPtr);
+/* 91 */
+EXTERN void TkWmMapWindow(TkWindow *winPtr);
+/* 92 */
+EXTERN void TkWmNewWindow(TkWindow *winPtr);
+/* 93 */
+EXTERN void TkWmProtocolEventProc(TkWindow *winPtr,
+ XEvent *evenvPtr);
+/* 94 */
+EXTERN void TkWmRemoveFromColormapWindows(TkWindow *winPtr);
+/* 95 */
+EXTERN void TkWmRestackToplevel(TkWindow *winPtr, int aboveBelow,
+ TkWindow *otherPtr);
+/* 96 */
+EXTERN void TkWmSetClass(TkWindow *winPtr);
+/* 97 */
+EXTERN void TkWmUnmapWindow(TkWindow *winPtr);
+/* 98 */
+EXTERN Tcl_Obj * TkDebugBitmap(Tk_Window tkwin, const char *name);
+/* 99 */
+EXTERN Tcl_Obj * TkDebugBorder(Tk_Window tkwin, const char *name);
+/* 100 */
+EXTERN Tcl_Obj * TkDebugCursor(Tk_Window tkwin, const char *name);
+/* 101 */
+EXTERN Tcl_Obj * TkDebugColor(Tk_Window tkwin, const char *name);
+/* 102 */
+EXTERN Tcl_Obj * TkDebugConfig(Tcl_Interp *interp,
+ Tk_OptionTable table);
+/* 103 */
+EXTERN Tcl_Obj * TkDebugFont(Tk_Window tkwin, const char *name);
+/* 104 */
+EXTERN int TkFindStateNumObj(Tcl_Interp *interp,
+ Tcl_Obj *optionPtr, const TkStateMap *mapPtr,
+ Tcl_Obj *keyPtr);
+/* 105 */
+EXTERN Tcl_HashTable * TkGetBitmapPredefTable(void);
+/* 106 */
+EXTERN TkDisplay * TkGetDisplayList(void);
+/* 107 */
+EXTERN TkMainInfo * TkGetMainInfoList(void);
+/* 108 */
+EXTERN int TkGetWindowFromObj(Tcl_Interp *interp,
+ Tk_Window tkwin, Tcl_Obj *objPtr,
+ Tk_Window *windowPtr);
+/* 109 */
+EXTERN CONST86 char * TkpGetString(TkWindow *winPtr, XEvent *eventPtr,
+ Tcl_DString *dsPtr);
+/* 110 */
+EXTERN void TkpGetSubFonts(Tcl_Interp *interp, Tk_Font tkfont);
+/* 111 */
+EXTERN Tcl_Obj * TkpGetSystemDefault(Tk_Window tkwin,
+ const char *dbName, const char *className);
+/* 112 */
+EXTERN void TkpMenuThreadInit(void);
+/* 113 */
+EXTERN void TkClipBox(TkRegion rgn, XRectangle *rect_return);
+/* 114 */
+EXTERN TkRegion TkCreateRegion(void);
+/* 115 */
+EXTERN void TkDestroyRegion(TkRegion rgn);
+/* 116 */
+EXTERN void TkIntersectRegion(TkRegion sra, TkRegion srcb,
+ TkRegion dr_return);
+/* 117 */
+EXTERN int TkRectInRegion(TkRegion rgn, int x, int y,
+ unsigned int width, unsigned int height);
+/* 118 */
+EXTERN void TkSetRegion(Display *display, GC gc, TkRegion rgn);
+/* 119 */
+EXTERN void TkUnionRectWithRegion(XRectangle *rect, TkRegion src,
+ TkRegion dr_return);
+/* Slot 120 is reserved */
+#ifdef MAC_OSX_TK /* AQUA */
+/* 121 */
+EXTERN Pixmap TkpCreateNativeBitmap(Display *display,
+ const void *source);
+#endif /* AQUA */
+#ifdef MAC_OSX_TK /* AQUA */
+/* 122 */
+EXTERN void TkpDefineNativeBitmaps(void);
+#endif /* AQUA */
+/* Slot 123 is reserved */
+#ifdef MAC_OSX_TK /* AQUA */
+/* 124 */
+EXTERN Pixmap TkpGetNativeAppBitmap(Display *display,
+ const char *name, int *width, int *height);
+#endif /* AQUA */
+/* Slot 125 is reserved */
+/* Slot 126 is reserved */
+/* Slot 127 is reserved */
+/* Slot 128 is reserved */
+/* Slot 129 is reserved */
+/* Slot 130 is reserved */
+/* Slot 131 is reserved */
+/* Slot 132 is reserved */
+/* Slot 133 is reserved */
+/* Slot 134 is reserved */
+/* 135 */
+EXTERN void TkpDrawHighlightBorder(Tk_Window tkwin, GC fgGC,
+ GC bgGC, int highlightWidth,
+ Drawable drawable);
+/* 136 */
+EXTERN void TkSetFocusWin(TkWindow *winPtr, int force);
+/* 137 */
+EXTERN void TkpSetKeycodeAndState(Tk_Window tkwin, KeySym keySym,
+ XEvent *eventPtr);
+/* 138 */
+EXTERN KeySym TkpGetKeySym(TkDisplay *dispPtr, XEvent *eventPtr);
+/* 139 */
+EXTERN void TkpInitKeymapInfo(TkDisplay *dispPtr);
+/* 140 */
+EXTERN TkRegion TkPhotoGetValidRegion(Tk_PhotoHandle handle);
+/* 141 */
+EXTERN TkWindow ** TkWmStackorderToplevel(TkWindow *parentPtr);
+/* 142 */
+EXTERN void TkFocusFree(TkMainInfo *mainPtr);
+/* 143 */
+EXTERN void TkClipCleanup(TkDisplay *dispPtr);
+/* 144 */
+EXTERN void TkGCCleanup(TkDisplay *dispPtr);
+/* 145 */
+EXTERN void TkSubtractRegion(TkRegion sra, TkRegion srcb,
+ TkRegion dr_return);
+/* 146 */
+EXTERN void TkStylePkgInit(TkMainInfo *mainPtr);
+/* 147 */
+EXTERN void TkStylePkgFree(TkMainInfo *mainPtr);
+/* 148 */
+EXTERN Tk_Window TkToplevelWindowForCommand(Tcl_Interp *interp,
+ const char *cmdName);
+/* 149 */
+EXTERN const Tk_OptionSpec * TkGetOptionSpec(const char *name,
+ Tk_OptionTable optionTable);
+/* 150 */
+EXTERN int TkMakeRawCurve(Tk_Canvas canvas, double *pointPtr,
+ int numPoints, int numSteps,
+ XPoint xPoints[], double dblPoints[]);
+/* 151 */
+EXTERN void TkMakeRawCurvePostscript(Tcl_Interp *interp,
+ Tk_Canvas canvas, double *pointPtr,
+ int numPoints);
+/* 152 */
+EXTERN void TkpDrawFrame(Tk_Window tkwin, Tk_3DBorder border,
+ int highlightWidth, int borderWidth,
+ int relief);
+/* 153 */
+EXTERN void TkCreateThreadExitHandler(Tcl_ExitProc *proc,
+ ClientData clientData);
+/* 154 */
+EXTERN void TkDeleteThreadExitHandler(Tcl_ExitProc *proc,
+ ClientData clientData);
+/* Slot 155 is reserved */
+/* 156 */
+EXTERN int TkpTestembedCmd(ClientData clientData,
+ Tcl_Interp *interp, int objc,
+ Tcl_Obj *const objv[]);
+/* 157 */
+EXTERN int TkpTesttextCmd(ClientData dummy, Tcl_Interp *interp,
+ int objc, Tcl_Obj *const objv[]);
+/* 158 */
+EXTERN int TkSelGetSelection(Tcl_Interp *interp,
+ Tk_Window tkwin, Atom selection, Atom target,
+ Tk_GetSelProc *proc, ClientData clientData);
+/* 159 */
+EXTERN int TkTextGetIndex(Tcl_Interp *interp,
+ struct TkText *textPtr, const char *string,
+ struct TkTextIndex *indexPtr);
+/* 160 */
+EXTERN int TkTextIndexBackBytes(const struct TkText *textPtr,
+ const struct TkTextIndex *srcPtr, int count,
+ struct TkTextIndex *dstPtr);
+/* 161 */
+EXTERN int TkTextIndexForwBytes(const struct TkText *textPtr,
+ const struct TkTextIndex *srcPtr, int count,
+ struct TkTextIndex *dstPtr);
+/* 162 */
+EXTERN struct TkTextIndex * TkTextMakeByteIndex(TkTextBTree tree,
+ const struct TkText *textPtr, int lineIndex,
+ int byteIndex, struct TkTextIndex *indexPtr);
+/* 163 */
+EXTERN int TkTextPrintIndex(const struct TkText *textPtr,
+ const struct TkTextIndex *indexPtr,
+ char *string);
+/* 164 */
+EXTERN struct TkTextSegment * TkTextSetMark(struct TkText *textPtr,
+ const char *name,
+ struct TkTextIndex *indexPtr);
+/* 165 */
+EXTERN int TkTextXviewCmd(struct TkText *textPtr,
+ Tcl_Interp *interp, int objc,
+ Tcl_Obj *const objv[]);
+/* 166 */
+EXTERN void TkTextChanged(struct TkSharedText *sharedTextPtr,
+ struct TkText *textPtr,
+ const struct TkTextIndex *index1Ptr,
+ const struct TkTextIndex *index2Ptr);
+/* 167 */
+EXTERN int TkBTreeNumLines(TkTextBTree tree,
+ const struct TkText *textPtr);
+/* 168 */
+EXTERN void TkTextInsertDisplayProc(struct TkText *textPtr,
+ struct TkTextDispChunk *chunkPtr, int x,
+ int y, int height, int baseline,
+ Display *display, Drawable dst, int screenY);
+/* 169 */
+EXTERN int TkStateParseProc(ClientData clientData,
+ Tcl_Interp *interp, Tk_Window tkwin,
+ const char *value, char *widgRec, int offset);
+/* 170 */
+EXTERN CONST86 char * TkStatePrintProc(ClientData clientData,
+ Tk_Window tkwin, char *widgRec, int offset,
+ Tcl_FreeProc **freeProcPtr);
+/* 171 */
+EXTERN int TkCanvasDashParseProc(ClientData clientData,
+ Tcl_Interp *interp, Tk_Window tkwin,
+ const char *value, char *widgRec, int offset);
+/* 172 */
+EXTERN CONST86 char * TkCanvasDashPrintProc(ClientData clientData,
+ Tk_Window tkwin, char *widgRec, int offset,
+ Tcl_FreeProc **freeProcPtr);
+/* 173 */
+EXTERN int TkOffsetParseProc(ClientData clientData,
+ Tcl_Interp *interp, Tk_Window tkwin,
+ const char *value, char *widgRec, int offset);
+/* 174 */
+EXTERN CONST86 char * TkOffsetPrintProc(ClientData clientData,
+ Tk_Window tkwin, char *widgRec, int offset,
+ Tcl_FreeProc **freeProcPtr);
+/* 175 */
+EXTERN int TkPixelParseProc(ClientData clientData,
+ Tcl_Interp *interp, Tk_Window tkwin,
+ const char *value, char *widgRec, int offset);
+/* 176 */
+EXTERN CONST86 char * TkPixelPrintProc(ClientData clientData,
+ Tk_Window tkwin, char *widgRec, int offset,
+ Tcl_FreeProc **freeProcPtr);
+/* 177 */
+EXTERN int TkOrientParseProc(ClientData clientData,
+ Tcl_Interp *interp, Tk_Window tkwin,
+ const char *value, char *widgRec, int offset);
+/* 178 */
+EXTERN CONST86 char * TkOrientPrintProc(ClientData clientData,
+ Tk_Window tkwin, char *widgRec, int offset,
+ Tcl_FreeProc **freeProcPtr);
+/* 179 */
+EXTERN int TkSmoothParseProc(ClientData clientData,
+ Tcl_Interp *interp, Tk_Window tkwin,
+ const char *value, char *widgRec, int offset);
+/* 180 */
+EXTERN CONST86 char * TkSmoothPrintProc(ClientData clientData,
+ Tk_Window tkwin, char *widgRec, int offset,
+ Tcl_FreeProc **freeProcPtr);
+/* 181 */
+EXTERN void TkDrawAngledTextLayout(Display *display,
+ Drawable drawable, GC gc,
+ Tk_TextLayout layout, int x, int y,
+ double angle, int firstChar, int lastChar);
+/* 182 */
+EXTERN void TkUnderlineAngledTextLayout(Display *display,
+ Drawable drawable, GC gc,
+ Tk_TextLayout layout, int x, int y,
+ double angle, int underline);
+/* 183 */
+EXTERN int TkIntersectAngledTextLayout(Tk_TextLayout layout,
+ int x, int y, int width, int height,
+ double angle);
+/* 184 */
+EXTERN void TkDrawAngledChars(Display *display,
+ Drawable drawable, GC gc, Tk_Font tkfont,
+ const char *source, int numBytes, double x,
+ double y, double angle);
+
+typedef struct TkIntStubs {
+ int magic;
+ void *hooks;
+
+ TkWindow * (*tkAllocWindow) (TkDisplay *dispPtr, int screenNum, TkWindow *parentPtr); /* 0 */
+ void (*tkBezierPoints) (double control[], int numSteps, double *coordPtr); /* 1 */
+ void (*tkBezierScreenPoints) (Tk_Canvas canvas, double control[], int numSteps, XPoint *xPointPtr); /* 2 */
+ void (*reserved3)(void);
+ void (*tkBindEventProc) (TkWindow *winPtr, XEvent *eventPtr); /* 4 */
+ void (*tkBindFree) (TkMainInfo *mainPtr); /* 5 */
+ void (*tkBindInit) (TkMainInfo *mainPtr); /* 6 */
+ void (*tkChangeEventWindow) (XEvent *eventPtr, TkWindow *winPtr); /* 7 */
+ int (*tkClipInit) (Tcl_Interp *interp, TkDisplay *dispPtr); /* 8 */
+ void (*tkComputeAnchor) (Tk_Anchor anchor, Tk_Window tkwin, int padX, int padY, int innerWidth, int innerHeight, int *xPtr, int *yPtr); /* 9 */
+ void (*reserved10)(void);
+ void (*reserved11)(void);
+ TkCursor * (*tkCreateCursorFromData) (Tk_Window tkwin, const char *source, const char *mask, int width, int height, int xHot, int yHot, XColor fg, XColor bg); /* 12 */
+ int (*tkCreateFrame) (ClientData clientData, Tcl_Interp *interp, int argc, const char *const *argv, int toplevel, const char *appName); /* 13 */
+ Tk_Window (*tkCreateMainWindow) (Tcl_Interp *interp, const char *screenName, const char *baseName); /* 14 */
+ Time (*tkCurrentTime) (TkDisplay *dispPtr); /* 15 */
+ void (*tkDeleteAllImages) (TkMainInfo *mainPtr); /* 16 */
+ void (*tkDoConfigureNotify) (TkWindow *winPtr); /* 17 */
+ void (*tkDrawInsetFocusHighlight) (Tk_Window tkwin, GC gc, int width, Drawable drawable, int padding); /* 18 */
+ void (*tkEventDeadWindow) (TkWindow *winPtr); /* 19 */
+ void (*tkFillPolygon) (Tk_Canvas canvas, double *coordPtr, int numPoints, Display *display, Drawable drawable, GC gc, GC outlineGC); /* 20 */
+ int (*tkFindStateNum) (Tcl_Interp *interp, const char *option, const TkStateMap *mapPtr, const char *strKey); /* 21 */
+ CONST86 char * (*tkFindStateString) (const TkStateMap *mapPtr, int numKey); /* 22 */
+ void (*tkFocusDeadWindow) (TkWindow *winPtr); /* 23 */
+ int (*tkFocusFilterEvent) (TkWindow *winPtr, XEvent *eventPtr); /* 24 */
+ TkWindow * (*tkFocusKeyEvent) (TkWindow *winPtr, XEvent *eventPtr); /* 25 */
+ void (*tkFontPkgInit) (TkMainInfo *mainPtr); /* 26 */
+ void (*tkFontPkgFree) (TkMainInfo *mainPtr); /* 27 */
+ void (*tkFreeBindingTags) (TkWindow *winPtr); /* 28 */
+ void (*tkpFreeCursor) (TkCursor *cursorPtr); /* 29 */
+ char * (*tkGetBitmapData) (Tcl_Interp *interp, const char *string, const char *fileName, int *widthPtr, int *heightPtr, int *hotXPtr, int *hotYPtr); /* 30 */
+ void (*tkGetButtPoints) (double p1[], double p2[], double width, int project, double m1[], double m2[]); /* 31 */
+ TkCursor * (*tkGetCursorByName) (Tcl_Interp *interp, Tk_Window tkwin, Tk_Uid string); /* 32 */
+ const char * (*tkGetDefaultScreenName) (Tcl_Interp *interp, const char *screenName); /* 33 */
+ TkDisplay * (*tkGetDisplay) (Display *display); /* 34 */
+ int (*tkGetDisplayOf) (Tcl_Interp *interp, int objc, Tcl_Obj *const objv[], Tk_Window *tkwinPtr); /* 35 */
+ TkWindow * (*tkGetFocusWin) (TkWindow *winPtr); /* 36 */
+ int (*tkGetInterpNames) (Tcl_Interp *interp, Tk_Window tkwin); /* 37 */
+ int (*tkGetMiterPoints) (double p1[], double p2[], double p3[], double width, double m1[], double m2[]); /* 38 */
+ void (*tkGetPointerCoords) (Tk_Window tkwin, int *xPtr, int *yPtr); /* 39 */
+ void (*tkGetServerInfo) (Tcl_Interp *interp, Tk_Window tkwin); /* 40 */
+ void (*tkGrabDeadWindow) (TkWindow *winPtr); /* 41 */
+ int (*tkGrabState) (TkWindow *winPtr); /* 42 */
+ void (*tkIncludePoint) (Tk_Item *itemPtr, double *pointPtr); /* 43 */
+ void (*tkInOutEvents) (XEvent *eventPtr, TkWindow *sourcePtr, TkWindow *destPtr, int leaveType, int enterType, Tcl_QueuePosition position); /* 44 */
+ void (*tkInstallFrameMenu) (Tk_Window tkwin); /* 45 */
+ CONST86 char * (*tkKeysymToString) (KeySym keysym); /* 46 */
+ int (*tkLineToArea) (double end1Ptr[], double end2Ptr[], double rectPtr[]); /* 47 */
+ double (*tkLineToPoint) (double end1Ptr[], double end2Ptr[], double pointPtr[]); /* 48 */
+ int (*tkMakeBezierCurve) (Tk_Canvas canvas, double *pointPtr, int numPoints, int numSteps, XPoint xPoints[], double dblPoints[]); /* 49 */
+ void (*tkMakeBezierPostscript) (Tcl_Interp *interp, Tk_Canvas canvas, double *pointPtr, int numPoints); /* 50 */
+ void (*tkOptionClassChanged) (TkWindow *winPtr); /* 51 */
+ void (*tkOptionDeadWindow) (TkWindow *winPtr); /* 52 */
+ int (*tkOvalToArea) (double *ovalPtr, double *rectPtr); /* 53 */
+ double (*tkOvalToPoint) (double ovalPtr[], double width, int filled, double pointPtr[]); /* 54 */
+ int (*tkpChangeFocus) (TkWindow *winPtr, int force); /* 55 */
+ void (*tkpCloseDisplay) (TkDisplay *dispPtr); /* 56 */
+ void (*tkpClaimFocus) (TkWindow *topLevelPtr, int force); /* 57 */
+ void (*tkpDisplayWarning) (const char *msg, const char *title); /* 58 */
+ void (*tkpGetAppName) (Tcl_Interp *interp, Tcl_DString *name); /* 59 */
+ TkWindow * (*tkpGetOtherWindow) (TkWindow *winPtr); /* 60 */
+ TkWindow * (*tkpGetWrapperWindow) (TkWindow *winPtr); /* 61 */
+ int (*tkpInit) (Tcl_Interp *interp); /* 62 */
+ void (*tkpInitializeMenuBindings) (Tcl_Interp *interp, Tk_BindingTable bindingTable); /* 63 */
+ void (*tkpMakeContainer) (Tk_Window tkwin); /* 64 */
+ void (*tkpMakeMenuWindow) (Tk_Window tkwin, int transient); /* 65 */
+ Window (*tkpMakeWindow) (TkWindow *winPtr, Window parent); /* 66 */
+ void (*tkpMenuNotifyToplevelCreate) (Tcl_Interp *interp, const char *menuName); /* 67 */
+ TkDisplay * (*tkpOpenDisplay) (const char *display_name); /* 68 */
+ int (*tkPointerEvent) (XEvent *eventPtr, TkWindow *winPtr); /* 69 */
+ int (*tkPolygonToArea) (double *polyPtr, int numPoints, double *rectPtr); /* 70 */
+ double (*tkPolygonToPoint) (double *polyPtr, int numPoints, double *pointPtr); /* 71 */
+ int (*tkPositionInTree) (TkWindow *winPtr, TkWindow *treePtr); /* 72 */
+ void (*tkpRedirectKeyEvent) (TkWindow *winPtr, XEvent *eventPtr); /* 73 */
+ void (*tkpSetMainMenubar) (Tcl_Interp *interp, Tk_Window tkwin, const char *menuName); /* 74 */
+ int (*tkpUseWindow) (Tcl_Interp *interp, Tk_Window tkwin, const char *string); /* 75 */
+ void (*reserved76)(void);
+ void (*tkQueueEventForAllChildren) (TkWindow *winPtr, XEvent *eventPtr); /* 77 */
+ 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); /* 78 */
+ int (*tkScrollWindow) (Tk_Window tkwin, GC gc, int x, int y, int width, int height, int dx, int dy, TkRegion damageRgn); /* 79 */
+ void (*tkSelDeadWindow) (TkWindow *winPtr); /* 80 */
+ void (*tkSelEventProc) (Tk_Window tkwin, XEvent *eventPtr); /* 81 */
+ void (*tkSelInit) (Tk_Window tkwin); /* 82 */
+ void (*tkSelPropProc) (XEvent *eventPtr); /* 83 */
+ void (*reserved84)(void);
+ void (*tkSetWindowMenuBar) (Tcl_Interp *interp, Tk_Window tkwin, const char *oldMenuName, const char *menuName); /* 85 */
+ KeySym (*tkStringToKeysym) (const char *name); /* 86 */
+ int (*tkThickPolyLineToArea) (double *coordPtr, int numPoints, double width, int capStyle, int joinStyle, double *rectPtr); /* 87 */
+ void (*tkWmAddToColormapWindows) (TkWindow *winPtr); /* 88 */
+ void (*tkWmDeadWindow) (TkWindow *winPtr); /* 89 */
+ TkWindow * (*tkWmFocusToplevel) (TkWindow *winPtr); /* 90 */
+ void (*tkWmMapWindow) (TkWindow *winPtr); /* 91 */
+ void (*tkWmNewWindow) (TkWindow *winPtr); /* 92 */
+ void (*tkWmProtocolEventProc) (TkWindow *winPtr, XEvent *evenvPtr); /* 93 */
+ void (*tkWmRemoveFromColormapWindows) (TkWindow *winPtr); /* 94 */
+ void (*tkWmRestackToplevel) (TkWindow *winPtr, int aboveBelow, TkWindow *otherPtr); /* 95 */
+ void (*tkWmSetClass) (TkWindow *winPtr); /* 96 */
+ void (*tkWmUnmapWindow) (TkWindow *winPtr); /* 97 */
+ Tcl_Obj * (*tkDebugBitmap) (Tk_Window tkwin, const char *name); /* 98 */
+ Tcl_Obj * (*tkDebugBorder) (Tk_Window tkwin, const char *name); /* 99 */
+ Tcl_Obj * (*tkDebugCursor) (Tk_Window tkwin, const char *name); /* 100 */
+ Tcl_Obj * (*tkDebugColor) (Tk_Window tkwin, const char *name); /* 101 */
+ Tcl_Obj * (*tkDebugConfig) (Tcl_Interp *interp, Tk_OptionTable table); /* 102 */
+ Tcl_Obj * (*tkDebugFont) (Tk_Window tkwin, const char *name); /* 103 */
+ int (*tkFindStateNumObj) (Tcl_Interp *interp, Tcl_Obj *optionPtr, const TkStateMap *mapPtr, Tcl_Obj *keyPtr); /* 104 */
+ Tcl_HashTable * (*tkGetBitmapPredefTable) (void); /* 105 */
+ TkDisplay * (*tkGetDisplayList) (void); /* 106 */
+ TkMainInfo * (*tkGetMainInfoList) (void); /* 107 */
+ int (*tkGetWindowFromObj) (Tcl_Interp *interp, Tk_Window tkwin, Tcl_Obj *objPtr, Tk_Window *windowPtr); /* 108 */
+ CONST86 char * (*tkpGetString) (TkWindow *winPtr, XEvent *eventPtr, Tcl_DString *dsPtr); /* 109 */
+ void (*tkpGetSubFonts) (Tcl_Interp *interp, Tk_Font tkfont); /* 110 */
+ Tcl_Obj * (*tkpGetSystemDefault) (Tk_Window tkwin, const char *dbName, const char *className); /* 111 */
+ void (*tkpMenuThreadInit) (void); /* 112 */
+ void (*tkClipBox) (TkRegion rgn, XRectangle *rect_return); /* 113 */
+ TkRegion (*tkCreateRegion) (void); /* 114 */
+ void (*tkDestroyRegion) (TkRegion rgn); /* 115 */
+ void (*tkIntersectRegion) (TkRegion sra, TkRegion srcb, TkRegion dr_return); /* 116 */
+ int (*tkRectInRegion) (TkRegion rgn, int x, int y, unsigned int width, unsigned int height); /* 117 */
+ void (*tkSetRegion) (Display *display, GC gc, TkRegion rgn); /* 118 */
+ void (*tkUnionRectWithRegion) (XRectangle *rect, TkRegion src, TkRegion dr_return); /* 119 */
+ void (*reserved120)(void);
+#if !(defined(_WIN32) || defined(MAC_OSX_TK)) /* X11 */
+ void (*reserved121)(void);
+#endif /* X11 */
+#if defined(_WIN32) /* WIN */
+ void (*reserved121)(void);
+#endif /* WIN */
+#ifdef MAC_OSX_TK /* AQUA */
+ void (*reserved121)(void); /* Dummy entry for stubs table backwards compatibility */
+ Pixmap (*tkpCreateNativeBitmap) (Display *display, const void *source); /* 121 */
+#endif /* AQUA */
+#if !(defined(_WIN32) || defined(MAC_OSX_TK)) /* X11 */
+ void (*reserved122)(void);
+#endif /* X11 */
+#if defined(_WIN32) /* WIN */
+ void (*reserved122)(void);
+#endif /* WIN */
+#ifdef MAC_OSX_TK /* AQUA */
+ void (*reserved122)(void); /* Dummy entry for stubs table backwards compatibility */
+ void (*tkpDefineNativeBitmaps) (void); /* 122 */
+#endif /* AQUA */
+ void (*reserved123)(void);
+#if !(defined(_WIN32) || defined(MAC_OSX_TK)) /* X11 */
+ void (*reserved124)(void);
+#endif /* X11 */
+#if defined(_WIN32) /* WIN */
+ void (*reserved124)(void);
+#endif /* WIN */
+#ifdef MAC_OSX_TK /* AQUA */
+ void (*reserved124)(void); /* Dummy entry for stubs table backwards compatibility */
+ Pixmap (*tkpGetNativeAppBitmap) (Display *display, const char *name, int *width, int *height); /* 124 */
+#endif /* AQUA */
+ void (*reserved125)(void);
+ void (*reserved126)(void);
+ void (*reserved127)(void);
+ void (*reserved128)(void);
+ void (*reserved129)(void);
+ void (*reserved130)(void);
+ void (*reserved131)(void);
+ void (*reserved132)(void);
+ void (*reserved133)(void);
+ void (*reserved134)(void);
+ void (*tkpDrawHighlightBorder) (Tk_Window tkwin, GC fgGC, GC bgGC, int highlightWidth, Drawable drawable); /* 135 */
+ void (*tkSetFocusWin) (TkWindow *winPtr, int force); /* 136 */
+ void (*tkpSetKeycodeAndState) (Tk_Window tkwin, KeySym keySym, XEvent *eventPtr); /* 137 */
+ KeySym (*tkpGetKeySym) (TkDisplay *dispPtr, XEvent *eventPtr); /* 138 */
+ void (*tkpInitKeymapInfo) (TkDisplay *dispPtr); /* 139 */
+ TkRegion (*tkPhotoGetValidRegion) (Tk_PhotoHandle handle); /* 140 */
+ TkWindow ** (*tkWmStackorderToplevel) (TkWindow *parentPtr); /* 141 */
+ void (*tkFocusFree) (TkMainInfo *mainPtr); /* 142 */
+ void (*tkClipCleanup) (TkDisplay *dispPtr); /* 143 */
+ void (*tkGCCleanup) (TkDisplay *dispPtr); /* 144 */
+ void (*tkSubtractRegion) (TkRegion sra, TkRegion srcb, TkRegion dr_return); /* 145 */
+ void (*tkStylePkgInit) (TkMainInfo *mainPtr); /* 146 */
+ void (*tkStylePkgFree) (TkMainInfo *mainPtr); /* 147 */
+ Tk_Window (*tkToplevelWindowForCommand) (Tcl_Interp *interp, const char *cmdName); /* 148 */
+ const Tk_OptionSpec * (*tkGetOptionSpec) (const char *name, Tk_OptionTable optionTable); /* 149 */
+ int (*tkMakeRawCurve) (Tk_Canvas canvas, double *pointPtr, int numPoints, int numSteps, XPoint xPoints[], double dblPoints[]); /* 150 */
+ void (*tkMakeRawCurvePostscript) (Tcl_Interp *interp, Tk_Canvas canvas, double *pointPtr, int numPoints); /* 151 */
+ void (*tkpDrawFrame) (Tk_Window tkwin, Tk_3DBorder border, int highlightWidth, int borderWidth, int relief); /* 152 */
+ void (*tkCreateThreadExitHandler) (Tcl_ExitProc *proc, ClientData clientData); /* 153 */
+ void (*tkDeleteThreadExitHandler) (Tcl_ExitProc *proc, ClientData clientData); /* 154 */
+ void (*reserved155)(void);
+ int (*tkpTestembedCmd) (ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); /* 156 */
+ int (*tkpTesttextCmd) (ClientData dummy, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); /* 157 */
+ int (*tkSelGetSelection) (Tcl_Interp *interp, Tk_Window tkwin, Atom selection, Atom target, Tk_GetSelProc *proc, ClientData clientData); /* 158 */
+ int (*tkTextGetIndex) (Tcl_Interp *interp, struct TkText *textPtr, const char *string, struct TkTextIndex *indexPtr); /* 159 */
+ int (*tkTextIndexBackBytes) (const struct TkText *textPtr, const struct TkTextIndex *srcPtr, int count, struct TkTextIndex *dstPtr); /* 160 */
+ int (*tkTextIndexForwBytes) (const struct TkText *textPtr, const struct TkTextIndex *srcPtr, int count, struct TkTextIndex *dstPtr); /* 161 */
+ struct TkTextIndex * (*tkTextMakeByteIndex) (TkTextBTree tree, const struct TkText *textPtr, int lineIndex, int byteIndex, struct TkTextIndex *indexPtr); /* 162 */
+ int (*tkTextPrintIndex) (const struct TkText *textPtr, const struct TkTextIndex *indexPtr, char *string); /* 163 */
+ struct TkTextSegment * (*tkTextSetMark) (struct TkText *textPtr, const char *name, struct TkTextIndex *indexPtr); /* 164 */
+ int (*tkTextXviewCmd) (struct TkText *textPtr, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); /* 165 */
+ void (*tkTextChanged) (struct TkSharedText *sharedTextPtr, struct TkText *textPtr, const struct TkTextIndex *index1Ptr, const struct TkTextIndex *index2Ptr); /* 166 */
+ int (*tkBTreeNumLines) (TkTextBTree tree, const struct TkText *textPtr); /* 167 */
+ void (*tkTextInsertDisplayProc) (struct TkText *textPtr, struct TkTextDispChunk *chunkPtr, int x, int y, int height, int baseline, Display *display, Drawable dst, int screenY); /* 168 */
+ int (*tkStateParseProc) (ClientData clientData, Tcl_Interp *interp, Tk_Window tkwin, const char *value, char *widgRec, int offset); /* 169 */
+ CONST86 char * (*tkStatePrintProc) (ClientData clientData, Tk_Window tkwin, char *widgRec, int offset, Tcl_FreeProc **freeProcPtr); /* 170 */
+ int (*tkCanvasDashParseProc) (ClientData clientData, Tcl_Interp *interp, Tk_Window tkwin, const char *value, char *widgRec, int offset); /* 171 */
+ CONST86 char * (*tkCanvasDashPrintProc) (ClientData clientData, Tk_Window tkwin, char *widgRec, int offset, Tcl_FreeProc **freeProcPtr); /* 172 */
+ int (*tkOffsetParseProc) (ClientData clientData, Tcl_Interp *interp, Tk_Window tkwin, const char *value, char *widgRec, int offset); /* 173 */
+ CONST86 char * (*tkOffsetPrintProc) (ClientData clientData, Tk_Window tkwin, char *widgRec, int offset, Tcl_FreeProc **freeProcPtr); /* 174 */
+ int (*tkPixelParseProc) (ClientData clientData, Tcl_Interp *interp, Tk_Window tkwin, const char *value, char *widgRec, int offset); /* 175 */
+ CONST86 char * (*tkPixelPrintProc) (ClientData clientData, Tk_Window tkwin, char *widgRec, int offset, Tcl_FreeProc **freeProcPtr); /* 176 */
+ int (*tkOrientParseProc) (ClientData clientData, Tcl_Interp *interp, Tk_Window tkwin, const char *value, char *widgRec, int offset); /* 177 */
+ CONST86 char * (*tkOrientPrintProc) (ClientData clientData, Tk_Window tkwin, char *widgRec, int offset, Tcl_FreeProc **freeProcPtr); /* 178 */
+ int (*tkSmoothParseProc) (ClientData clientData, Tcl_Interp *interp, Tk_Window tkwin, const char *value, char *widgRec, int offset); /* 179 */
+ CONST86 char * (*tkSmoothPrintProc) (ClientData clientData, Tk_Window tkwin, char *widgRec, int offset, Tcl_FreeProc **freeProcPtr); /* 180 */
+ void (*tkDrawAngledTextLayout) (Display *display, Drawable drawable, GC gc, Tk_TextLayout layout, int x, int y, double angle, int firstChar, int lastChar); /* 181 */
+ void (*tkUnderlineAngledTextLayout) (Display *display, Drawable drawable, GC gc, Tk_TextLayout layout, int x, int y, double angle, int underline); /* 182 */
+ int (*tkIntersectAngledTextLayout) (Tk_TextLayout layout, int x, int y, int width, int height, double angle); /* 183 */
+ void (*tkDrawAngledChars) (Display *display, Drawable drawable, GC gc, Tk_Font tkfont, const char *source, int numBytes, double x, double y, double angle); /* 184 */
+} TkIntStubs;
+
+extern const TkIntStubs *tkIntStubsPtr;
+
+#ifdef __cplusplus
+}
+#endif
+
+#if defined(USE_TK_STUBS)
+
+/*
+ * Inline function declarations:
+ */
+
+#define TkAllocWindow \
+ (tkIntStubsPtr->tkAllocWindow) /* 0 */
+#define TkBezierPoints \
+ (tkIntStubsPtr->tkBezierPoints) /* 1 */
+#define TkBezierScreenPoints \
+ (tkIntStubsPtr->tkBezierScreenPoints) /* 2 */
+/* Slot 3 is reserved */
+#define TkBindEventProc \
+ (tkIntStubsPtr->tkBindEventProc) /* 4 */
+#define TkBindFree \
+ (tkIntStubsPtr->tkBindFree) /* 5 */
+#define TkBindInit \
+ (tkIntStubsPtr->tkBindInit) /* 6 */
+#define TkChangeEventWindow \
+ (tkIntStubsPtr->tkChangeEventWindow) /* 7 */
+#define TkClipInit \
+ (tkIntStubsPtr->tkClipInit) /* 8 */
+#define TkComputeAnchor \
+ (tkIntStubsPtr->tkComputeAnchor) /* 9 */
+/* Slot 10 is reserved */
+/* Slot 11 is reserved */
+#define TkCreateCursorFromData \
+ (tkIntStubsPtr->tkCreateCursorFromData) /* 12 */
+#define TkCreateFrame \
+ (tkIntStubsPtr->tkCreateFrame) /* 13 */
+#define TkCreateMainWindow \
+ (tkIntStubsPtr->tkCreateMainWindow) /* 14 */
+#define TkCurrentTime \
+ (tkIntStubsPtr->tkCurrentTime) /* 15 */
+#define TkDeleteAllImages \
+ (tkIntStubsPtr->tkDeleteAllImages) /* 16 */
+#define TkDoConfigureNotify \
+ (tkIntStubsPtr->tkDoConfigureNotify) /* 17 */
+#define TkDrawInsetFocusHighlight \
+ (tkIntStubsPtr->tkDrawInsetFocusHighlight) /* 18 */
+#define TkEventDeadWindow \
+ (tkIntStubsPtr->tkEventDeadWindow) /* 19 */
+#define TkFillPolygon \
+ (tkIntStubsPtr->tkFillPolygon) /* 20 */
+#define TkFindStateNum \
+ (tkIntStubsPtr->tkFindStateNum) /* 21 */
+#define TkFindStateString \
+ (tkIntStubsPtr->tkFindStateString) /* 22 */
+#define TkFocusDeadWindow \
+ (tkIntStubsPtr->tkFocusDeadWindow) /* 23 */
+#define TkFocusFilterEvent \
+ (tkIntStubsPtr->tkFocusFilterEvent) /* 24 */
+#define TkFocusKeyEvent \
+ (tkIntStubsPtr->tkFocusKeyEvent) /* 25 */
+#define TkFontPkgInit \
+ (tkIntStubsPtr->tkFontPkgInit) /* 26 */
+#define TkFontPkgFree \
+ (tkIntStubsPtr->tkFontPkgFree) /* 27 */
+#define TkFreeBindingTags \
+ (tkIntStubsPtr->tkFreeBindingTags) /* 28 */
+#define TkpFreeCursor \
+ (tkIntStubsPtr->tkpFreeCursor) /* 29 */
+#define TkGetBitmapData \
+ (tkIntStubsPtr->tkGetBitmapData) /* 30 */
+#define TkGetButtPoints \
+ (tkIntStubsPtr->tkGetButtPoints) /* 31 */
+#define TkGetCursorByName \
+ (tkIntStubsPtr->tkGetCursorByName) /* 32 */
+#define TkGetDefaultScreenName \
+ (tkIntStubsPtr->tkGetDefaultScreenName) /* 33 */
+#define TkGetDisplay \
+ (tkIntStubsPtr->tkGetDisplay) /* 34 */
+#define TkGetDisplayOf \
+ (tkIntStubsPtr->tkGetDisplayOf) /* 35 */
+#define TkGetFocusWin \
+ (tkIntStubsPtr->tkGetFocusWin) /* 36 */
+#define TkGetInterpNames \
+ (tkIntStubsPtr->tkGetInterpNames) /* 37 */
+#define TkGetMiterPoints \
+ (tkIntStubsPtr->tkGetMiterPoints) /* 38 */
+#define TkGetPointerCoords \
+ (tkIntStubsPtr->tkGetPointerCoords) /* 39 */
+#define TkGetServerInfo \
+ (tkIntStubsPtr->tkGetServerInfo) /* 40 */
+#define TkGrabDeadWindow \
+ (tkIntStubsPtr->tkGrabDeadWindow) /* 41 */
+#define TkGrabState \
+ (tkIntStubsPtr->tkGrabState) /* 42 */
+#define TkIncludePoint \
+ (tkIntStubsPtr->tkIncludePoint) /* 43 */
+#define TkInOutEvents \
+ (tkIntStubsPtr->tkInOutEvents) /* 44 */
+#define TkInstallFrameMenu \
+ (tkIntStubsPtr->tkInstallFrameMenu) /* 45 */
+#define TkKeysymToString \
+ (tkIntStubsPtr->tkKeysymToString) /* 46 */
+#define TkLineToArea \
+ (tkIntStubsPtr->tkLineToArea) /* 47 */
+#define TkLineToPoint \
+ (tkIntStubsPtr->tkLineToPoint) /* 48 */
+#define TkMakeBezierCurve \
+ (tkIntStubsPtr->tkMakeBezierCurve) /* 49 */
+#define TkMakeBezierPostscript \
+ (tkIntStubsPtr->tkMakeBezierPostscript) /* 50 */
+#define TkOptionClassChanged \
+ (tkIntStubsPtr->tkOptionClassChanged) /* 51 */
+#define TkOptionDeadWindow \
+ (tkIntStubsPtr->tkOptionDeadWindow) /* 52 */
+#define TkOvalToArea \
+ (tkIntStubsPtr->tkOvalToArea) /* 53 */
+#define TkOvalToPoint \
+ (tkIntStubsPtr->tkOvalToPoint) /* 54 */
+#define TkpChangeFocus \
+ (tkIntStubsPtr->tkpChangeFocus) /* 55 */
+#define TkpCloseDisplay \
+ (tkIntStubsPtr->tkpCloseDisplay) /* 56 */
+#define TkpClaimFocus \
+ (tkIntStubsPtr->tkpClaimFocus) /* 57 */
+#define TkpDisplayWarning \
+ (tkIntStubsPtr->tkpDisplayWarning) /* 58 */
+#define TkpGetAppName \
+ (tkIntStubsPtr->tkpGetAppName) /* 59 */
+#define TkpGetOtherWindow \
+ (tkIntStubsPtr->tkpGetOtherWindow) /* 60 */
+#define TkpGetWrapperWindow \
+ (tkIntStubsPtr->tkpGetWrapperWindow) /* 61 */
+#define TkpInit \
+ (tkIntStubsPtr->tkpInit) /* 62 */
+#define TkpInitializeMenuBindings \
+ (tkIntStubsPtr->tkpInitializeMenuBindings) /* 63 */
+#define TkpMakeContainer \
+ (tkIntStubsPtr->tkpMakeContainer) /* 64 */
+#define TkpMakeMenuWindow \
+ (tkIntStubsPtr->tkpMakeMenuWindow) /* 65 */
+#define TkpMakeWindow \
+ (tkIntStubsPtr->tkpMakeWindow) /* 66 */
+#define TkpMenuNotifyToplevelCreate \
+ (tkIntStubsPtr->tkpMenuNotifyToplevelCreate) /* 67 */
+#define TkpOpenDisplay \
+ (tkIntStubsPtr->tkpOpenDisplay) /* 68 */
+#define TkPointerEvent \
+ (tkIntStubsPtr->tkPointerEvent) /* 69 */
+#define TkPolygonToArea \
+ (tkIntStubsPtr->tkPolygonToArea) /* 70 */
+#define TkPolygonToPoint \
+ (tkIntStubsPtr->tkPolygonToPoint) /* 71 */
+#define TkPositionInTree \
+ (tkIntStubsPtr->tkPositionInTree) /* 72 */
+#define TkpRedirectKeyEvent \
+ (tkIntStubsPtr->tkpRedirectKeyEvent) /* 73 */
+#define TkpSetMainMenubar \
+ (tkIntStubsPtr->tkpSetMainMenubar) /* 74 */
+#define TkpUseWindow \
+ (tkIntStubsPtr->tkpUseWindow) /* 75 */
+/* Slot 76 is reserved */
+#define TkQueueEventForAllChildren \
+ (tkIntStubsPtr->tkQueueEventForAllChildren) /* 77 */
+#define TkReadBitmapFile \
+ (tkIntStubsPtr->tkReadBitmapFile) /* 78 */
+#define TkScrollWindow \
+ (tkIntStubsPtr->tkScrollWindow) /* 79 */
+#define TkSelDeadWindow \
+ (tkIntStubsPtr->tkSelDeadWindow) /* 80 */
+#define TkSelEventProc \
+ (tkIntStubsPtr->tkSelEventProc) /* 81 */
+#define TkSelInit \
+ (tkIntStubsPtr->tkSelInit) /* 82 */
+#define TkSelPropProc \
+ (tkIntStubsPtr->tkSelPropProc) /* 83 */
+/* Slot 84 is reserved */
+#define TkSetWindowMenuBar \
+ (tkIntStubsPtr->tkSetWindowMenuBar) /* 85 */
+#define TkStringToKeysym \
+ (tkIntStubsPtr->tkStringToKeysym) /* 86 */
+#define TkThickPolyLineToArea \
+ (tkIntStubsPtr->tkThickPolyLineToArea) /* 87 */
+#define TkWmAddToColormapWindows \
+ (tkIntStubsPtr->tkWmAddToColormapWindows) /* 88 */
+#define TkWmDeadWindow \
+ (tkIntStubsPtr->tkWmDeadWindow) /* 89 */
+#define TkWmFocusToplevel \
+ (tkIntStubsPtr->tkWmFocusToplevel) /* 90 */
+#define TkWmMapWindow \
+ (tkIntStubsPtr->tkWmMapWindow) /* 91 */
+#define TkWmNewWindow \
+ (tkIntStubsPtr->tkWmNewWindow) /* 92 */
+#define TkWmProtocolEventProc \
+ (tkIntStubsPtr->tkWmProtocolEventProc) /* 93 */
+#define TkWmRemoveFromColormapWindows \
+ (tkIntStubsPtr->tkWmRemoveFromColormapWindows) /* 94 */
+#define TkWmRestackToplevel \
+ (tkIntStubsPtr->tkWmRestackToplevel) /* 95 */
+#define TkWmSetClass \
+ (tkIntStubsPtr->tkWmSetClass) /* 96 */
+#define TkWmUnmapWindow \
+ (tkIntStubsPtr->tkWmUnmapWindow) /* 97 */
+#define TkDebugBitmap \
+ (tkIntStubsPtr->tkDebugBitmap) /* 98 */
+#define TkDebugBorder \
+ (tkIntStubsPtr->tkDebugBorder) /* 99 */
+#define TkDebugCursor \
+ (tkIntStubsPtr->tkDebugCursor) /* 100 */
+#define TkDebugColor \
+ (tkIntStubsPtr->tkDebugColor) /* 101 */
+#define TkDebugConfig \
+ (tkIntStubsPtr->tkDebugConfig) /* 102 */
+#define TkDebugFont \
+ (tkIntStubsPtr->tkDebugFont) /* 103 */
+#define TkFindStateNumObj \
+ (tkIntStubsPtr->tkFindStateNumObj) /* 104 */
+#define TkGetBitmapPredefTable \
+ (tkIntStubsPtr->tkGetBitmapPredefTable) /* 105 */
+#define TkGetDisplayList \
+ (tkIntStubsPtr->tkGetDisplayList) /* 106 */
+#define TkGetMainInfoList \
+ (tkIntStubsPtr->tkGetMainInfoList) /* 107 */
+#define TkGetWindowFromObj \
+ (tkIntStubsPtr->tkGetWindowFromObj) /* 108 */
+#define TkpGetString \
+ (tkIntStubsPtr->tkpGetString) /* 109 */
+#define TkpGetSubFonts \
+ (tkIntStubsPtr->tkpGetSubFonts) /* 110 */
+#define TkpGetSystemDefault \
+ (tkIntStubsPtr->tkpGetSystemDefault) /* 111 */
+#define TkpMenuThreadInit \
+ (tkIntStubsPtr->tkpMenuThreadInit) /* 112 */
+#define TkClipBox \
+ (tkIntStubsPtr->tkClipBox) /* 113 */
+#define TkCreateRegion \
+ (tkIntStubsPtr->tkCreateRegion) /* 114 */
+#define TkDestroyRegion \
+ (tkIntStubsPtr->tkDestroyRegion) /* 115 */
+#define TkIntersectRegion \
+ (tkIntStubsPtr->tkIntersectRegion) /* 116 */
+#define TkRectInRegion \
+ (tkIntStubsPtr->tkRectInRegion) /* 117 */
+#define TkSetRegion \
+ (tkIntStubsPtr->tkSetRegion) /* 118 */
+#define TkUnionRectWithRegion \
+ (tkIntStubsPtr->tkUnionRectWithRegion) /* 119 */
+/* Slot 120 is reserved */
+#ifdef MAC_OSX_TK /* AQUA */
+#define TkpCreateNativeBitmap \
+ (tkIntStubsPtr->tkpCreateNativeBitmap) /* 121 */
+#endif /* AQUA */
+#ifdef MAC_OSX_TK /* AQUA */
+#define TkpDefineNativeBitmaps \
+ (tkIntStubsPtr->tkpDefineNativeBitmaps) /* 122 */
+#endif /* AQUA */
+/* Slot 123 is reserved */
+#ifdef MAC_OSX_TK /* AQUA */
+#define TkpGetNativeAppBitmap \
+ (tkIntStubsPtr->tkpGetNativeAppBitmap) /* 124 */
+#endif /* AQUA */
+/* Slot 125 is reserved */
+/* Slot 126 is reserved */
+/* Slot 127 is reserved */
+/* Slot 128 is reserved */
+/* Slot 129 is reserved */
+/* Slot 130 is reserved */
+/* Slot 131 is reserved */
+/* Slot 132 is reserved */
+/* Slot 133 is reserved */
+/* Slot 134 is reserved */
+#define TkpDrawHighlightBorder \
+ (tkIntStubsPtr->tkpDrawHighlightBorder) /* 135 */
+#define TkSetFocusWin \
+ (tkIntStubsPtr->tkSetFocusWin) /* 136 */
+#define TkpSetKeycodeAndState \
+ (tkIntStubsPtr->tkpSetKeycodeAndState) /* 137 */
+#define TkpGetKeySym \
+ (tkIntStubsPtr->tkpGetKeySym) /* 138 */
+#define TkpInitKeymapInfo \
+ (tkIntStubsPtr->tkpInitKeymapInfo) /* 139 */
+#define TkPhotoGetValidRegion \
+ (tkIntStubsPtr->tkPhotoGetValidRegion) /* 140 */
+#define TkWmStackorderToplevel \
+ (tkIntStubsPtr->tkWmStackorderToplevel) /* 141 */
+#define TkFocusFree \
+ (tkIntStubsPtr->tkFocusFree) /* 142 */
+#define TkClipCleanup \
+ (tkIntStubsPtr->tkClipCleanup) /* 143 */
+#define TkGCCleanup \
+ (tkIntStubsPtr->tkGCCleanup) /* 144 */
+#define TkSubtractRegion \
+ (tkIntStubsPtr->tkSubtractRegion) /* 145 */
+#define TkStylePkgInit \
+ (tkIntStubsPtr->tkStylePkgInit) /* 146 */
+#define TkStylePkgFree \
+ (tkIntStubsPtr->tkStylePkgFree) /* 147 */
+#define TkToplevelWindowForCommand \
+ (tkIntStubsPtr->tkToplevelWindowForCommand) /* 148 */
+#define TkGetOptionSpec \
+ (tkIntStubsPtr->tkGetOptionSpec) /* 149 */
+#define TkMakeRawCurve \
+ (tkIntStubsPtr->tkMakeRawCurve) /* 150 */
+#define TkMakeRawCurvePostscript \
+ (tkIntStubsPtr->tkMakeRawCurvePostscript) /* 151 */
+#define TkpDrawFrame \
+ (tkIntStubsPtr->tkpDrawFrame) /* 152 */
+#define TkCreateThreadExitHandler \
+ (tkIntStubsPtr->tkCreateThreadExitHandler) /* 153 */
+#define TkDeleteThreadExitHandler \
+ (tkIntStubsPtr->tkDeleteThreadExitHandler) /* 154 */
+/* Slot 155 is reserved */
+#define TkpTestembedCmd \
+ (tkIntStubsPtr->tkpTestembedCmd) /* 156 */
+#define TkpTesttextCmd \
+ (tkIntStubsPtr->tkpTesttextCmd) /* 157 */
+#define TkSelGetSelection \
+ (tkIntStubsPtr->tkSelGetSelection) /* 158 */
+#define TkTextGetIndex \
+ (tkIntStubsPtr->tkTextGetIndex) /* 159 */
+#define TkTextIndexBackBytes \
+ (tkIntStubsPtr->tkTextIndexBackBytes) /* 160 */
+#define TkTextIndexForwBytes \
+ (tkIntStubsPtr->tkTextIndexForwBytes) /* 161 */
+#define TkTextMakeByteIndex \
+ (tkIntStubsPtr->tkTextMakeByteIndex) /* 162 */
+#define TkTextPrintIndex \
+ (tkIntStubsPtr->tkTextPrintIndex) /* 163 */
+#define TkTextSetMark \
+ (tkIntStubsPtr->tkTextSetMark) /* 164 */
+#define TkTextXviewCmd \
+ (tkIntStubsPtr->tkTextXviewCmd) /* 165 */
+#define TkTextChanged \
+ (tkIntStubsPtr->tkTextChanged) /* 166 */
+#define TkBTreeNumLines \
+ (tkIntStubsPtr->tkBTreeNumLines) /* 167 */
+#define TkTextInsertDisplayProc \
+ (tkIntStubsPtr->tkTextInsertDisplayProc) /* 168 */
+#define TkStateParseProc \
+ (tkIntStubsPtr->tkStateParseProc) /* 169 */
+#define TkStatePrintProc \
+ (tkIntStubsPtr->tkStatePrintProc) /* 170 */
+#define TkCanvasDashParseProc \
+ (tkIntStubsPtr->tkCanvasDashParseProc) /* 171 */
+#define TkCanvasDashPrintProc \
+ (tkIntStubsPtr->tkCanvasDashPrintProc) /* 172 */
+#define TkOffsetParseProc \
+ (tkIntStubsPtr->tkOffsetParseProc) /* 173 */
+#define TkOffsetPrintProc \
+ (tkIntStubsPtr->tkOffsetPrintProc) /* 174 */
+#define TkPixelParseProc \
+ (tkIntStubsPtr->tkPixelParseProc) /* 175 */
+#define TkPixelPrintProc \
+ (tkIntStubsPtr->tkPixelPrintProc) /* 176 */
+#define TkOrientParseProc \
+ (tkIntStubsPtr->tkOrientParseProc) /* 177 */
+#define TkOrientPrintProc \
+ (tkIntStubsPtr->tkOrientPrintProc) /* 178 */
+#define TkSmoothParseProc \
+ (tkIntStubsPtr->tkSmoothParseProc) /* 179 */
+#define TkSmoothPrintProc \
+ (tkIntStubsPtr->tkSmoothPrintProc) /* 180 */
+#define TkDrawAngledTextLayout \
+ (tkIntStubsPtr->tkDrawAngledTextLayout) /* 181 */
+#define TkUnderlineAngledTextLayout \
+ (tkIntStubsPtr->tkUnderlineAngledTextLayout) /* 182 */
+#define TkIntersectAngledTextLayout \
+ (tkIntStubsPtr->tkIntersectAngledTextLayout) /* 183 */
+#define TkDrawAngledChars \
+ (tkIntStubsPtr->tkDrawAngledChars) /* 184 */
+
+#endif /* defined(USE_TK_STUBS) */
+
+/* !END!: Do not edit above this line. */
+
+#undef TCL_STORAGE_CLASS
+#define TCL_STORAGE_CLASS DLLIMPORT
+
+/*
+ * On X11, these macros are just wrappers for the equivalent X Region calls.
+ */
+#if !(defined(_WIN32) || defined(__CYGWIN__) || defined(MAC_OSX_TK)) /* X11 */
+
+#undef TkClipBox
+#undef TkCreateRegion
+#undef TkDestroyRegion
+#undef TkIntersectRegion
+#undef TkRectInRegion
+#undef TkSetRegion
+#undef TkSubtractRegion
+#undef TkUnionRectWithRegion
+
+#define TkClipBox(rgn, rect) XClipBox((Region) rgn, rect)
+#define TkCreateRegion() (TkRegion) XCreateRegion()
+#define TkDestroyRegion(rgn) XDestroyRegion((Region) rgn)
+#define TkIntersectRegion(a, b, r) XIntersectRegion((Region) a, \
+ (Region) b, (Region) r)
+#define TkRectInRegion(r, x, y, w, h) XRectInRegion((Region) r, x, y, w, h)
+#define TkSetRegion(d, gc, rgn) XSetRegion(d, gc, (Region) rgn)
+#define TkSubtractRegion(a, b, r) XSubtractRegion((Region) a, \
+ (Region) b, (Region) r)
+#define TkUnionRectWithRegion(rect, src, ret) XUnionRectWithRegion(rect, \
+ (Region) src, (Region) ret)
+
+#endif /* UNIX */
+
+#endif /* _TKINTDECLS */
+
diff --git a/tk8.6/generic/tkIntPlatDecls.h b/tk8.6/generic/tkIntPlatDecls.h
new file mode 100644
index 0000000..e48e803
--- /dev/null
+++ b/tk8.6/generic/tkIntPlatDecls.h
@@ -0,0 +1,669 @@
+/*
+ * 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.
+ */
+
+#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. */
+
+#ifdef __cplusplus
+extern "C" {
+#endif
+
+/*
+ * Exported function declarations:
+ */
+
+#if defined(_WIN32) || defined(__CYGWIN__) /* WIN */
+/* 0 */
+EXTERN char * TkAlignImageData(XImage *image, int alignment,
+ int bitOrder);
+/* Slot 1 is reserved */
+/* 2 */
+EXTERN void TkGenerateActivateEvents(TkWindow *winPtr,
+ int active);
+/* 3 */
+EXTERN unsigned long TkpGetMS(void);
+/* 4 */
+EXTERN void TkPointerDeadWindow(TkWindow *winPtr);
+/* 5 */
+EXTERN void TkpPrintWindowId(char *buf, Window window);
+/* 6 */
+EXTERN int TkpScanWindowId(Tcl_Interp *interp,
+ const char *string, Window *idPtr);
+/* 7 */
+EXTERN void TkpSetCapture(TkWindow *winPtr);
+/* 8 */
+EXTERN void TkpSetCursor(TkpCursor cursor);
+/* 9 */
+EXTERN int TkpWmSetState(TkWindow *winPtr, int state);
+/* 10 */
+EXTERN void TkSetPixmapColormap(Pixmap pixmap, Colormap colormap);
+/* 11 */
+EXTERN void TkWinCancelMouseTimer(void);
+/* 12 */
+EXTERN void TkWinClipboardRender(TkDisplay *dispPtr, UINT format);
+/* 13 */
+EXTERN LRESULT TkWinEmbeddedEventProc(HWND hwnd, UINT message,
+ WPARAM wParam, LPARAM lParam);
+/* 14 */
+EXTERN void TkWinFillRect(HDC dc, int x, int y, int width,
+ int height, int pixel);
+/* 15 */
+EXTERN COLORREF TkWinGetBorderPixels(Tk_Window tkwin,
+ Tk_3DBorder border, int which);
+/* 16 */
+EXTERN HDC TkWinGetDrawableDC(Display *display, Drawable d,
+ TkWinDCState *state);
+/* 17 */
+EXTERN int TkWinGetModifierState(void);
+/* 18 */
+EXTERN HPALETTE TkWinGetSystemPalette(void);
+/* 19 */
+EXTERN HWND TkWinGetWrapperWindow(Tk_Window tkwin);
+/* 20 */
+EXTERN int TkWinHandleMenuEvent(HWND *phwnd, UINT *pMessage,
+ WPARAM *pwParam, LPARAM *plParam,
+ LRESULT *plResult);
+/* 21 */
+EXTERN int TkWinIndexOfColor(XColor *colorPtr);
+/* 22 */
+EXTERN void TkWinReleaseDrawableDC(Drawable d, HDC hdc,
+ TkWinDCState *state);
+/* 23 */
+EXTERN LRESULT TkWinResendEvent(WNDPROC wndproc, HWND hwnd,
+ XEvent *eventPtr);
+/* 24 */
+EXTERN HPALETTE TkWinSelectPalette(HDC dc, Colormap colormap);
+/* 25 */
+EXTERN void TkWinSetMenu(Tk_Window tkwin, HMENU hMenu);
+/* 26 */
+EXTERN void TkWinSetWindowPos(HWND hwnd, HWND siblingHwnd,
+ int pos);
+/* 27 */
+EXTERN void TkWinWmCleanup(HINSTANCE hInstance);
+/* 28 */
+EXTERN void TkWinXCleanup(ClientData clientData);
+/* 29 */
+EXTERN void TkWinXInit(HINSTANCE hInstance);
+/* 30 */
+EXTERN void TkWinSetForegroundWindow(TkWindow *winPtr);
+/* 31 */
+EXTERN void TkWinDialogDebug(int debug);
+/* 32 */
+EXTERN Tcl_Obj * TkWinGetMenuSystemDefault(Tk_Window tkwin,
+ const char *dbName, const char *className);
+/* 33 */
+EXTERN int TkWinGetPlatformId(void);
+/* 34 */
+EXTERN void TkWinSetHINSTANCE(HINSTANCE hInstance);
+/* 35 */
+EXTERN int TkWinGetPlatformTheme(void);
+/* 36 */
+EXTERN LRESULT __stdcall TkWinChildProc(HWND hwnd, UINT message,
+ WPARAM wParam, LPARAM lParam);
+/* 37 */
+EXTERN void TkCreateXEventSource(void);
+/* 38 */
+EXTERN int TkpCmapStressed(Tk_Window tkwin, Colormap colormap);
+/* 39 */
+EXTERN void TkpSync(Display *display);
+/* 40 */
+EXTERN Window TkUnixContainerId(TkWindow *winPtr);
+/* 41 */
+EXTERN int TkUnixDoOneXEvent(Tcl_Time *timePtr);
+/* 42 */
+EXTERN void TkUnixSetMenubar(Tk_Window tkwin, Tk_Window menubar);
+/* 43 */
+EXTERN void TkWmCleanup(TkDisplay *dispPtr);
+/* 44 */
+EXTERN void TkSendCleanup(TkDisplay *dispPtr);
+/* 45 */
+EXTERN int TkpTestsendCmd(ClientData clientData,
+ Tcl_Interp *interp, int objc,
+ Tcl_Obj *const objv[]);
+#endif /* WIN */
+#ifdef MAC_OSX_TK /* AQUA */
+/* 0 */
+EXTERN void TkGenerateActivateEvents(TkWindow *winPtr,
+ int active);
+/* Slot 1 is reserved */
+/* Slot 2 is reserved */
+/* 3 */
+EXTERN void TkPointerDeadWindow(TkWindow *winPtr);
+/* 4 */
+EXTERN void TkpSetCapture(TkWindow *winPtr);
+/* 5 */
+EXTERN void TkpSetCursor(TkpCursor cursor);
+/* 6 */
+EXTERN void TkpWmSetState(TkWindow *winPtr, int state);
+/* 7 */
+EXTERN void TkAboutDlg(void);
+/* 8 */
+EXTERN unsigned int TkMacOSXButtonKeyState(void);
+/* 9 */
+EXTERN void TkMacOSXClearMenubarActive(void);
+/* 10 */
+EXTERN int TkMacOSXDispatchMenuEvent(int menuID, int index);
+/* 11 */
+EXTERN void TkMacOSXInstallCursor(int resizeOverride);
+/* 12 */
+EXTERN void TkMacOSXHandleTearoffMenu(void);
+/* Slot 13 is reserved */
+/* 14 */
+EXTERN int TkMacOSXDoHLEvent(void *theEvent);
+/* Slot 15 is reserved */
+/* 16 */
+EXTERN Window TkMacOSXGetXWindow(void *macWinPtr);
+/* 17 */
+EXTERN int TkMacOSXGrowToplevel(void *whichWindow, XPoint start);
+/* 18 */
+EXTERN void TkMacOSXHandleMenuSelect(short theMenu,
+ unsigned short theItem, int optionKeyPressed);
+/* Slot 19 is reserved */
+/* Slot 20 is reserved */
+/* 21 */
+EXTERN void TkMacOSXInvalidateWindow(MacDrawable *macWin,
+ int flag);
+/* 22 */
+EXTERN int TkMacOSXIsCharacterMissing(Tk_Font tkfont,
+ unsigned int searchChar);
+/* 23 */
+EXTERN void TkMacOSXMakeRealWindowExist(TkWindow *winPtr);
+/* 24 */
+EXTERN void * TkMacOSXMakeStippleMap(Drawable d1, Drawable d2);
+/* 25 */
+EXTERN void TkMacOSXMenuClick(void);
+/* 26 */
+EXTERN void TkMacOSXRegisterOffScreenWindow(Window window,
+ void *portPtr);
+/* 27 */
+EXTERN int TkMacOSXResizable(TkWindow *winPtr);
+/* 28 */
+EXTERN void TkMacOSXSetHelpMenuItemCount(void);
+/* 29 */
+EXTERN void TkMacOSXSetScrollbarGrow(TkWindow *winPtr, int flag);
+/* 30 */
+EXTERN void TkMacOSXSetUpClippingRgn(Drawable drawable);
+/* 31 */
+EXTERN void TkMacOSXSetUpGraphicsPort(GC gc, void *destPort);
+/* 32 */
+EXTERN void TkMacOSXUpdateClipRgn(TkWindow *winPtr);
+/* 33 */
+EXTERN void TkMacOSXUnregisterMacWindow(void *portPtr);
+/* 34 */
+EXTERN int TkMacOSXUseMenuID(short macID);
+/* 35 */
+EXTERN TkRegion TkMacOSXVisableClipRgn(TkWindow *winPtr);
+/* 36 */
+EXTERN void TkMacOSXWinBounds(TkWindow *winPtr, void *geometry);
+/* 37 */
+EXTERN void TkMacOSXWindowOffset(void *wRef, int *xOffset,
+ int *yOffset);
+/* 38 */
+EXTERN int TkSetMacColor(unsigned long pixel, void *macColor);
+/* 39 */
+EXTERN void TkSetWMName(TkWindow *winPtr, Tk_Uid titleUid);
+/* 40 */
+EXTERN void TkSuspendClipboard(void);
+/* 41 */
+EXTERN int TkMacOSXZoomToplevel(void *whichWindow,
+ short zoomPart);
+/* 42 */
+EXTERN Tk_Window Tk_TopCoordsToWindow(Tk_Window tkwin, int rootX,
+ int rootY, int *newX, int *newY);
+/* 43 */
+EXTERN MacDrawable * TkMacOSXContainerId(TkWindow *winPtr);
+/* 44 */
+EXTERN MacDrawable * TkMacOSXGetHostToplevel(TkWindow *winPtr);
+/* 45 */
+EXTERN void TkMacOSXPreprocessMenu(void);
+/* 46 */
+EXTERN int TkpIsWindowFloating(void *window);
+/* 47 */
+EXTERN Tk_Window TkMacOSXGetCapture(void);
+/* Slot 48 is reserved */
+/* 49 */
+EXTERN Window TkGetTransientMaster(TkWindow *winPtr);
+/* 50 */
+EXTERN int TkGenerateButtonEvent(int x, int y, Window window,
+ unsigned int state);
+/* 51 */
+EXTERN void TkGenWMDestroyEvent(Tk_Window tkwin);
+/* 52 */
+EXTERN void TkMacOSXSetDrawingEnabled(TkWindow *winPtr, int flag);
+/* 53 */
+EXTERN unsigned long TkpGetMS(void);
+/* 54 */
+EXTERN void * TkMacOSXDrawable(Drawable drawable);
+/* 55 */
+EXTERN int TkpScanWindowId(Tcl_Interp *interp,
+ const char *string, Window *idPtr);
+#endif /* AQUA */
+#if !(defined(_WIN32) || defined(__CYGWIN__) || defined(MAC_OSX_TK)) /* X11 */
+/* 0 */
+EXTERN void TkCreateXEventSource(void);
+/* Slot 1 is reserved */
+/* Slot 2 is reserved */
+/* 3 */
+EXTERN int TkpCmapStressed(Tk_Window tkwin, Colormap colormap);
+/* 4 */
+EXTERN void TkpSync(Display *display);
+/* 5 */
+EXTERN Window TkUnixContainerId(TkWindow *winPtr);
+/* 6 */
+EXTERN int TkUnixDoOneXEvent(Tcl_Time *timePtr);
+/* 7 */
+EXTERN void TkUnixSetMenubar(Tk_Window tkwin, Tk_Window menubar);
+/* 8 */
+EXTERN int TkpScanWindowId(Tcl_Interp *interp,
+ const char *string, Window *idPtr);
+/* 9 */
+EXTERN void TkWmCleanup(TkDisplay *dispPtr);
+/* 10 */
+EXTERN void TkSendCleanup(TkDisplay *dispPtr);
+/* Slot 11 is reserved */
+/* 12 */
+EXTERN int TkpWmSetState(TkWindow *winPtr, int state);
+/* 13 */
+EXTERN int TkpTestsendCmd(ClientData clientData,
+ Tcl_Interp *interp, int objc,
+ Tcl_Obj *const objv[]);
+#endif /* X11 */
+
+typedef struct TkIntPlatStubs {
+ int magic;
+ void *hooks;
+
+#if defined(_WIN32) || defined(__CYGWIN__) /* WIN */
+ char * (*tkAlignImageData) (XImage *image, int alignment, int bitOrder); /* 0 */
+ void (*reserved1)(void);
+ void (*tkGenerateActivateEvents) (TkWindow *winPtr, int active); /* 2 */
+ unsigned long (*tkpGetMS) (void); /* 3 */
+ void (*tkPointerDeadWindow) (TkWindow *winPtr); /* 4 */
+ void (*tkpPrintWindowId) (char *buf, Window window); /* 5 */
+ int (*tkpScanWindowId) (Tcl_Interp *interp, const char *string, Window *idPtr); /* 6 */
+ void (*tkpSetCapture) (TkWindow *winPtr); /* 7 */
+ void (*tkpSetCursor) (TkpCursor cursor); /* 8 */
+ int (*tkpWmSetState) (TkWindow *winPtr, int state); /* 9 */
+ void (*tkSetPixmapColormap) (Pixmap pixmap, Colormap colormap); /* 10 */
+ void (*tkWinCancelMouseTimer) (void); /* 11 */
+ void (*tkWinClipboardRender) (TkDisplay *dispPtr, UINT format); /* 12 */
+ LRESULT (*tkWinEmbeddedEventProc) (HWND hwnd, UINT message, WPARAM wParam, LPARAM lParam); /* 13 */
+ void (*tkWinFillRect) (HDC dc, int x, int y, int width, int height, int pixel); /* 14 */
+ COLORREF (*tkWinGetBorderPixels) (Tk_Window tkwin, Tk_3DBorder border, int which); /* 15 */
+ HDC (*tkWinGetDrawableDC) (Display *display, Drawable d, TkWinDCState *state); /* 16 */
+ int (*tkWinGetModifierState) (void); /* 17 */
+ HPALETTE (*tkWinGetSystemPalette) (void); /* 18 */
+ HWND (*tkWinGetWrapperWindow) (Tk_Window tkwin); /* 19 */
+ int (*tkWinHandleMenuEvent) (HWND *phwnd, UINT *pMessage, WPARAM *pwParam, LPARAM *plParam, LRESULT *plResult); /* 20 */
+ int (*tkWinIndexOfColor) (XColor *colorPtr); /* 21 */
+ void (*tkWinReleaseDrawableDC) (Drawable d, HDC hdc, TkWinDCState *state); /* 22 */
+ LRESULT (*tkWinResendEvent) (WNDPROC wndproc, HWND hwnd, XEvent *eventPtr); /* 23 */
+ HPALETTE (*tkWinSelectPalette) (HDC dc, Colormap colormap); /* 24 */
+ void (*tkWinSetMenu) (Tk_Window tkwin, HMENU hMenu); /* 25 */
+ void (*tkWinSetWindowPos) (HWND hwnd, HWND siblingHwnd, int pos); /* 26 */
+ void (*tkWinWmCleanup) (HINSTANCE hInstance); /* 27 */
+ void (*tkWinXCleanup) (ClientData clientData); /* 28 */
+ void (*tkWinXInit) (HINSTANCE hInstance); /* 29 */
+ void (*tkWinSetForegroundWindow) (TkWindow *winPtr); /* 30 */
+ void (*tkWinDialogDebug) (int debug); /* 31 */
+ Tcl_Obj * (*tkWinGetMenuSystemDefault) (Tk_Window tkwin, const char *dbName, const char *className); /* 32 */
+ int (*tkWinGetPlatformId) (void); /* 33 */
+ void (*tkWinSetHINSTANCE) (HINSTANCE hInstance); /* 34 */
+ int (*tkWinGetPlatformTheme) (void); /* 35 */
+ LRESULT (__stdcall *tkWinChildProc) (HWND hwnd, UINT message, WPARAM wParam, LPARAM lParam); /* 36 */
+ void (*tkCreateXEventSource) (void); /* 37 */
+ int (*tkpCmapStressed) (Tk_Window tkwin, Colormap colormap); /* 38 */
+ void (*tkpSync) (Display *display); /* 39 */
+ Window (*tkUnixContainerId) (TkWindow *winPtr); /* 40 */
+ int (*tkUnixDoOneXEvent) (Tcl_Time *timePtr); /* 41 */
+ void (*tkUnixSetMenubar) (Tk_Window tkwin, Tk_Window menubar); /* 42 */
+ void (*tkWmCleanup) (TkDisplay *dispPtr); /* 43 */
+ void (*tkSendCleanup) (TkDisplay *dispPtr); /* 44 */
+ int (*tkpTestsendCmd) (ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); /* 45 */
+#endif /* WIN */
+#ifdef MAC_OSX_TK /* AQUA */
+ void (*tkGenerateActivateEvents) (TkWindow *winPtr, int active); /* 0 */
+ void (*reserved1)(void);
+ void (*reserved2)(void);
+ void (*tkPointerDeadWindow) (TkWindow *winPtr); /* 3 */
+ void (*tkpSetCapture) (TkWindow *winPtr); /* 4 */
+ void (*tkpSetCursor) (TkpCursor cursor); /* 5 */
+ void (*tkpWmSetState) (TkWindow *winPtr, int state); /* 6 */
+ void (*tkAboutDlg) (void); /* 7 */
+ unsigned int (*tkMacOSXButtonKeyState) (void); /* 8 */
+ void (*tkMacOSXClearMenubarActive) (void); /* 9 */
+ int (*tkMacOSXDispatchMenuEvent) (int menuID, int index); /* 10 */
+ void (*tkMacOSXInstallCursor) (int resizeOverride); /* 11 */
+ void (*tkMacOSXHandleTearoffMenu) (void); /* 12 */
+ void (*reserved13)(void);
+ int (*tkMacOSXDoHLEvent) (void *theEvent); /* 14 */
+ void (*reserved15)(void);
+ Window (*tkMacOSXGetXWindow) (void *macWinPtr); /* 16 */
+ int (*tkMacOSXGrowToplevel) (void *whichWindow, XPoint start); /* 17 */
+ void (*tkMacOSXHandleMenuSelect) (short theMenu, unsigned short theItem, int optionKeyPressed); /* 18 */
+ void (*reserved19)(void);
+ void (*reserved20)(void);
+ void (*tkMacOSXInvalidateWindow) (MacDrawable *macWin, int flag); /* 21 */
+ int (*tkMacOSXIsCharacterMissing) (Tk_Font tkfont, unsigned int searchChar); /* 22 */
+ void (*tkMacOSXMakeRealWindowExist) (TkWindow *winPtr); /* 23 */
+ void * (*tkMacOSXMakeStippleMap) (Drawable d1, Drawable d2); /* 24 */
+ void (*tkMacOSXMenuClick) (void); /* 25 */
+ void (*tkMacOSXRegisterOffScreenWindow) (Window window, void *portPtr); /* 26 */
+ int (*tkMacOSXResizable) (TkWindow *winPtr); /* 27 */
+ void (*tkMacOSXSetHelpMenuItemCount) (void); /* 28 */
+ void (*tkMacOSXSetScrollbarGrow) (TkWindow *winPtr, int flag); /* 29 */
+ void (*tkMacOSXSetUpClippingRgn) (Drawable drawable); /* 30 */
+ void (*tkMacOSXSetUpGraphicsPort) (GC gc, void *destPort); /* 31 */
+ void (*tkMacOSXUpdateClipRgn) (TkWindow *winPtr); /* 32 */
+ void (*tkMacOSXUnregisterMacWindow) (void *portPtr); /* 33 */
+ int (*tkMacOSXUseMenuID) (short macID); /* 34 */
+ TkRegion (*tkMacOSXVisableClipRgn) (TkWindow *winPtr); /* 35 */
+ void (*tkMacOSXWinBounds) (TkWindow *winPtr, void *geometry); /* 36 */
+ void (*tkMacOSXWindowOffset) (void *wRef, int *xOffset, int *yOffset); /* 37 */
+ int (*tkSetMacColor) (unsigned long pixel, void *macColor); /* 38 */
+ void (*tkSetWMName) (TkWindow *winPtr, Tk_Uid titleUid); /* 39 */
+ void (*tkSuspendClipboard) (void); /* 40 */
+ int (*tkMacOSXZoomToplevel) (void *whichWindow, short zoomPart); /* 41 */
+ Tk_Window (*tk_TopCoordsToWindow) (Tk_Window tkwin, int rootX, int rootY, int *newX, int *newY); /* 42 */
+ MacDrawable * (*tkMacOSXContainerId) (TkWindow *winPtr); /* 43 */
+ MacDrawable * (*tkMacOSXGetHostToplevel) (TkWindow *winPtr); /* 44 */
+ void (*tkMacOSXPreprocessMenu) (void); /* 45 */
+ int (*tkpIsWindowFloating) (void *window); /* 46 */
+ Tk_Window (*tkMacOSXGetCapture) (void); /* 47 */
+ void (*reserved48)(void);
+ Window (*tkGetTransientMaster) (TkWindow *winPtr); /* 49 */
+ int (*tkGenerateButtonEvent) (int x, int y, Window window, unsigned int state); /* 50 */
+ void (*tkGenWMDestroyEvent) (Tk_Window tkwin); /* 51 */
+ void (*tkMacOSXSetDrawingEnabled) (TkWindow *winPtr, int flag); /* 52 */
+ unsigned long (*tkpGetMS) (void); /* 53 */
+ void * (*tkMacOSXDrawable) (Drawable drawable); /* 54 */
+ int (*tkpScanWindowId) (Tcl_Interp *interp, const char *string, Window *idPtr); /* 55 */
+#endif /* AQUA */
+#if !(defined(_WIN32) || defined(__CYGWIN__) || defined(MAC_OSX_TK)) /* X11 */
+ void (*tkCreateXEventSource) (void); /* 0 */
+ void (*reserved1)(void);
+ void (*reserved2)(void);
+ int (*tkpCmapStressed) (Tk_Window tkwin, Colormap colormap); /* 3 */
+ void (*tkpSync) (Display *display); /* 4 */
+ Window (*tkUnixContainerId) (TkWindow *winPtr); /* 5 */
+ int (*tkUnixDoOneXEvent) (Tcl_Time *timePtr); /* 6 */
+ void (*tkUnixSetMenubar) (Tk_Window tkwin, Tk_Window menubar); /* 7 */
+ int (*tkpScanWindowId) (Tcl_Interp *interp, const char *string, Window *idPtr); /* 8 */
+ void (*tkWmCleanup) (TkDisplay *dispPtr); /* 9 */
+ void (*tkSendCleanup) (TkDisplay *dispPtr); /* 10 */
+ void (*reserved11)(void);
+ int (*tkpWmSetState) (TkWindow *winPtr, int state); /* 12 */
+ int (*tkpTestsendCmd) (ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); /* 13 */
+#endif /* X11 */
+} TkIntPlatStubs;
+
+extern const TkIntPlatStubs *tkIntPlatStubsPtr;
+
+#ifdef __cplusplus
+}
+#endif
+
+#if defined(USE_TK_STUBS)
+
+/*
+ * Inline function declarations:
+ */
+
+#if defined(_WIN32) || defined(__CYGWIN__) /* WIN */
+#define TkAlignImageData \
+ (tkIntPlatStubsPtr->tkAlignImageData) /* 0 */
+/* Slot 1 is reserved */
+#define TkGenerateActivateEvents \
+ (tkIntPlatStubsPtr->tkGenerateActivateEvents) /* 2 */
+#define TkpGetMS \
+ (tkIntPlatStubsPtr->tkpGetMS) /* 3 */
+#define TkPointerDeadWindow \
+ (tkIntPlatStubsPtr->tkPointerDeadWindow) /* 4 */
+#define TkpPrintWindowId \
+ (tkIntPlatStubsPtr->tkpPrintWindowId) /* 5 */
+#define TkpScanWindowId \
+ (tkIntPlatStubsPtr->tkpScanWindowId) /* 6 */
+#define TkpSetCapture \
+ (tkIntPlatStubsPtr->tkpSetCapture) /* 7 */
+#define TkpSetCursor \
+ (tkIntPlatStubsPtr->tkpSetCursor) /* 8 */
+#define TkpWmSetState \
+ (tkIntPlatStubsPtr->tkpWmSetState) /* 9 */
+#define TkSetPixmapColormap \
+ (tkIntPlatStubsPtr->tkSetPixmapColormap) /* 10 */
+#define TkWinCancelMouseTimer \
+ (tkIntPlatStubsPtr->tkWinCancelMouseTimer) /* 11 */
+#define TkWinClipboardRender \
+ (tkIntPlatStubsPtr->tkWinClipboardRender) /* 12 */
+#define TkWinEmbeddedEventProc \
+ (tkIntPlatStubsPtr->tkWinEmbeddedEventProc) /* 13 */
+#define TkWinFillRect \
+ (tkIntPlatStubsPtr->tkWinFillRect) /* 14 */
+#define TkWinGetBorderPixels \
+ (tkIntPlatStubsPtr->tkWinGetBorderPixels) /* 15 */
+#define TkWinGetDrawableDC \
+ (tkIntPlatStubsPtr->tkWinGetDrawableDC) /* 16 */
+#define TkWinGetModifierState \
+ (tkIntPlatStubsPtr->tkWinGetModifierState) /* 17 */
+#define TkWinGetSystemPalette \
+ (tkIntPlatStubsPtr->tkWinGetSystemPalette) /* 18 */
+#define TkWinGetWrapperWindow \
+ (tkIntPlatStubsPtr->tkWinGetWrapperWindow) /* 19 */
+#define TkWinHandleMenuEvent \
+ (tkIntPlatStubsPtr->tkWinHandleMenuEvent) /* 20 */
+#define TkWinIndexOfColor \
+ (tkIntPlatStubsPtr->tkWinIndexOfColor) /* 21 */
+#define TkWinReleaseDrawableDC \
+ (tkIntPlatStubsPtr->tkWinReleaseDrawableDC) /* 22 */
+#define TkWinResendEvent \
+ (tkIntPlatStubsPtr->tkWinResendEvent) /* 23 */
+#define TkWinSelectPalette \
+ (tkIntPlatStubsPtr->tkWinSelectPalette) /* 24 */
+#define TkWinSetMenu \
+ (tkIntPlatStubsPtr->tkWinSetMenu) /* 25 */
+#define TkWinSetWindowPos \
+ (tkIntPlatStubsPtr->tkWinSetWindowPos) /* 26 */
+#define TkWinWmCleanup \
+ (tkIntPlatStubsPtr->tkWinWmCleanup) /* 27 */
+#define TkWinXCleanup \
+ (tkIntPlatStubsPtr->tkWinXCleanup) /* 28 */
+#define TkWinXInit \
+ (tkIntPlatStubsPtr->tkWinXInit) /* 29 */
+#define TkWinSetForegroundWindow \
+ (tkIntPlatStubsPtr->tkWinSetForegroundWindow) /* 30 */
+#define TkWinDialogDebug \
+ (tkIntPlatStubsPtr->tkWinDialogDebug) /* 31 */
+#define TkWinGetMenuSystemDefault \
+ (tkIntPlatStubsPtr->tkWinGetMenuSystemDefault) /* 32 */
+#define TkWinGetPlatformId \
+ (tkIntPlatStubsPtr->tkWinGetPlatformId) /* 33 */
+#define TkWinSetHINSTANCE \
+ (tkIntPlatStubsPtr->tkWinSetHINSTANCE) /* 34 */
+#define TkWinGetPlatformTheme \
+ (tkIntPlatStubsPtr->tkWinGetPlatformTheme) /* 35 */
+#define TkWinChildProc \
+ (tkIntPlatStubsPtr->tkWinChildProc) /* 36 */
+#define TkCreateXEventSource \
+ (tkIntPlatStubsPtr->tkCreateXEventSource) /* 37 */
+#define TkpCmapStressed \
+ (tkIntPlatStubsPtr->tkpCmapStressed) /* 38 */
+#define TkpSync \
+ (tkIntPlatStubsPtr->tkpSync) /* 39 */
+#define TkUnixContainerId \
+ (tkIntPlatStubsPtr->tkUnixContainerId) /* 40 */
+#define TkUnixDoOneXEvent \
+ (tkIntPlatStubsPtr->tkUnixDoOneXEvent) /* 41 */
+#define TkUnixSetMenubar \
+ (tkIntPlatStubsPtr->tkUnixSetMenubar) /* 42 */
+#define TkWmCleanup \
+ (tkIntPlatStubsPtr->tkWmCleanup) /* 43 */
+#define TkSendCleanup \
+ (tkIntPlatStubsPtr->tkSendCleanup) /* 44 */
+#define TkpTestsendCmd \
+ (tkIntPlatStubsPtr->tkpTestsendCmd) /* 45 */
+#endif /* WIN */
+#ifdef MAC_OSX_TK /* AQUA */
+#define TkGenerateActivateEvents \
+ (tkIntPlatStubsPtr->tkGenerateActivateEvents) /* 0 */
+/* Slot 1 is reserved */
+/* Slot 2 is reserved */
+#define TkPointerDeadWindow \
+ (tkIntPlatStubsPtr->tkPointerDeadWindow) /* 3 */
+#define TkpSetCapture \
+ (tkIntPlatStubsPtr->tkpSetCapture) /* 4 */
+#define TkpSetCursor \
+ (tkIntPlatStubsPtr->tkpSetCursor) /* 5 */
+#define TkpWmSetState \
+ (tkIntPlatStubsPtr->tkpWmSetState) /* 6 */
+#define TkAboutDlg \
+ (tkIntPlatStubsPtr->tkAboutDlg) /* 7 */
+#define TkMacOSXButtonKeyState \
+ (tkIntPlatStubsPtr->tkMacOSXButtonKeyState) /* 8 */
+#define TkMacOSXClearMenubarActive \
+ (tkIntPlatStubsPtr->tkMacOSXClearMenubarActive) /* 9 */
+#define TkMacOSXDispatchMenuEvent \
+ (tkIntPlatStubsPtr->tkMacOSXDispatchMenuEvent) /* 10 */
+#define TkMacOSXInstallCursor \
+ (tkIntPlatStubsPtr->tkMacOSXInstallCursor) /* 11 */
+#define TkMacOSXHandleTearoffMenu \
+ (tkIntPlatStubsPtr->tkMacOSXHandleTearoffMenu) /* 12 */
+/* Slot 13 is reserved */
+#define TkMacOSXDoHLEvent \
+ (tkIntPlatStubsPtr->tkMacOSXDoHLEvent) /* 14 */
+/* Slot 15 is reserved */
+#define TkMacOSXGetXWindow \
+ (tkIntPlatStubsPtr->tkMacOSXGetXWindow) /* 16 */
+#define TkMacOSXGrowToplevel \
+ (tkIntPlatStubsPtr->tkMacOSXGrowToplevel) /* 17 */
+#define TkMacOSXHandleMenuSelect \
+ (tkIntPlatStubsPtr->tkMacOSXHandleMenuSelect) /* 18 */
+/* Slot 19 is reserved */
+/* Slot 20 is reserved */
+#define TkMacOSXInvalidateWindow \
+ (tkIntPlatStubsPtr->tkMacOSXInvalidateWindow) /* 21 */
+#define TkMacOSXIsCharacterMissing \
+ (tkIntPlatStubsPtr->tkMacOSXIsCharacterMissing) /* 22 */
+#define TkMacOSXMakeRealWindowExist \
+ (tkIntPlatStubsPtr->tkMacOSXMakeRealWindowExist) /* 23 */
+#define TkMacOSXMakeStippleMap \
+ (tkIntPlatStubsPtr->tkMacOSXMakeStippleMap) /* 24 */
+#define TkMacOSXMenuClick \
+ (tkIntPlatStubsPtr->tkMacOSXMenuClick) /* 25 */
+#define TkMacOSXRegisterOffScreenWindow \
+ (tkIntPlatStubsPtr->tkMacOSXRegisterOffScreenWindow) /* 26 */
+#define TkMacOSXResizable \
+ (tkIntPlatStubsPtr->tkMacOSXResizable) /* 27 */
+#define TkMacOSXSetHelpMenuItemCount \
+ (tkIntPlatStubsPtr->tkMacOSXSetHelpMenuItemCount) /* 28 */
+#define TkMacOSXSetScrollbarGrow \
+ (tkIntPlatStubsPtr->tkMacOSXSetScrollbarGrow) /* 29 */
+#define TkMacOSXSetUpClippingRgn \
+ (tkIntPlatStubsPtr->tkMacOSXSetUpClippingRgn) /* 30 */
+#define TkMacOSXSetUpGraphicsPort \
+ (tkIntPlatStubsPtr->tkMacOSXSetUpGraphicsPort) /* 31 */
+#define TkMacOSXUpdateClipRgn \
+ (tkIntPlatStubsPtr->tkMacOSXUpdateClipRgn) /* 32 */
+#define TkMacOSXUnregisterMacWindow \
+ (tkIntPlatStubsPtr->tkMacOSXUnregisterMacWindow) /* 33 */
+#define TkMacOSXUseMenuID \
+ (tkIntPlatStubsPtr->tkMacOSXUseMenuID) /* 34 */
+#define TkMacOSXVisableClipRgn \
+ (tkIntPlatStubsPtr->tkMacOSXVisableClipRgn) /* 35 */
+#define TkMacOSXWinBounds \
+ (tkIntPlatStubsPtr->tkMacOSXWinBounds) /* 36 */
+#define TkMacOSXWindowOffset \
+ (tkIntPlatStubsPtr->tkMacOSXWindowOffset) /* 37 */
+#define TkSetMacColor \
+ (tkIntPlatStubsPtr->tkSetMacColor) /* 38 */
+#define TkSetWMName \
+ (tkIntPlatStubsPtr->tkSetWMName) /* 39 */
+#define TkSuspendClipboard \
+ (tkIntPlatStubsPtr->tkSuspendClipboard) /* 40 */
+#define TkMacOSXZoomToplevel \
+ (tkIntPlatStubsPtr->tkMacOSXZoomToplevel) /* 41 */
+#define Tk_TopCoordsToWindow \
+ (tkIntPlatStubsPtr->tk_TopCoordsToWindow) /* 42 */
+#define TkMacOSXContainerId \
+ (tkIntPlatStubsPtr->tkMacOSXContainerId) /* 43 */
+#define TkMacOSXGetHostToplevel \
+ (tkIntPlatStubsPtr->tkMacOSXGetHostToplevel) /* 44 */
+#define TkMacOSXPreprocessMenu \
+ (tkIntPlatStubsPtr->tkMacOSXPreprocessMenu) /* 45 */
+#define TkpIsWindowFloating \
+ (tkIntPlatStubsPtr->tkpIsWindowFloating) /* 46 */
+#define TkMacOSXGetCapture \
+ (tkIntPlatStubsPtr->tkMacOSXGetCapture) /* 47 */
+/* Slot 48 is reserved */
+#define TkGetTransientMaster \
+ (tkIntPlatStubsPtr->tkGetTransientMaster) /* 49 */
+#define TkGenerateButtonEvent \
+ (tkIntPlatStubsPtr->tkGenerateButtonEvent) /* 50 */
+#define TkGenWMDestroyEvent \
+ (tkIntPlatStubsPtr->tkGenWMDestroyEvent) /* 51 */
+#define TkMacOSXSetDrawingEnabled \
+ (tkIntPlatStubsPtr->tkMacOSXSetDrawingEnabled) /* 52 */
+#define TkpGetMS \
+ (tkIntPlatStubsPtr->tkpGetMS) /* 53 */
+#define TkMacOSXDrawable \
+ (tkIntPlatStubsPtr->tkMacOSXDrawable) /* 54 */
+#define TkpScanWindowId \
+ (tkIntPlatStubsPtr->tkpScanWindowId) /* 55 */
+#endif /* AQUA */
+#if !(defined(_WIN32) || defined(__CYGWIN__) || defined(MAC_OSX_TK)) /* X11 */
+#define TkCreateXEventSource \
+ (tkIntPlatStubsPtr->tkCreateXEventSource) /* 0 */
+/* Slot 1 is reserved */
+/* Slot 2 is reserved */
+#define TkpCmapStressed \
+ (tkIntPlatStubsPtr->tkpCmapStressed) /* 3 */
+#define TkpSync \
+ (tkIntPlatStubsPtr->tkpSync) /* 4 */
+#define TkUnixContainerId \
+ (tkIntPlatStubsPtr->tkUnixContainerId) /* 5 */
+#define TkUnixDoOneXEvent \
+ (tkIntPlatStubsPtr->tkUnixDoOneXEvent) /* 6 */
+#define TkUnixSetMenubar \
+ (tkIntPlatStubsPtr->tkUnixSetMenubar) /* 7 */
+#define TkpScanWindowId \
+ (tkIntPlatStubsPtr->tkpScanWindowId) /* 8 */
+#define TkWmCleanup \
+ (tkIntPlatStubsPtr->tkWmCleanup) /* 9 */
+#define TkSendCleanup \
+ (tkIntPlatStubsPtr->tkSendCleanup) /* 10 */
+/* Slot 11 is reserved */
+#define TkpWmSetState \
+ (tkIntPlatStubsPtr->tkpWmSetState) /* 12 */
+#define TkpTestsendCmd \
+ (tkIntPlatStubsPtr->tkpTestsendCmd) /* 13 */
+#endif /* X11 */
+
+#endif /* defined(USE_TK_STUBS) */
+
+/* !END!: Do not edit above this line. */
+
+#undef TCL_STORAGE_CLASS
+#define TCL_STORAGE_CLASS DLLIMPORT
+
+#endif /* _TKINTPLATDECLS */
diff --git a/tk8.6/generic/tkIntXlibDecls.h b/tk8.6/generic/tkIntXlibDecls.h
new file mode 100644
index 0000000..6ac7ccb
--- /dev/null
+++ b/tk8.6/generic/tkIntXlibDecls.h
@@ -0,0 +1,1279 @@
+/*
+ * 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.
+ */
+
+#ifndef _TKINTXLIBDECLS
+#define _TKINTXLIBDECLS
+
+/*
+ * 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.
+ */
+
+#ifndef _TCL
+# include <tcl.h>
+#endif
+
+#include "X11/Xutil.h"
+
+#ifdef BUILD_tk
+#undef TCL_STORAGE_CLASS
+#define TCL_STORAGE_CLASS DLLEXPORT
+#endif
+
+typedef int (*XAfterFunction) ( /* WARNING, this type not in Xlib spec */
+ Display* /* display */
+);
+
+/* !BEGIN!: Do not edit below this line. */
+
+#ifdef __cplusplus
+extern "C" {
+#endif
+
+/*
+ * Exported function declarations:
+ */
+
+#if defined(_WIN32) || defined(__CYGWIN__) /* WIN */
+/* 0 */
+EXTERN int XSetDashes(Display *display, GC gc, int dash_offset,
+ _Xconst char *dash_list, int n);
+/* 1 */
+EXTERN XModifierKeymap * XGetModifierMapping(Display *d);
+/* 2 */
+EXTERN 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);
+/* 3 */
+EXTERN XImage * XGetImage(Display *d, Drawable dr, int i1, int i2,
+ unsigned int ui1, unsigned int ui2,
+ unsigned long ul, int i3);
+/* 4 */
+EXTERN char * XGetAtomName(Display *d, Atom a);
+/* 5 */
+EXTERN char * XKeysymToString(KeySym k);
+/* 6 */
+EXTERN Colormap XCreateColormap(Display *d, Window w, Visual *v,
+ int i);
+/* 7 */
+EXTERN Cursor XCreatePixmapCursor(Display *d, Pixmap p1, Pixmap p2,
+ XColor *x1, XColor *x2, unsigned int ui1,
+ unsigned int ui2);
+/* 8 */
+EXTERN Cursor XCreateGlyphCursor(Display *d, Font f1, Font f2,
+ unsigned int ui1, unsigned int ui2,
+ XColor _Xconst *x1, XColor _Xconst *x2);
+/* 9 */
+EXTERN GContext XGContextFromGC(GC g);
+/* 10 */
+EXTERN XHostAddress * XListHosts(Display *d, int *i, Bool *b);
+/* 11 */
+EXTERN KeySym XKeycodeToKeysym(Display *d, unsigned int k, int i);
+/* 12 */
+EXTERN KeySym XStringToKeysym(_Xconst char *c);
+/* 13 */
+EXTERN Window XRootWindow(Display *d, int i);
+/* 14 */
+EXTERN XErrorHandler XSetErrorHandler(XErrorHandler x);
+/* 15 */
+EXTERN Status XIconifyWindow(Display *d, Window w, int i);
+/* 16 */
+EXTERN Status XWithdrawWindow(Display *d, Window w, int i);
+/* 17 */
+EXTERN Status XGetWMColormapWindows(Display *d, Window w,
+ Window **wpp, int *ip);
+/* 18 */
+EXTERN Status XAllocColor(Display *d, Colormap c, XColor *xp);
+/* 19 */
+EXTERN int XBell(Display *d, int i);
+/* 20 */
+EXTERN int XChangeProperty(Display *d, Window w, Atom a1,
+ Atom a2, int i1, int i2,
+ _Xconst unsigned char *c, int i3);
+/* 21 */
+EXTERN int XChangeWindowAttributes(Display *d, Window w,
+ unsigned long ul, XSetWindowAttributes *x);
+/* 22 */
+EXTERN int XClearWindow(Display *d, Window w);
+/* 23 */
+EXTERN int XConfigureWindow(Display *d, Window w,
+ unsigned int i, XWindowChanges *x);
+/* 24 */
+EXTERN int XCopyArea(Display *d, Drawable dr1, Drawable dr2,
+ GC g, int i1, int i2, unsigned int ui1,
+ unsigned int ui2, int i3, int i4);
+/* 25 */
+EXTERN int 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);
+/* 26 */
+EXTERN Pixmap XCreateBitmapFromData(Display *display, Drawable d,
+ _Xconst char *data, unsigned int width,
+ unsigned int height);
+/* 27 */
+EXTERN int XDefineCursor(Display *d, Window w, Cursor c);
+/* 28 */
+EXTERN int XDeleteProperty(Display *d, Window w, Atom a);
+/* 29 */
+EXTERN int XDestroyWindow(Display *d, Window w);
+/* 30 */
+EXTERN int XDrawArc(Display *d, Drawable dr, GC g, int i1,
+ int i2, unsigned int ui1, unsigned int ui2,
+ int i3, int i4);
+/* 31 */
+EXTERN int XDrawLines(Display *d, Drawable dr, GC g, XPoint *x,
+ int i1, int i2);
+/* 32 */
+EXTERN int XDrawRectangle(Display *d, Drawable dr, GC g, int i1,
+ int i2, unsigned int ui1, unsigned int ui2);
+/* 33 */
+EXTERN int XFillArc(Display *d, Drawable dr, GC g, int i1,
+ int i2, unsigned int ui1, unsigned int ui2,
+ int i3, int i4);
+/* 34 */
+EXTERN int XFillPolygon(Display *d, Drawable dr, GC g,
+ XPoint *x, int i1, int i2, int i3);
+/* 35 */
+EXTERN int XFillRectangles(Display *d, Drawable dr, GC g,
+ XRectangle *x, int i);
+/* 36 */
+EXTERN int XForceScreenSaver(Display *d, int i);
+/* 37 */
+EXTERN int XFreeColormap(Display *d, Colormap c);
+/* 38 */
+EXTERN int XFreeColors(Display *d, Colormap c,
+ unsigned long *ulp, int i, unsigned long ul);
+/* 39 */
+EXTERN int XFreeCursor(Display *d, Cursor c);
+/* 40 */
+EXTERN int XFreeModifiermap(XModifierKeymap *x);
+/* 41 */
+EXTERN Status XGetGeometry(Display *d, Drawable dr, Window *w,
+ int *i1, int *i2, unsigned int *ui1,
+ unsigned int *ui2, unsigned int *ui3,
+ unsigned int *ui4);
+/* 42 */
+EXTERN int XGetInputFocus(Display *d, Window *w, int *i);
+/* 43 */
+EXTERN 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);
+/* 44 */
+EXTERN Status XGetWindowAttributes(Display *d, Window w,
+ XWindowAttributes *x);
+/* 45 */
+EXTERN int XGrabKeyboard(Display *d, Window w, Bool b, int i1,
+ int i2, Time t);
+/* 46 */
+EXTERN int XGrabPointer(Display *d, Window w1, Bool b,
+ unsigned int ui, int i1, int i2, Window w2,
+ Cursor c, Time t);
+/* 47 */
+EXTERN KeyCode XKeysymToKeycode(Display *d, KeySym k);
+/* 48 */
+EXTERN Status XLookupColor(Display *d, Colormap c1,
+ _Xconst char *c2, XColor *x1, XColor *x2);
+/* 49 */
+EXTERN int XMapWindow(Display *d, Window w);
+/* 50 */
+EXTERN int XMoveResizeWindow(Display *d, Window w, int i1,
+ int i2, unsigned int ui1, unsigned int ui2);
+/* 51 */
+EXTERN int XMoveWindow(Display *d, Window w, int i1, int i2);
+/* 52 */
+EXTERN int XNextEvent(Display *d, XEvent *x);
+/* 53 */
+EXTERN int XPutBackEvent(Display *d, XEvent *x);
+/* 54 */
+EXTERN int XQueryColors(Display *d, Colormap c, XColor *x,
+ int i);
+/* 55 */
+EXTERN Bool XQueryPointer(Display *d, Window w1, Window *w2,
+ Window *w3, int *i1, int *i2, int *i3,
+ int *i4, unsigned int *ui);
+/* 56 */
+EXTERN Status XQueryTree(Display *d, Window w1, Window *w2,
+ Window *w3, Window **w4, unsigned int *ui);
+/* 57 */
+EXTERN int XRaiseWindow(Display *d, Window w);
+/* 58 */
+EXTERN int XRefreshKeyboardMapping(XMappingEvent *x);
+/* 59 */
+EXTERN int XResizeWindow(Display *d, Window w, unsigned int ui1,
+ unsigned int ui2);
+/* 60 */
+EXTERN int XSelectInput(Display *d, Window w, long l);
+/* 61 */
+EXTERN Status XSendEvent(Display *d, Window w, Bool b, long l,
+ XEvent *x);
+/* 62 */
+EXTERN int XSetCommand(Display *d, Window w, char **c, int i);
+/* 63 */
+EXTERN int XSetIconName(Display *d, Window w, _Xconst char *c);
+/* 64 */
+EXTERN int XSetInputFocus(Display *d, Window w, int i, Time t);
+/* 65 */
+EXTERN int XSetSelectionOwner(Display *d, Atom a, Window w,
+ Time t);
+/* 66 */
+EXTERN int XSetWindowBackground(Display *d, Window w,
+ unsigned long ul);
+/* 67 */
+EXTERN int XSetWindowBackgroundPixmap(Display *d, Window w,
+ Pixmap p);
+/* 68 */
+EXTERN int XSetWindowBorder(Display *d, Window w,
+ unsigned long ul);
+/* 69 */
+EXTERN int XSetWindowBorderPixmap(Display *d, Window w,
+ Pixmap p);
+/* 70 */
+EXTERN int XSetWindowBorderWidth(Display *d, Window w,
+ unsigned int ui);
+/* 71 */
+EXTERN int XSetWindowColormap(Display *d, Window w, Colormap c);
+/* 72 */
+EXTERN Bool XTranslateCoordinates(Display *d, Window w1,
+ Window w2, int i1, int i2, int *i3, int *i4,
+ Window *w3);
+/* 73 */
+EXTERN int XUngrabKeyboard(Display *d, Time t);
+/* 74 */
+EXTERN int XUngrabPointer(Display *d, Time t);
+/* 75 */
+EXTERN int XUnmapWindow(Display *d, Window w);
+/* 76 */
+EXTERN int XWindowEvent(Display *d, Window w, long l, XEvent *x);
+/* 77 */
+EXTERN void XDestroyIC(XIC x);
+/* 78 */
+EXTERN Bool XFilterEvent(XEvent *x, Window w);
+/* 79 */
+EXTERN int XmbLookupString(XIC xi, XKeyPressedEvent *xk,
+ char *c, int i, KeySym *k, Status *s);
+/* 80 */
+EXTERN int 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);
+/* Slot 81 is reserved */
+/* 82 */
+EXTERN Status XParseColor(Display *display, Colormap map,
+ _Xconst char *spec, XColor *colorPtr);
+/* 83 */
+EXTERN GC XCreateGC(Display *display, Drawable d,
+ unsigned long valuemask, XGCValues *values);
+/* 84 */
+EXTERN int XFreeGC(Display *display, GC gc);
+/* 85 */
+EXTERN Atom XInternAtom(Display *display,
+ _Xconst char *atom_name, Bool only_if_exists);
+/* 86 */
+EXTERN int XSetBackground(Display *display, GC gc,
+ unsigned long foreground);
+/* 87 */
+EXTERN int XSetForeground(Display *display, GC gc,
+ unsigned long foreground);
+/* 88 */
+EXTERN int XSetClipMask(Display *display, GC gc, Pixmap pixmap);
+/* 89 */
+EXTERN int XSetClipOrigin(Display *display, GC gc,
+ int clip_x_origin, int clip_y_origin);
+/* 90 */
+EXTERN int XSetTSOrigin(Display *display, GC gc,
+ int ts_x_origin, int ts_y_origin);
+/* 91 */
+EXTERN int XChangeGC(Display *d, GC gc, unsigned long mask,
+ XGCValues *values);
+/* 92 */
+EXTERN int XSetFont(Display *display, GC gc, Font font);
+/* 93 */
+EXTERN int XSetArcMode(Display *display, GC gc, int arc_mode);
+/* 94 */
+EXTERN int XSetStipple(Display *display, GC gc, Pixmap stipple);
+/* 95 */
+EXTERN int XSetFillRule(Display *display, GC gc, int fill_rule);
+/* 96 */
+EXTERN int XSetFillStyle(Display *display, GC gc,
+ int fill_style);
+/* 97 */
+EXTERN int XSetFunction(Display *display, GC gc, int function);
+/* 98 */
+EXTERN int XSetLineAttributes(Display *display, GC gc,
+ unsigned int line_width, int line_style,
+ int cap_style, int join_style);
+/* 99 */
+EXTERN int _XInitImageFuncPtrs(XImage *image);
+/* 100 */
+EXTERN XIC XCreateIC(XIM xim, ...);
+/* 101 */
+EXTERN XVisualInfo * XGetVisualInfo(Display *display, long vinfo_mask,
+ XVisualInfo *vinfo_template,
+ int *nitems_return);
+/* 102 */
+EXTERN void XSetWMClientMachine(Display *display, Window w,
+ XTextProperty *text_prop);
+/* 103 */
+EXTERN Status XStringListToTextProperty(char **list, int count,
+ XTextProperty *text_prop_return);
+/* 104 */
+EXTERN int XDrawLine(Display *d, Drawable dr, GC g, int x1,
+ int y1, int x2, int y2);
+/* 105 */
+EXTERN int XWarpPointer(Display *d, Window s, Window dw, int sx,
+ int sy, unsigned int sw, unsigned int sh,
+ int dx, int dy);
+/* 106 */
+EXTERN int XFillRectangle(Display *display, Drawable d, GC gc,
+ int x, int y, unsigned int width,
+ unsigned int height);
+/* 107 */
+EXTERN int XFlush(Display *display);
+/* 108 */
+EXTERN int XGrabServer(Display *display);
+/* 109 */
+EXTERN int XUngrabServer(Display *display);
+/* 110 */
+EXTERN int XFree(void *data);
+/* 111 */
+EXTERN int XNoOp(Display *display);
+/* 112 */
+EXTERN XAfterFunction XSynchronize(Display *display, Bool onoff);
+/* 113 */
+EXTERN int XSync(Display *display, Bool discard);
+/* 114 */
+EXTERN VisualID XVisualIDFromVisual(Visual *visual);
+#endif /* WIN */
+#ifdef MAC_OSX_TK /* AQUA */
+/* 0 */
+EXTERN int XSetDashes(Display *display, GC gc, int dash_offset,
+ _Xconst char *dash_list, int n);
+/* 1 */
+EXTERN XModifierKeymap * XGetModifierMapping(Display *d);
+/* 2 */
+EXTERN 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);
+/* 3 */
+EXTERN XImage * XGetImage(Display *d, Drawable dr, int i1, int i2,
+ unsigned int ui1, unsigned int ui2,
+ unsigned long ul, int i3);
+/* 4 */
+EXTERN char * XGetAtomName(Display *d, Atom a);
+/* 5 */
+EXTERN char * XKeysymToString(KeySym k);
+/* 6 */
+EXTERN Colormap XCreateColormap(Display *d, Window w, Visual *v,
+ int i);
+/* 7 */
+EXTERN GContext XGContextFromGC(GC g);
+/* 8 */
+EXTERN KeySym XKeycodeToKeysym(Display *d, KeyCode k, int i);
+/* 9 */
+EXTERN KeySym XStringToKeysym(_Xconst char *c);
+/* 10 */
+EXTERN Window XRootWindow(Display *d, int i);
+/* 11 */
+EXTERN XErrorHandler XSetErrorHandler(XErrorHandler x);
+/* 12 */
+EXTERN Status XAllocColor(Display *d, Colormap c, XColor *xp);
+/* 13 */
+EXTERN int XBell(Display *d, int i);
+/* 14 */
+EXTERN void XChangeProperty(Display *d, Window w, Atom a1,
+ Atom a2, int i1, int i2,
+ _Xconst unsigned char *c, int i3);
+/* 15 */
+EXTERN void XChangeWindowAttributes(Display *d, Window w,
+ unsigned long ul, XSetWindowAttributes *x);
+/* 16 */
+EXTERN void XConfigureWindow(Display *d, Window w,
+ unsigned int i, XWindowChanges *x);
+/* 17 */
+EXTERN void XCopyArea(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(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(Display *display, Drawable d,
+ _Xconst char *data, unsigned int width,
+ unsigned int height);
+/* 20 */
+EXTERN int XDefineCursor(Display *d, Window w, Cursor c);
+/* 21 */
+EXTERN void XDestroyWindow(Display *d, Window w);
+/* 22 */
+EXTERN void XDrawArc(Display *d, Drawable dr, GC g, int i1,
+ int i2, unsigned int ui1, unsigned int ui2,
+ int i3, int i4);
+/* 23 */
+EXTERN int XDrawLines(Display *d, Drawable dr, GC g, XPoint *x,
+ int i1, int i2);
+/* 24 */
+EXTERN void XDrawRectangle(Display *d, Drawable dr, GC g, int i1,
+ int i2, unsigned int ui1, unsigned int ui2);
+/* 25 */
+EXTERN void XFillArc(Display *d, Drawable dr, GC g, int i1,
+ int i2, unsigned int ui1, unsigned int ui2,
+ int i3, int i4);
+/* 26 */
+EXTERN void XFillPolygon(Display *d, Drawable dr, GC g,
+ XPoint *x, int i1, int i2, int i3);
+/* 27 */
+EXTERN int XFillRectangles(Display *d, Drawable dr, GC g,
+ XRectangle *x, int i);
+/* 28 */
+EXTERN int XFreeColormap(Display *d, Colormap c);
+/* 29 */
+EXTERN int XFreeColors(Display *d, Colormap c,
+ unsigned long *ulp, int i, unsigned long ul);
+/* 30 */
+EXTERN int XFreeModifiermap(XModifierKeymap *x);
+/* 31 */
+EXTERN Status XGetGeometry(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(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(Display *d, Window w, Bool b, int i1,
+ int i2, Time t);
+/* 34 */
+EXTERN int XGrabPointer(Display *d, Window w1, Bool b,
+ unsigned int ui, int i1, int i2, Window w2,
+ Cursor c, Time t);
+/* 35 */
+EXTERN KeyCode XKeysymToKeycode(Display *d, KeySym k);
+/* 36 */
+EXTERN void XMapWindow(Display *d, Window w);
+/* 37 */
+EXTERN void XMoveResizeWindow(Display *d, Window w, int i1,
+ int i2, unsigned int ui1, unsigned int ui2);
+/* 38 */
+EXTERN void XMoveWindow(Display *d, Window w, int i1, int i2);
+/* 39 */
+EXTERN Bool XQueryPointer(Display *d, Window w1, Window *w2,
+ Window *w3, int *i1, int *i2, int *i3,
+ int *i4, unsigned int *ui);
+/* 40 */
+EXTERN void XRaiseWindow(Display *d, Window w);
+/* 41 */
+EXTERN void XRefreshKeyboardMapping(XMappingEvent *x);
+/* 42 */
+EXTERN void XResizeWindow(Display *d, Window w, unsigned int ui1,
+ unsigned int ui2);
+/* 43 */
+EXTERN void XSelectInput(Display *d, Window w, long l);
+/* 44 */
+EXTERN Status XSendEvent(Display *d, Window w, Bool b, long l,
+ XEvent *x);
+/* 45 */
+EXTERN void XSetIconName(Display *d, Window w, _Xconst char *c);
+/* 46 */
+EXTERN void XSetInputFocus(Display *d, Window w, int i, Time t);
+/* 47 */
+EXTERN int XSetSelectionOwner(Display *d, Atom a, Window w,
+ Time t);
+/* 48 */
+EXTERN void XSetWindowBackground(Display *d, Window w,
+ unsigned long ul);
+/* 49 */
+EXTERN void XSetWindowBackgroundPixmap(Display *d, Window w,
+ Pixmap p);
+/* 50 */
+EXTERN void XSetWindowBorder(Display *d, Window w,
+ unsigned long ul);
+/* 51 */
+EXTERN void XSetWindowBorderPixmap(Display *d, Window w,
+ Pixmap p);
+/* 52 */
+EXTERN void XSetWindowBorderWidth(Display *d, Window w,
+ unsigned int ui);
+/* 53 */
+EXTERN void XSetWindowColormap(Display *d, Window w, Colormap c);
+/* 54 */
+EXTERN void XUngrabKeyboard(Display *d, Time t);
+/* 55 */
+EXTERN int XUngrabPointer(Display *d, Time t);
+/* 56 */
+EXTERN void XUnmapWindow(Display *d, Window w);
+/* 57 */
+EXTERN int 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);
+/* 58 */
+EXTERN Status XParseColor(Display *display, Colormap map,
+ _Xconst char *spec, XColor *colorPtr);
+/* 59 */
+EXTERN GC XCreateGC(Display *display, Drawable d,
+ unsigned long valuemask, XGCValues *values);
+/* 60 */
+EXTERN int XFreeGC(Display *display, GC gc);
+/* 61 */
+EXTERN Atom XInternAtom(Display *display,
+ _Xconst char *atom_name, Bool only_if_exists);
+/* 62 */
+EXTERN int XSetBackground(Display *display, GC gc,
+ unsigned long foreground);
+/* 63 */
+EXTERN int XSetForeground(Display *display, GC gc,
+ unsigned long foreground);
+/* 64 */
+EXTERN int XSetClipMask(Display *display, GC gc, Pixmap pixmap);
+/* 65 */
+EXTERN int XSetClipOrigin(Display *display, GC gc,
+ int clip_x_origin, int clip_y_origin);
+/* 66 */
+EXTERN int XSetTSOrigin(Display *display, GC gc,
+ int ts_x_origin, int ts_y_origin);
+/* 67 */
+EXTERN int XChangeGC(Display *d, GC gc, unsigned long mask,
+ XGCValues *values);
+/* 68 */
+EXTERN int XSetFont(Display *display, GC gc, Font font);
+/* 69 */
+EXTERN int XSetArcMode(Display *display, GC gc, int arc_mode);
+/* 70 */
+EXTERN int XSetStipple(Display *display, GC gc, Pixmap stipple);
+/* 71 */
+EXTERN int XSetFillRule(Display *display, GC gc, int fill_rule);
+/* 72 */
+EXTERN int XSetFillStyle(Display *display, GC gc,
+ int fill_style);
+/* 73 */
+EXTERN int XSetFunction(Display *display, GC gc, int function);
+/* 74 */
+EXTERN int XSetLineAttributes(Display *display, GC gc,
+ unsigned int line_width, int line_style,
+ int cap_style, int join_style);
+/* 75 */
+EXTERN int _XInitImageFuncPtrs(XImage *image);
+/* 76 */
+EXTERN XIC XCreateIC(void);
+/* 77 */
+EXTERN XVisualInfo * XGetVisualInfo(Display *display, long vinfo_mask,
+ XVisualInfo *vinfo_template,
+ int *nitems_return);
+/* 78 */
+EXTERN void XSetWMClientMachine(Display *display, Window w,
+ XTextProperty *text_prop);
+/* 79 */
+EXTERN Status XStringListToTextProperty(char **list, int count,
+ XTextProperty *text_prop_return);
+/* 80 */
+EXTERN void XDrawSegments(Display *display, Drawable d, GC gc,
+ XSegment *segments, int nsegments);
+/* 81 */
+EXTERN void XForceScreenSaver(Display *display, int mode);
+/* 82 */
+EXTERN int XDrawLine(Display *d, Drawable dr, GC g, int x1,
+ int y1, int x2, int y2);
+/* 83 */
+EXTERN int XFillRectangle(Display *display, Drawable d, GC gc,
+ int x, int y, unsigned int width,
+ unsigned int height);
+/* 84 */
+EXTERN void XClearWindow(Display *d, Window w);
+/* 85 */
+EXTERN void XDrawPoint(Display *display, Drawable d, GC gc,
+ int x, int y);
+/* 86 */
+EXTERN void XDrawPoints(Display *display, Drawable d, GC gc,
+ XPoint *points, int npoints, int mode);
+/* 87 */
+EXTERN int 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);
+/* 88 */
+EXTERN void XQueryColor(Display *display, Colormap colormap,
+ XColor *def_in_out);
+/* 89 */
+EXTERN void XQueryColors(Display *display, Colormap colormap,
+ XColor *defs_in_out, int ncolors);
+/* 90 */
+EXTERN Status XQueryTree(Display *d, Window w1, Window *w2,
+ Window *w3, Window **w4, unsigned int *ui);
+/* 91 */
+EXTERN int XSync(Display *display, Bool flag);
+#endif /* AQUA */
+
+typedef struct TkIntXlibStubs {
+ int magic;
+ void *hooks;
+
+#if defined(_WIN32) || defined(__CYGWIN__) /* WIN */
+ int (*xSetDashes) (Display *display, GC gc, int dash_offset, _Xconst char *dash_list, int n); /* 0 */
+ XModifierKeymap * (*xGetModifierMapping) (Display *d); /* 1 */
+ 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); /* 2 */
+ XImage * (*xGetImage) (Display *d, Drawable dr, int i1, int i2, unsigned int ui1, unsigned int ui2, unsigned long ul, int i3); /* 3 */
+ char * (*xGetAtomName) (Display *d, Atom a); /* 4 */
+ char * (*xKeysymToString) (KeySym k); /* 5 */
+ Colormap (*xCreateColormap) (Display *d, Window w, Visual *v, int i); /* 6 */
+ Cursor (*xCreatePixmapCursor) (Display *d, Pixmap p1, Pixmap p2, XColor *x1, XColor *x2, unsigned int ui1, unsigned int ui2); /* 7 */
+ Cursor (*xCreateGlyphCursor) (Display *d, Font f1, Font f2, unsigned int ui1, unsigned int ui2, XColor _Xconst *x1, XColor _Xconst *x2); /* 8 */
+ GContext (*xGContextFromGC) (GC g); /* 9 */
+ XHostAddress * (*xListHosts) (Display *d, int *i, Bool *b); /* 10 */
+ KeySym (*xKeycodeToKeysym) (Display *d, unsigned int k, int i); /* 11 */
+ KeySym (*xStringToKeysym) (_Xconst char *c); /* 12 */
+ Window (*xRootWindow) (Display *d, int i); /* 13 */
+ XErrorHandler (*xSetErrorHandler) (XErrorHandler x); /* 14 */
+ Status (*xIconifyWindow) (Display *d, Window w, int i); /* 15 */
+ Status (*xWithdrawWindow) (Display *d, Window w, int i); /* 16 */
+ Status (*xGetWMColormapWindows) (Display *d, Window w, Window **wpp, int *ip); /* 17 */
+ Status (*xAllocColor) (Display *d, Colormap c, XColor *xp); /* 18 */
+ int (*xBell) (Display *d, int i); /* 19 */
+ int (*xChangeProperty) (Display *d, Window w, Atom a1, Atom a2, int i1, int i2, _Xconst unsigned char *c, int i3); /* 20 */
+ int (*xChangeWindowAttributes) (Display *d, Window w, unsigned long ul, XSetWindowAttributes *x); /* 21 */
+ int (*xClearWindow) (Display *d, Window w); /* 22 */
+ int (*xConfigureWindow) (Display *d, Window w, unsigned int i, XWindowChanges *x); /* 23 */
+ int (*xCopyArea) (Display *d, Drawable dr1, Drawable dr2, GC g, int i1, int i2, unsigned int ui1, unsigned int ui2, int i3, int i4); /* 24 */
+ int (*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); /* 25 */
+ Pixmap (*xCreateBitmapFromData) (Display *display, Drawable d, _Xconst char *data, unsigned int width, unsigned int height); /* 26 */
+ int (*xDefineCursor) (Display *d, Window w, Cursor c); /* 27 */
+ int (*xDeleteProperty) (Display *d, Window w, Atom a); /* 28 */
+ int (*xDestroyWindow) (Display *d, Window w); /* 29 */
+ int (*xDrawArc) (Display *d, Drawable dr, GC g, int i1, int i2, unsigned int ui1, unsigned int ui2, int i3, int i4); /* 30 */
+ int (*xDrawLines) (Display *d, Drawable dr, GC g, XPoint *x, int i1, int i2); /* 31 */
+ int (*xDrawRectangle) (Display *d, Drawable dr, GC g, int i1, int i2, unsigned int ui1, unsigned int ui2); /* 32 */
+ int (*xFillArc) (Display *d, Drawable dr, GC g, int i1, int i2, unsigned int ui1, unsigned int ui2, int i3, int i4); /* 33 */
+ int (*xFillPolygon) (Display *d, Drawable dr, GC g, XPoint *x, int i1, int i2, int i3); /* 34 */
+ int (*xFillRectangles) (Display *d, Drawable dr, GC g, XRectangle *x, int i); /* 35 */
+ int (*xForceScreenSaver) (Display *d, int i); /* 36 */
+ int (*xFreeColormap) (Display *d, Colormap c); /* 37 */
+ int (*xFreeColors) (Display *d, Colormap c, unsigned long *ulp, int i, unsigned long ul); /* 38 */
+ int (*xFreeCursor) (Display *d, Cursor c); /* 39 */
+ int (*xFreeModifiermap) (XModifierKeymap *x); /* 40 */
+ Status (*xGetGeometry) (Display *d, Drawable dr, Window *w, int *i1, int *i2, unsigned int *ui1, unsigned int *ui2, unsigned int *ui3, unsigned int *ui4); /* 41 */
+ int (*xGetInputFocus) (Display *d, Window *w, int *i); /* 42 */
+ 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); /* 43 */
+ Status (*xGetWindowAttributes) (Display *d, Window w, XWindowAttributes *x); /* 44 */
+ int (*xGrabKeyboard) (Display *d, Window w, Bool b, int i1, int i2, Time t); /* 45 */
+ int (*xGrabPointer) (Display *d, Window w1, Bool b, unsigned int ui, int i1, int i2, Window w2, Cursor c, Time t); /* 46 */
+ KeyCode (*xKeysymToKeycode) (Display *d, KeySym k); /* 47 */
+ Status (*xLookupColor) (Display *d, Colormap c1, _Xconst char *c2, XColor *x1, XColor *x2); /* 48 */
+ int (*xMapWindow) (Display *d, Window w); /* 49 */
+ int (*xMoveResizeWindow) (Display *d, Window w, int i1, int i2, unsigned int ui1, unsigned int ui2); /* 50 */
+ int (*xMoveWindow) (Display *d, Window w, int i1, int i2); /* 51 */
+ int (*xNextEvent) (Display *d, XEvent *x); /* 52 */
+ int (*xPutBackEvent) (Display *d, XEvent *x); /* 53 */
+ int (*xQueryColors) (Display *d, Colormap c, XColor *x, int i); /* 54 */
+ Bool (*xQueryPointer) (Display *d, Window w1, Window *w2, Window *w3, int *i1, int *i2, int *i3, int *i4, unsigned int *ui); /* 55 */
+ Status (*xQueryTree) (Display *d, Window w1, Window *w2, Window *w3, Window **w4, unsigned int *ui); /* 56 */
+ int (*xRaiseWindow) (Display *d, Window w); /* 57 */
+ int (*xRefreshKeyboardMapping) (XMappingEvent *x); /* 58 */
+ int (*xResizeWindow) (Display *d, Window w, unsigned int ui1, unsigned int ui2); /* 59 */
+ int (*xSelectInput) (Display *d, Window w, long l); /* 60 */
+ Status (*xSendEvent) (Display *d, Window w, Bool b, long l, XEvent *x); /* 61 */
+ int (*xSetCommand) (Display *d, Window w, char **c, int i); /* 62 */
+ int (*xSetIconName) (Display *d, Window w, _Xconst char *c); /* 63 */
+ int (*xSetInputFocus) (Display *d, Window w, int i, Time t); /* 64 */
+ int (*xSetSelectionOwner) (Display *d, Atom a, Window w, Time t); /* 65 */
+ int (*xSetWindowBackground) (Display *d, Window w, unsigned long ul); /* 66 */
+ int (*xSetWindowBackgroundPixmap) (Display *d, Window w, Pixmap p); /* 67 */
+ int (*xSetWindowBorder) (Display *d, Window w, unsigned long ul); /* 68 */
+ int (*xSetWindowBorderPixmap) (Display *d, Window w, Pixmap p); /* 69 */
+ int (*xSetWindowBorderWidth) (Display *d, Window w, unsigned int ui); /* 70 */
+ int (*xSetWindowColormap) (Display *d, Window w, Colormap c); /* 71 */
+ Bool (*xTranslateCoordinates) (Display *d, Window w1, Window w2, int i1, int i2, int *i3, int *i4, Window *w3); /* 72 */
+ int (*xUngrabKeyboard) (Display *d, Time t); /* 73 */
+ int (*xUngrabPointer) (Display *d, Time t); /* 74 */
+ int (*xUnmapWindow) (Display *d, Window w); /* 75 */
+ int (*xWindowEvent) (Display *d, Window w, long l, XEvent *x); /* 76 */
+ void (*xDestroyIC) (XIC x); /* 77 */
+ Bool (*xFilterEvent) (XEvent *x, Window w); /* 78 */
+ int (*xmbLookupString) (XIC xi, XKeyPressedEvent *xk, char *c, int i, KeySym *k, Status *s); /* 79 */
+ int (*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); /* 80 */
+ void (*reserved81)(void);
+ Status (*xParseColor) (Display *display, Colormap map, _Xconst char *spec, XColor *colorPtr); /* 82 */
+ GC (*xCreateGC) (Display *display, Drawable d, unsigned long valuemask, XGCValues *values); /* 83 */
+ int (*xFreeGC) (Display *display, GC gc); /* 84 */
+ Atom (*xInternAtom) (Display *display, _Xconst char *atom_name, Bool only_if_exists); /* 85 */
+ int (*xSetBackground) (Display *display, GC gc, unsigned long foreground); /* 86 */
+ int (*xSetForeground) (Display *display, GC gc, unsigned long foreground); /* 87 */
+ int (*xSetClipMask) (Display *display, GC gc, Pixmap pixmap); /* 88 */
+ int (*xSetClipOrigin) (Display *display, GC gc, int clip_x_origin, int clip_y_origin); /* 89 */
+ int (*xSetTSOrigin) (Display *display, GC gc, int ts_x_origin, int ts_y_origin); /* 90 */
+ int (*xChangeGC) (Display *d, GC gc, unsigned long mask, XGCValues *values); /* 91 */
+ int (*xSetFont) (Display *display, GC gc, Font font); /* 92 */
+ int (*xSetArcMode) (Display *display, GC gc, int arc_mode); /* 93 */
+ int (*xSetStipple) (Display *display, GC gc, Pixmap stipple); /* 94 */
+ int (*xSetFillRule) (Display *display, GC gc, int fill_rule); /* 95 */
+ int (*xSetFillStyle) (Display *display, GC gc, int fill_style); /* 96 */
+ int (*xSetFunction) (Display *display, GC gc, int function); /* 97 */
+ int (*xSetLineAttributes) (Display *display, GC gc, unsigned int line_width, int line_style, int cap_style, int join_style); /* 98 */
+ int (*_XInitImageFuncPtrs) (XImage *image); /* 99 */
+ XIC (*xCreateIC) (XIM xim, ...); /* 100 */
+ XVisualInfo * (*xGetVisualInfo) (Display *display, long vinfo_mask, XVisualInfo *vinfo_template, int *nitems_return); /* 101 */
+ void (*xSetWMClientMachine) (Display *display, Window w, XTextProperty *text_prop); /* 102 */
+ Status (*xStringListToTextProperty) (char **list, int count, XTextProperty *text_prop_return); /* 103 */
+ int (*xDrawLine) (Display *d, Drawable dr, GC g, int x1, int y1, int x2, int y2); /* 104 */
+ int (*xWarpPointer) (Display *d, Window s, Window dw, int sx, int sy, unsigned int sw, unsigned int sh, int dx, int dy); /* 105 */
+ int (*xFillRectangle) (Display *display, Drawable d, GC gc, int x, int y, unsigned int width, unsigned int height); /* 106 */
+ int (*xFlush) (Display *display); /* 107 */
+ int (*xGrabServer) (Display *display); /* 108 */
+ int (*xUngrabServer) (Display *display); /* 109 */
+ int (*xFree) (void *data); /* 110 */
+ int (*xNoOp) (Display *display); /* 111 */
+ XAfterFunction (*xSynchronize) (Display *display, Bool onoff); /* 112 */
+ int (*xSync) (Display *display, Bool discard); /* 113 */
+ VisualID (*xVisualIDFromVisual) (Visual *visual); /* 114 */
+#endif /* WIN */
+#ifdef MAC_OSX_TK /* AQUA */
+ int (*xSetDashes) (Display *display, GC gc, int dash_offset, _Xconst char *dash_list, int n); /* 0 */
+ XModifierKeymap * (*xGetModifierMapping) (Display *d); /* 1 */
+ 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); /* 2 */
+ XImage * (*xGetImage) (Display *d, Drawable dr, int i1, int i2, unsigned int ui1, unsigned int ui2, unsigned long ul, int i3); /* 3 */
+ char * (*xGetAtomName) (Display *d, Atom a); /* 4 */
+ char * (*xKeysymToString) (KeySym k); /* 5 */
+ Colormap (*xCreateColormap) (Display *d, Window w, Visual *v, int i); /* 6 */
+ GContext (*xGContextFromGC) (GC g); /* 7 */
+ KeySym (*xKeycodeToKeysym) (Display *d, KeyCode k, int i); /* 8 */
+ KeySym (*xStringToKeysym) (_Xconst char *c); /* 9 */
+ Window (*xRootWindow) (Display *d, int i); /* 10 */
+ XErrorHandler (*xSetErrorHandler) (XErrorHandler x); /* 11 */
+ Status (*xAllocColor) (Display *d, Colormap c, XColor *xp); /* 12 */
+ int (*xBell) (Display *d, int i); /* 13 */
+ void (*xChangeProperty) (Display *d, Window w, Atom a1, Atom a2, int i1, int i2, _Xconst unsigned char *c, int i3); /* 14 */
+ void (*xChangeWindowAttributes) (Display *d, Window w, unsigned long ul, XSetWindowAttributes *x); /* 15 */
+ void (*xConfigureWindow) (Display *d, Window w, unsigned int i, XWindowChanges *x); /* 16 */
+ void (*xCopyArea) (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) (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) (Display *display, Drawable d, _Xconst char *data, unsigned int width, unsigned int height); /* 19 */
+ int (*xDefineCursor) (Display *d, Window w, Cursor c); /* 20 */
+ void (*xDestroyWindow) (Display *d, Window w); /* 21 */
+ void (*xDrawArc) (Display *d, Drawable dr, GC g, int i1, int i2, unsigned int ui1, unsigned int ui2, int i3, int i4); /* 22 */
+ int (*xDrawLines) (Display *d, Drawable dr, GC g, XPoint *x, int i1, int i2); /* 23 */
+ void (*xDrawRectangle) (Display *d, Drawable dr, GC g, int i1, int i2, unsigned int ui1, unsigned int ui2); /* 24 */
+ void (*xFillArc) (Display *d, Drawable dr, GC g, int i1, int i2, unsigned int ui1, unsigned int ui2, int i3, int i4); /* 25 */
+ void (*xFillPolygon) (Display *d, Drawable dr, GC g, XPoint *x, int i1, int i2, int i3); /* 26 */
+ int (*xFillRectangles) (Display *d, Drawable dr, GC g, XRectangle *x, int i); /* 27 */
+ int (*xFreeColormap) (Display *d, Colormap c); /* 28 */
+ int (*xFreeColors) (Display *d, Colormap c, unsigned long *ulp, int i, unsigned long ul); /* 29 */
+ int (*xFreeModifiermap) (XModifierKeymap *x); /* 30 */
+ Status (*xGetGeometry) (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) (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) (Display *d, Window w, Bool b, int i1, int i2, Time t); /* 33 */
+ int (*xGrabPointer) (Display *d, Window w1, Bool b, unsigned int ui, int i1, int i2, Window w2, Cursor c, Time t); /* 34 */
+ KeyCode (*xKeysymToKeycode) (Display *d, KeySym k); /* 35 */
+ void (*xMapWindow) (Display *d, Window w); /* 36 */
+ void (*xMoveResizeWindow) (Display *d, Window w, int i1, int i2, unsigned int ui1, unsigned int ui2); /* 37 */
+ void (*xMoveWindow) (Display *d, Window w, int i1, int i2); /* 38 */
+ Bool (*xQueryPointer) (Display *d, Window w1, Window *w2, Window *w3, int *i1, int *i2, int *i3, int *i4, unsigned int *ui); /* 39 */
+ void (*xRaiseWindow) (Display *d, Window w); /* 40 */
+ void (*xRefreshKeyboardMapping) (XMappingEvent *x); /* 41 */
+ void (*xResizeWindow) (Display *d, Window w, unsigned int ui1, unsigned int ui2); /* 42 */
+ void (*xSelectInput) (Display *d, Window w, long l); /* 43 */
+ Status (*xSendEvent) (Display *d, Window w, Bool b, long l, XEvent *x); /* 44 */
+ void (*xSetIconName) (Display *d, Window w, _Xconst char *c); /* 45 */
+ void (*xSetInputFocus) (Display *d, Window w, int i, Time t); /* 46 */
+ int (*xSetSelectionOwner) (Display *d, Atom a, Window w, Time t); /* 47 */
+ void (*xSetWindowBackground) (Display *d, Window w, unsigned long ul); /* 48 */
+ void (*xSetWindowBackgroundPixmap) (Display *d, Window w, Pixmap p); /* 49 */
+ void (*xSetWindowBorder) (Display *d, Window w, unsigned long ul); /* 50 */
+ void (*xSetWindowBorderPixmap) (Display *d, Window w, Pixmap p); /* 51 */
+ void (*xSetWindowBorderWidth) (Display *d, Window w, unsigned int ui); /* 52 */
+ void (*xSetWindowColormap) (Display *d, Window w, Colormap c); /* 53 */
+ void (*xUngrabKeyboard) (Display *d, Time t); /* 54 */
+ int (*xUngrabPointer) (Display *d, Time t); /* 55 */
+ void (*xUnmapWindow) (Display *d, Window w); /* 56 */
+ int (*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); /* 57 */
+ Status (*xParseColor) (Display *display, Colormap map, _Xconst char *spec, XColor *colorPtr); /* 58 */
+ GC (*xCreateGC) (Display *display, Drawable d, unsigned long valuemask, XGCValues *values); /* 59 */
+ int (*xFreeGC) (Display *display, GC gc); /* 60 */
+ Atom (*xInternAtom) (Display *display, _Xconst char *atom_name, Bool only_if_exists); /* 61 */
+ int (*xSetBackground) (Display *display, GC gc, unsigned long foreground); /* 62 */
+ int (*xSetForeground) (Display *display, GC gc, unsigned long foreground); /* 63 */
+ int (*xSetClipMask) (Display *display, GC gc, Pixmap pixmap); /* 64 */
+ int (*xSetClipOrigin) (Display *display, GC gc, int clip_x_origin, int clip_y_origin); /* 65 */
+ int (*xSetTSOrigin) (Display *display, GC gc, int ts_x_origin, int ts_y_origin); /* 66 */
+ int (*xChangeGC) (Display *d, GC gc, unsigned long mask, XGCValues *values); /* 67 */
+ int (*xSetFont) (Display *display, GC gc, Font font); /* 68 */
+ int (*xSetArcMode) (Display *display, GC gc, int arc_mode); /* 69 */
+ int (*xSetStipple) (Display *display, GC gc, Pixmap stipple); /* 70 */
+ int (*xSetFillRule) (Display *display, GC gc, int fill_rule); /* 71 */
+ int (*xSetFillStyle) (Display *display, GC gc, int fill_style); /* 72 */
+ int (*xSetFunction) (Display *display, GC gc, int function); /* 73 */
+ int (*xSetLineAttributes) (Display *display, GC gc, unsigned int line_width, int line_style, int cap_style, int join_style); /* 74 */
+ int (*_XInitImageFuncPtrs) (XImage *image); /* 75 */
+ XIC (*xCreateIC) (void); /* 76 */
+ XVisualInfo * (*xGetVisualInfo) (Display *display, long vinfo_mask, XVisualInfo *vinfo_template, int *nitems_return); /* 77 */
+ void (*xSetWMClientMachine) (Display *display, Window w, XTextProperty *text_prop); /* 78 */
+ Status (*xStringListToTextProperty) (char **list, int count, XTextProperty *text_prop_return); /* 79 */
+ void (*xDrawSegments) (Display *display, Drawable d, GC gc, XSegment *segments, int nsegments); /* 80 */
+ void (*xForceScreenSaver) (Display *display, int mode); /* 81 */
+ int (*xDrawLine) (Display *d, Drawable dr, GC g, int x1, int y1, int x2, int y2); /* 82 */
+ int (*xFillRectangle) (Display *display, Drawable d, GC gc, int x, int y, unsigned int width, unsigned int height); /* 83 */
+ void (*xClearWindow) (Display *d, Window w); /* 84 */
+ void (*xDrawPoint) (Display *display, Drawable d, GC gc, int x, int y); /* 85 */
+ void (*xDrawPoints) (Display *display, Drawable d, GC gc, XPoint *points, int npoints, int mode); /* 86 */
+ int (*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); /* 87 */
+ void (*xQueryColor) (Display *display, Colormap colormap, XColor *def_in_out); /* 88 */
+ void (*xQueryColors) (Display *display, Colormap colormap, XColor *defs_in_out, int ncolors); /* 89 */
+ Status (*xQueryTree) (Display *d, Window w1, Window *w2, Window *w3, Window **w4, unsigned int *ui); /* 90 */
+ int (*xSync) (Display *display, Bool flag); /* 91 */
+#endif /* AQUA */
+} TkIntXlibStubs;
+
+extern const TkIntXlibStubs *tkIntXlibStubsPtr;
+
+#ifdef __cplusplus
+}
+#endif
+
+#if defined(USE_TK_STUBS)
+
+/*
+ * Inline function declarations:
+ */
+
+#if defined(_WIN32) || defined(__CYGWIN__) /* WIN */
+#define XSetDashes \
+ (tkIntXlibStubsPtr->xSetDashes) /* 0 */
+#define XGetModifierMapping \
+ (tkIntXlibStubsPtr->xGetModifierMapping) /* 1 */
+#define XCreateImage \
+ (tkIntXlibStubsPtr->xCreateImage) /* 2 */
+#define XGetImage \
+ (tkIntXlibStubsPtr->xGetImage) /* 3 */
+#define XGetAtomName \
+ (tkIntXlibStubsPtr->xGetAtomName) /* 4 */
+#define XKeysymToString \
+ (tkIntXlibStubsPtr->xKeysymToString) /* 5 */
+#define XCreateColormap \
+ (tkIntXlibStubsPtr->xCreateColormap) /* 6 */
+#define XCreatePixmapCursor \
+ (tkIntXlibStubsPtr->xCreatePixmapCursor) /* 7 */
+#define XCreateGlyphCursor \
+ (tkIntXlibStubsPtr->xCreateGlyphCursor) /* 8 */
+#define XGContextFromGC \
+ (tkIntXlibStubsPtr->xGContextFromGC) /* 9 */
+#define XListHosts \
+ (tkIntXlibStubsPtr->xListHosts) /* 10 */
+#define XKeycodeToKeysym \
+ (tkIntXlibStubsPtr->xKeycodeToKeysym) /* 11 */
+#define XStringToKeysym \
+ (tkIntXlibStubsPtr->xStringToKeysym) /* 12 */
+#define XRootWindow \
+ (tkIntXlibStubsPtr->xRootWindow) /* 13 */
+#define XSetErrorHandler \
+ (tkIntXlibStubsPtr->xSetErrorHandler) /* 14 */
+#define XIconifyWindow \
+ (tkIntXlibStubsPtr->xIconifyWindow) /* 15 */
+#define XWithdrawWindow \
+ (tkIntXlibStubsPtr->xWithdrawWindow) /* 16 */
+#define XGetWMColormapWindows \
+ (tkIntXlibStubsPtr->xGetWMColormapWindows) /* 17 */
+#define XAllocColor \
+ (tkIntXlibStubsPtr->xAllocColor) /* 18 */
+#define XBell \
+ (tkIntXlibStubsPtr->xBell) /* 19 */
+#define XChangeProperty \
+ (tkIntXlibStubsPtr->xChangeProperty) /* 20 */
+#define XChangeWindowAttributes \
+ (tkIntXlibStubsPtr->xChangeWindowAttributes) /* 21 */
+#define XClearWindow \
+ (tkIntXlibStubsPtr->xClearWindow) /* 22 */
+#define XConfigureWindow \
+ (tkIntXlibStubsPtr->xConfigureWindow) /* 23 */
+#define XCopyArea \
+ (tkIntXlibStubsPtr->xCopyArea) /* 24 */
+#define XCopyPlane \
+ (tkIntXlibStubsPtr->xCopyPlane) /* 25 */
+#define XCreateBitmapFromData \
+ (tkIntXlibStubsPtr->xCreateBitmapFromData) /* 26 */
+#define XDefineCursor \
+ (tkIntXlibStubsPtr->xDefineCursor) /* 27 */
+#define XDeleteProperty \
+ (tkIntXlibStubsPtr->xDeleteProperty) /* 28 */
+#define XDestroyWindow \
+ (tkIntXlibStubsPtr->xDestroyWindow) /* 29 */
+#define XDrawArc \
+ (tkIntXlibStubsPtr->xDrawArc) /* 30 */
+#define XDrawLines \
+ (tkIntXlibStubsPtr->xDrawLines) /* 31 */
+#define XDrawRectangle \
+ (tkIntXlibStubsPtr->xDrawRectangle) /* 32 */
+#define XFillArc \
+ (tkIntXlibStubsPtr->xFillArc) /* 33 */
+#define XFillPolygon \
+ (tkIntXlibStubsPtr->xFillPolygon) /* 34 */
+#define XFillRectangles \
+ (tkIntXlibStubsPtr->xFillRectangles) /* 35 */
+#define XForceScreenSaver \
+ (tkIntXlibStubsPtr->xForceScreenSaver) /* 36 */
+#define XFreeColormap \
+ (tkIntXlibStubsPtr->xFreeColormap) /* 37 */
+#define XFreeColors \
+ (tkIntXlibStubsPtr->xFreeColors) /* 38 */
+#define XFreeCursor \
+ (tkIntXlibStubsPtr->xFreeCursor) /* 39 */
+#define XFreeModifiermap \
+ (tkIntXlibStubsPtr->xFreeModifiermap) /* 40 */
+#define XGetGeometry \
+ (tkIntXlibStubsPtr->xGetGeometry) /* 41 */
+#define XGetInputFocus \
+ (tkIntXlibStubsPtr->xGetInputFocus) /* 42 */
+#define XGetWindowProperty \
+ (tkIntXlibStubsPtr->xGetWindowProperty) /* 43 */
+#define XGetWindowAttributes \
+ (tkIntXlibStubsPtr->xGetWindowAttributes) /* 44 */
+#define XGrabKeyboard \
+ (tkIntXlibStubsPtr->xGrabKeyboard) /* 45 */
+#define XGrabPointer \
+ (tkIntXlibStubsPtr->xGrabPointer) /* 46 */
+#define XKeysymToKeycode \
+ (tkIntXlibStubsPtr->xKeysymToKeycode) /* 47 */
+#define XLookupColor \
+ (tkIntXlibStubsPtr->xLookupColor) /* 48 */
+#define XMapWindow \
+ (tkIntXlibStubsPtr->xMapWindow) /* 49 */
+#define XMoveResizeWindow \
+ (tkIntXlibStubsPtr->xMoveResizeWindow) /* 50 */
+#define XMoveWindow \
+ (tkIntXlibStubsPtr->xMoveWindow) /* 51 */
+#define XNextEvent \
+ (tkIntXlibStubsPtr->xNextEvent) /* 52 */
+#define XPutBackEvent \
+ (tkIntXlibStubsPtr->xPutBackEvent) /* 53 */
+#define XQueryColors \
+ (tkIntXlibStubsPtr->xQueryColors) /* 54 */
+#define XQueryPointer \
+ (tkIntXlibStubsPtr->xQueryPointer) /* 55 */
+#define XQueryTree \
+ (tkIntXlibStubsPtr->xQueryTree) /* 56 */
+#define XRaiseWindow \
+ (tkIntXlibStubsPtr->xRaiseWindow) /* 57 */
+#define XRefreshKeyboardMapping \
+ (tkIntXlibStubsPtr->xRefreshKeyboardMapping) /* 58 */
+#define XResizeWindow \
+ (tkIntXlibStubsPtr->xResizeWindow) /* 59 */
+#define XSelectInput \
+ (tkIntXlibStubsPtr->xSelectInput) /* 60 */
+#define XSendEvent \
+ (tkIntXlibStubsPtr->xSendEvent) /* 61 */
+#define XSetCommand \
+ (tkIntXlibStubsPtr->xSetCommand) /* 62 */
+#define XSetIconName \
+ (tkIntXlibStubsPtr->xSetIconName) /* 63 */
+#define XSetInputFocus \
+ (tkIntXlibStubsPtr->xSetInputFocus) /* 64 */
+#define XSetSelectionOwner \
+ (tkIntXlibStubsPtr->xSetSelectionOwner) /* 65 */
+#define XSetWindowBackground \
+ (tkIntXlibStubsPtr->xSetWindowBackground) /* 66 */
+#define XSetWindowBackgroundPixmap \
+ (tkIntXlibStubsPtr->xSetWindowBackgroundPixmap) /* 67 */
+#define XSetWindowBorder \
+ (tkIntXlibStubsPtr->xSetWindowBorder) /* 68 */
+#define XSetWindowBorderPixmap \
+ (tkIntXlibStubsPtr->xSetWindowBorderPixmap) /* 69 */
+#define XSetWindowBorderWidth \
+ (tkIntXlibStubsPtr->xSetWindowBorderWidth) /* 70 */
+#define XSetWindowColormap \
+ (tkIntXlibStubsPtr->xSetWindowColormap) /* 71 */
+#define XTranslateCoordinates \
+ (tkIntXlibStubsPtr->xTranslateCoordinates) /* 72 */
+#define XUngrabKeyboard \
+ (tkIntXlibStubsPtr->xUngrabKeyboard) /* 73 */
+#define XUngrabPointer \
+ (tkIntXlibStubsPtr->xUngrabPointer) /* 74 */
+#define XUnmapWindow \
+ (tkIntXlibStubsPtr->xUnmapWindow) /* 75 */
+#define XWindowEvent \
+ (tkIntXlibStubsPtr->xWindowEvent) /* 76 */
+#define XDestroyIC \
+ (tkIntXlibStubsPtr->xDestroyIC) /* 77 */
+#define XFilterEvent \
+ (tkIntXlibStubsPtr->xFilterEvent) /* 78 */
+#define XmbLookupString \
+ (tkIntXlibStubsPtr->xmbLookupString) /* 79 */
+#define TkPutImage \
+ (tkIntXlibStubsPtr->tkPutImage) /* 80 */
+/* Slot 81 is reserved */
+#define XParseColor \
+ (tkIntXlibStubsPtr->xParseColor) /* 82 */
+#define XCreateGC \
+ (tkIntXlibStubsPtr->xCreateGC) /* 83 */
+#define XFreeGC \
+ (tkIntXlibStubsPtr->xFreeGC) /* 84 */
+#define XInternAtom \
+ (tkIntXlibStubsPtr->xInternAtom) /* 85 */
+#define XSetBackground \
+ (tkIntXlibStubsPtr->xSetBackground) /* 86 */
+#define XSetForeground \
+ (tkIntXlibStubsPtr->xSetForeground) /* 87 */
+#define XSetClipMask \
+ (tkIntXlibStubsPtr->xSetClipMask) /* 88 */
+#define XSetClipOrigin \
+ (tkIntXlibStubsPtr->xSetClipOrigin) /* 89 */
+#define XSetTSOrigin \
+ (tkIntXlibStubsPtr->xSetTSOrigin) /* 90 */
+#define XChangeGC \
+ (tkIntXlibStubsPtr->xChangeGC) /* 91 */
+#define XSetFont \
+ (tkIntXlibStubsPtr->xSetFont) /* 92 */
+#define XSetArcMode \
+ (tkIntXlibStubsPtr->xSetArcMode) /* 93 */
+#define XSetStipple \
+ (tkIntXlibStubsPtr->xSetStipple) /* 94 */
+#define XSetFillRule \
+ (tkIntXlibStubsPtr->xSetFillRule) /* 95 */
+#define XSetFillStyle \
+ (tkIntXlibStubsPtr->xSetFillStyle) /* 96 */
+#define XSetFunction \
+ (tkIntXlibStubsPtr->xSetFunction) /* 97 */
+#define XSetLineAttributes \
+ (tkIntXlibStubsPtr->xSetLineAttributes) /* 98 */
+#define _XInitImageFuncPtrs \
+ (tkIntXlibStubsPtr->_XInitImageFuncPtrs) /* 99 */
+#define XCreateIC \
+ (tkIntXlibStubsPtr->xCreateIC) /* 100 */
+#define XGetVisualInfo \
+ (tkIntXlibStubsPtr->xGetVisualInfo) /* 101 */
+#define XSetWMClientMachine \
+ (tkIntXlibStubsPtr->xSetWMClientMachine) /* 102 */
+#define XStringListToTextProperty \
+ (tkIntXlibStubsPtr->xStringListToTextProperty) /* 103 */
+#define XDrawLine \
+ (tkIntXlibStubsPtr->xDrawLine) /* 104 */
+#define XWarpPointer \
+ (tkIntXlibStubsPtr->xWarpPointer) /* 105 */
+#define XFillRectangle \
+ (tkIntXlibStubsPtr->xFillRectangle) /* 106 */
+#define XFlush \
+ (tkIntXlibStubsPtr->xFlush) /* 107 */
+#define XGrabServer \
+ (tkIntXlibStubsPtr->xGrabServer) /* 108 */
+#define XUngrabServer \
+ (tkIntXlibStubsPtr->xUngrabServer) /* 109 */
+#define XFree \
+ (tkIntXlibStubsPtr->xFree) /* 110 */
+#define XNoOp \
+ (tkIntXlibStubsPtr->xNoOp) /* 111 */
+#define XSynchronize \
+ (tkIntXlibStubsPtr->xSynchronize) /* 112 */
+#define XSync \
+ (tkIntXlibStubsPtr->xSync) /* 113 */
+#define XVisualIDFromVisual \
+ (tkIntXlibStubsPtr->xVisualIDFromVisual) /* 114 */
+#endif /* WIN */
+#ifdef MAC_OSX_TK /* AQUA */
+#define XSetDashes \
+ (tkIntXlibStubsPtr->xSetDashes) /* 0 */
+#define XGetModifierMapping \
+ (tkIntXlibStubsPtr->xGetModifierMapping) /* 1 */
+#define XCreateImage \
+ (tkIntXlibStubsPtr->xCreateImage) /* 2 */
+#define XGetImage \
+ (tkIntXlibStubsPtr->xGetImage) /* 3 */
+#define XGetAtomName \
+ (tkIntXlibStubsPtr->xGetAtomName) /* 4 */
+#define XKeysymToString \
+ (tkIntXlibStubsPtr->xKeysymToString) /* 5 */
+#define XCreateColormap \
+ (tkIntXlibStubsPtr->xCreateColormap) /* 6 */
+#define XGContextFromGC \
+ (tkIntXlibStubsPtr->xGContextFromGC) /* 7 */
+#define XKeycodeToKeysym \
+ (tkIntXlibStubsPtr->xKeycodeToKeysym) /* 8 */
+#define XStringToKeysym \
+ (tkIntXlibStubsPtr->xStringToKeysym) /* 9 */
+#define XRootWindow \
+ (tkIntXlibStubsPtr->xRootWindow) /* 10 */
+#define XSetErrorHandler \
+ (tkIntXlibStubsPtr->xSetErrorHandler) /* 11 */
+#define XAllocColor \
+ (tkIntXlibStubsPtr->xAllocColor) /* 12 */
+#define XBell \
+ (tkIntXlibStubsPtr->xBell) /* 13 */
+#define XChangeProperty \
+ (tkIntXlibStubsPtr->xChangeProperty) /* 14 */
+#define XChangeWindowAttributes \
+ (tkIntXlibStubsPtr->xChangeWindowAttributes) /* 15 */
+#define XConfigureWindow \
+ (tkIntXlibStubsPtr->xConfigureWindow) /* 16 */
+#define XCopyArea \
+ (tkIntXlibStubsPtr->xCopyArea) /* 17 */
+#define XCopyPlane \
+ (tkIntXlibStubsPtr->xCopyPlane) /* 18 */
+#define XCreateBitmapFromData \
+ (tkIntXlibStubsPtr->xCreateBitmapFromData) /* 19 */
+#define XDefineCursor \
+ (tkIntXlibStubsPtr->xDefineCursor) /* 20 */
+#define XDestroyWindow \
+ (tkIntXlibStubsPtr->xDestroyWindow) /* 21 */
+#define XDrawArc \
+ (tkIntXlibStubsPtr->xDrawArc) /* 22 */
+#define XDrawLines \
+ (tkIntXlibStubsPtr->xDrawLines) /* 23 */
+#define XDrawRectangle \
+ (tkIntXlibStubsPtr->xDrawRectangle) /* 24 */
+#define XFillArc \
+ (tkIntXlibStubsPtr->xFillArc) /* 25 */
+#define XFillPolygon \
+ (tkIntXlibStubsPtr->xFillPolygon) /* 26 */
+#define XFillRectangles \
+ (tkIntXlibStubsPtr->xFillRectangles) /* 27 */
+#define XFreeColormap \
+ (tkIntXlibStubsPtr->xFreeColormap) /* 28 */
+#define XFreeColors \
+ (tkIntXlibStubsPtr->xFreeColors) /* 29 */
+#define XFreeModifiermap \
+ (tkIntXlibStubsPtr->xFreeModifiermap) /* 30 */
+#define XGetGeometry \
+ (tkIntXlibStubsPtr->xGetGeometry) /* 31 */
+#define XGetWindowProperty \
+ (tkIntXlibStubsPtr->xGetWindowProperty) /* 32 */
+#define XGrabKeyboard \
+ (tkIntXlibStubsPtr->xGrabKeyboard) /* 33 */
+#define XGrabPointer \
+ (tkIntXlibStubsPtr->xGrabPointer) /* 34 */
+#define XKeysymToKeycode \
+ (tkIntXlibStubsPtr->xKeysymToKeycode) /* 35 */
+#define XMapWindow \
+ (tkIntXlibStubsPtr->xMapWindow) /* 36 */
+#define XMoveResizeWindow \
+ (tkIntXlibStubsPtr->xMoveResizeWindow) /* 37 */
+#define XMoveWindow \
+ (tkIntXlibStubsPtr->xMoveWindow) /* 38 */
+#define XQueryPointer \
+ (tkIntXlibStubsPtr->xQueryPointer) /* 39 */
+#define XRaiseWindow \
+ (tkIntXlibStubsPtr->xRaiseWindow) /* 40 */
+#define XRefreshKeyboardMapping \
+ (tkIntXlibStubsPtr->xRefreshKeyboardMapping) /* 41 */
+#define XResizeWindow \
+ (tkIntXlibStubsPtr->xResizeWindow) /* 42 */
+#define XSelectInput \
+ (tkIntXlibStubsPtr->xSelectInput) /* 43 */
+#define XSendEvent \
+ (tkIntXlibStubsPtr->xSendEvent) /* 44 */
+#define XSetIconName \
+ (tkIntXlibStubsPtr->xSetIconName) /* 45 */
+#define XSetInputFocus \
+ (tkIntXlibStubsPtr->xSetInputFocus) /* 46 */
+#define XSetSelectionOwner \
+ (tkIntXlibStubsPtr->xSetSelectionOwner) /* 47 */
+#define XSetWindowBackground \
+ (tkIntXlibStubsPtr->xSetWindowBackground) /* 48 */
+#define XSetWindowBackgroundPixmap \
+ (tkIntXlibStubsPtr->xSetWindowBackgroundPixmap) /* 49 */
+#define XSetWindowBorder \
+ (tkIntXlibStubsPtr->xSetWindowBorder) /* 50 */
+#define XSetWindowBorderPixmap \
+ (tkIntXlibStubsPtr->xSetWindowBorderPixmap) /* 51 */
+#define XSetWindowBorderWidth \
+ (tkIntXlibStubsPtr->xSetWindowBorderWidth) /* 52 */
+#define XSetWindowColormap \
+ (tkIntXlibStubsPtr->xSetWindowColormap) /* 53 */
+#define XUngrabKeyboard \
+ (tkIntXlibStubsPtr->xUngrabKeyboard) /* 54 */
+#define XUngrabPointer \
+ (tkIntXlibStubsPtr->xUngrabPointer) /* 55 */
+#define XUnmapWindow \
+ (tkIntXlibStubsPtr->xUnmapWindow) /* 56 */
+#define TkPutImage \
+ (tkIntXlibStubsPtr->tkPutImage) /* 57 */
+#define XParseColor \
+ (tkIntXlibStubsPtr->xParseColor) /* 58 */
+#define XCreateGC \
+ (tkIntXlibStubsPtr->xCreateGC) /* 59 */
+#define XFreeGC \
+ (tkIntXlibStubsPtr->xFreeGC) /* 60 */
+#define XInternAtom \
+ (tkIntXlibStubsPtr->xInternAtom) /* 61 */
+#define XSetBackground \
+ (tkIntXlibStubsPtr->xSetBackground) /* 62 */
+#define XSetForeground \
+ (tkIntXlibStubsPtr->xSetForeground) /* 63 */
+#define XSetClipMask \
+ (tkIntXlibStubsPtr->xSetClipMask) /* 64 */
+#define XSetClipOrigin \
+ (tkIntXlibStubsPtr->xSetClipOrigin) /* 65 */
+#define XSetTSOrigin \
+ (tkIntXlibStubsPtr->xSetTSOrigin) /* 66 */
+#define XChangeGC \
+ (tkIntXlibStubsPtr->xChangeGC) /* 67 */
+#define XSetFont \
+ (tkIntXlibStubsPtr->xSetFont) /* 68 */
+#define XSetArcMode \
+ (tkIntXlibStubsPtr->xSetArcMode) /* 69 */
+#define XSetStipple \
+ (tkIntXlibStubsPtr->xSetStipple) /* 70 */
+#define XSetFillRule \
+ (tkIntXlibStubsPtr->xSetFillRule) /* 71 */
+#define XSetFillStyle \
+ (tkIntXlibStubsPtr->xSetFillStyle) /* 72 */
+#define XSetFunction \
+ (tkIntXlibStubsPtr->xSetFunction) /* 73 */
+#define XSetLineAttributes \
+ (tkIntXlibStubsPtr->xSetLineAttributes) /* 74 */
+#define _XInitImageFuncPtrs \
+ (tkIntXlibStubsPtr->_XInitImageFuncPtrs) /* 75 */
+#define XCreateIC \
+ (tkIntXlibStubsPtr->xCreateIC) /* 76 */
+#define XGetVisualInfo \
+ (tkIntXlibStubsPtr->xGetVisualInfo) /* 77 */
+#define XSetWMClientMachine \
+ (tkIntXlibStubsPtr->xSetWMClientMachine) /* 78 */
+#define XStringListToTextProperty \
+ (tkIntXlibStubsPtr->xStringListToTextProperty) /* 79 */
+#define XDrawSegments \
+ (tkIntXlibStubsPtr->xDrawSegments) /* 80 */
+#define XForceScreenSaver \
+ (tkIntXlibStubsPtr->xForceScreenSaver) /* 81 */
+#define XDrawLine \
+ (tkIntXlibStubsPtr->xDrawLine) /* 82 */
+#define XFillRectangle \
+ (tkIntXlibStubsPtr->xFillRectangle) /* 83 */
+#define XClearWindow \
+ (tkIntXlibStubsPtr->xClearWindow) /* 84 */
+#define XDrawPoint \
+ (tkIntXlibStubsPtr->xDrawPoint) /* 85 */
+#define XDrawPoints \
+ (tkIntXlibStubsPtr->xDrawPoints) /* 86 */
+#define XWarpPointer \
+ (tkIntXlibStubsPtr->xWarpPointer) /* 87 */
+#define XQueryColor \
+ (tkIntXlibStubsPtr->xQueryColor) /* 88 */
+#define XQueryColors \
+ (tkIntXlibStubsPtr->xQueryColors) /* 89 */
+#define XQueryTree \
+ (tkIntXlibStubsPtr->xQueryTree) /* 90 */
+#define XSync \
+ (tkIntXlibStubsPtr->xSync) /* 91 */
+#endif /* AQUA */
+
+#endif /* defined(USE_TK_STUBS) */
+
+/* !END!: Do not edit above this line. */
+
+#undef TCL_STORAGE_CLASS
+#define TCL_STORAGE_CLASS DLLIMPORT
+
+#endif /* _TKINTXLIBDECLS */
diff --git a/tk8.6/generic/tkListbox.c b/tk8.6/generic/tkListbox.c
new file mode 100644
index 0000000..b059727
--- /dev/null
+++ b/tk8.6/generic/tkListbox.c
@@ -0,0 +1,3646 @@
+/*
+ * tkListbox.c --
+ *
+ * This module implements listbox widgets for the Tk toolkit. A listbox
+ * displays a collection of strings, one per line, and provides scrolling
+ * and selection.
+ *
+ * Copyright (c) 1990-1994 The Regents of the University of California.
+ * Copyright (c) 1994-1997 Sun Microsystems, Inc.
+ *
+ * See the file "license.terms" for information on usage and redistribution of
+ * this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ */
+
+#include "default.h"
+#include "tkInt.h"
+
+#ifdef _WIN32
+#include "tkWinInt.h"
+#endif
+
+typedef struct {
+ Tk_OptionTable listboxOptionTable;
+ /* Table defining configuration options
+ * available for the listbox. */
+ Tk_OptionTable itemAttrOptionTable;
+ /* Table defining configuration options
+ * available for listbox items. */
+} ListboxOptionTables;
+
+/*
+ * A data structure of the following type is kept for each listbox widget
+ * managed by this file:
+ */
+
+typedef struct {
+ Tk_Window tkwin; /* Window that embodies the listbox. NULL
+ * means that the window has been destroyed
+ * but the data structures haven't yet been
+ * cleaned up. */
+ Display *display; /* Display containing widget. Used, among
+ * other things, so that resources can be
+ * freed even after tkwin has gone away. */
+ Tcl_Interp *interp; /* Interpreter associated with listbox. */
+ Tcl_Command widgetCmd; /* Token for listbox's widget command. */
+ Tk_OptionTable optionTable; /* Table that defines configuration options
+ * available for this widget. */
+ Tk_OptionTable itemAttrOptionTable;
+ /* Table that defines configuration options
+ * available for listbox items. */
+ char *listVarName; /* List variable name */
+ Tcl_Obj *listObj; /* Pointer to the list object being used */
+ int nElements; /* Holds the current count of elements */
+ Tcl_HashTable *selection; /* Tracks selection */
+ Tcl_HashTable *itemAttrTable;
+ /* Tracks item attributes */
+
+ /*
+ * Information used when displaying widget:
+ */
+
+ Tk_3DBorder normalBorder; /* Used for drawing border around whole
+ * window, plus used for background. */
+ int borderWidth; /* Width of 3-D border around window. */
+ int relief; /* 3-D effect: TK_RELIEF_RAISED, etc. */
+ int highlightWidth; /* Width in pixels of highlight to draw around
+ * widget when it has the focus. <= 0 means
+ * don't draw a highlight. */
+ XColor *highlightBgColorPtr;
+ /* Color for drawing traversal highlight area
+ * when highlight is off. */
+ XColor *highlightColorPtr; /* Color for drawing traversal highlight. */
+ int inset; /* Total width of all borders, including
+ * traversal highlight and 3-D border.
+ * Indicates how much interior stuff must be
+ * offset from outside edges to leave room for
+ * borders. */
+ Tk_Font tkfont; /* Information about text font, or NULL. */
+ XColor *fgColorPtr; /* Text color in normal mode. */
+ XColor *dfgColorPtr; /* Text color in disabled mode. */
+ GC textGC; /* For drawing normal text. */
+ Tk_3DBorder selBorder; /* Borders and backgrounds for selected
+ * elements. */
+ int selBorderWidth; /* Width of border around selection. */
+ XColor *selFgColorPtr; /* Foreground color for selected elements. */
+ GC selTextGC; /* For drawing selected text. */
+ int width; /* Desired width of window, in characters. */
+ int height; /* Desired height of window, in lines. */
+ int lineHeight; /* Number of pixels allocated for each line in
+ * display. */
+ int topIndex; /* Index of top-most element visible in
+ * window. */
+ int fullLines; /* Number of lines that are completely
+ * visible in window. There may be one
+ * additional line at the bottom that is
+ * partially visible. */
+ int partialLine; /* 0 means that the window holds exactly
+ * fullLines lines. 1 means that there is one
+ * additional line that is partially
+ * visible. */
+ int setGrid; /* Non-zero means pass gridding information to
+ * window manager. */
+
+ /*
+ * Information to support horizontal scrolling:
+ */
+
+ int maxWidth; /* Width (in pixels) of widest string in
+ * listbox. */
+ int xScrollUnit; /* Number of pixels in one "unit" for
+ * horizontal scrolling (window scrolls
+ * horizontally in increments of this size).
+ * This is an average character size. */
+ int xOffset; /* The left edge of each string in the listbox
+ * is offset to the left by this many pixels
+ * (0 means no offset, positive means there is
+ * an offset). This is x scrolling information
+ * is not linked to justification. */
+
+ /*
+ * Information about what's selected or active, if any.
+ */
+
+ Tk_Uid selectMode; /* Selection style: single, browse, multiple,
+ * or extended. This value isn't used in C
+ * code, but the Tcl bindings use it. */
+ int numSelected; /* Number of elements currently selected. */
+ int selectAnchor; /* Fixed end of selection (i.e. element at
+ * which selection was started.) */
+ int exportSelection; /* Non-zero means tie internal listbox to X
+ * selection. */
+ int active; /* Index of "active" element (the one that has
+ * been selected by keyboard traversal). -1
+ * means none. */
+ int activeStyle; /* Style in which to draw the active element.
+ * One of: underline, none, dotbox */
+
+ /*
+ * Information for scanning:
+ */
+
+ int scanMarkX; /* X-position at which scan started (e.g.
+ * button was pressed here). */
+ int scanMarkY; /* Y-position at which scan started (e.g.
+ * button was pressed here). */
+ int scanMarkXOffset; /* Value of "xOffset" field when scan
+ * started. */
+ int scanMarkYIndex; /* Index of line that was at top of window
+ * when scan started. */
+
+ /*
+ * Miscellaneous information:
+ */
+
+ Tk_Cursor cursor; /* Current cursor for window, or None. */
+ char *takeFocus; /* Value of -takefocus option; not used in the
+ * C code, but used by keyboard traversal
+ * scripts. Malloc'ed, but may be NULL. */
+ char *yScrollCmd; /* Command prefix for communicating with
+ * vertical scrollbar. NULL means no command
+ * to issue. Malloc'ed. */
+ char *xScrollCmd; /* Command prefix for communicating with
+ * horizontal scrollbar. NULL means no command
+ * to issue. Malloc'ed. */
+ int state; /* Listbox state. */
+ Pixmap gray; /* Pixmap for displaying disabled text. */
+ int flags; /* Various flag bits: see below for
+ * definitions. */
+ Tk_Justify justify; /* Justification. */
+} Listbox;
+
+/*
+ * How to encode the keys for the hash tables used to store what items are
+ * selected and what the attributes are.
+ */
+
+#define KEY(i) ((char *) INT2PTR(i))
+
+/*
+ * ItemAttr structures are used to store item configuration information for
+ * the items in a listbox
+ */
+
+typedef struct {
+ Tk_3DBorder border; /* Used for drawing background around text */
+ Tk_3DBorder selBorder; /* Used for selected text */
+ XColor *fgColor; /* Text color in normal mode. */
+ XColor *selFgColor; /* Text color in selected mode. */
+} ItemAttr;
+
+/*
+ * Flag bits for listboxes:
+ *
+ * REDRAW_PENDING: Non-zero means a DoWhenIdle handler has
+ * already been queued to redraw this window.
+ * UPDATE_V_SCROLLBAR: Non-zero means vertical scrollbar needs to be
+ * updated.
+ * UPDATE_H_SCROLLBAR: Non-zero means horizontal scrollbar needs to
+ * be updated.
+ * GOT_FOCUS: Non-zero means this widget currently has the
+ * input focus.
+ * MAXWIDTH_IS_STALE: Stored maxWidth may be out-of-date.
+ * LISTBOX_DELETED: This listbox has been effectively destroyed.
+ */
+
+#define REDRAW_PENDING 1
+#define UPDATE_V_SCROLLBAR 2
+#define UPDATE_H_SCROLLBAR 4
+#define GOT_FOCUS 8
+#define MAXWIDTH_IS_STALE 16
+#define LISTBOX_DELETED 32
+
+/*
+ * The following enum is used to define a type for the -state option of the
+ * Listbox widget. These values are used as indices into the string table
+ * below.
+ */
+
+enum state {
+ STATE_DISABLED, STATE_NORMAL
+};
+
+static const char *const stateStrings[] = {
+ "disabled", "normal", NULL
+};
+
+enum activeStyle {
+ ACTIVE_STYLE_DOTBOX, ACTIVE_STYLE_NONE, ACTIVE_STYLE_UNDERLINE
+};
+
+static const char *const activeStyleStrings[] = {
+ "dotbox", "none", "underline", NULL
+};
+
+/*
+ * The optionSpecs table defines the valid configuration options for the
+ * listbox widget.
+ */
+
+static const Tk_OptionSpec optionSpecs[] = {
+ {TK_OPTION_STRING_TABLE, "-activestyle", "activeStyle", "ActiveStyle",
+ DEF_LISTBOX_ACTIVE_STYLE, -1, Tk_Offset(Listbox, activeStyle),
+ 0, activeStyleStrings, 0},
+ {TK_OPTION_BORDER, "-background", "background", "Background",
+ DEF_LISTBOX_BG_COLOR, -1, Tk_Offset(Listbox, normalBorder),
+ 0, DEF_LISTBOX_BG_MONO, 0},
+ {TK_OPTION_SYNONYM, "-bd", NULL, NULL,
+ NULL, 0, -1, 0, "-borderwidth", 0},
+ {TK_OPTION_SYNONYM, "-bg", NULL, NULL,
+ NULL, 0, -1, 0, "-background", 0},
+ {TK_OPTION_PIXELS, "-borderwidth", "borderWidth", "BorderWidth",
+ DEF_LISTBOX_BORDER_WIDTH, -1, Tk_Offset(Listbox, borderWidth),
+ 0, 0, 0},
+ {TK_OPTION_CURSOR, "-cursor", "cursor", "Cursor",
+ DEF_LISTBOX_CURSOR, -1, Tk_Offset(Listbox, cursor),
+ TK_OPTION_NULL_OK, 0, 0},
+ {TK_OPTION_COLOR, "-disabledforeground", "disabledForeground",
+ "DisabledForeground", DEF_LISTBOX_DISABLED_FG, -1,
+ Tk_Offset(Listbox, dfgColorPtr), TK_OPTION_NULL_OK, 0, 0},
+ {TK_OPTION_BOOLEAN, "-exportselection", "exportSelection",
+ "ExportSelection", DEF_LISTBOX_EXPORT_SELECTION, -1,
+ Tk_Offset(Listbox, exportSelection), 0, 0, 0},
+ {TK_OPTION_SYNONYM, "-fg", "foreground", NULL,
+ NULL, 0, -1, 0, "-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_JUSTIFY, "-justify", "justify", "Justify",
+ DEF_LISTBOX_JUSTIFY, -1, Tk_Offset(Listbox, justify), 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, 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),
+ TK_OPTION_NULL_OK, DEF_LISTBOX_SELECT_FG_MONO, 0},
+ {TK_OPTION_STRING, "-selectmode", "selectMode", "SelectMode",
+ DEF_LISTBOX_SELECT_MODE, -1, Tk_Offset(Listbox, selectMode),
+ TK_OPTION_NULL_OK, 0, 0},
+ {TK_OPTION_BOOLEAN, "-setgrid", "setGrid", "SetGrid",
+ DEF_LISTBOX_SET_GRID, -1, Tk_Offset(Listbox, setGrid), 0, 0, 0},
+ {TK_OPTION_STRING_TABLE, "-state", "state", "State",
+ DEF_LISTBOX_STATE, -1, Tk_Offset(Listbox, state),
+ 0, stateStrings, 0},
+ {TK_OPTION_STRING, "-takefocus", "takeFocus", "TakeFocus",
+ DEF_LISTBOX_TAKE_FOCUS, -1, Tk_Offset(Listbox, takeFocus),
+ TK_OPTION_NULL_OK, 0, 0},
+ {TK_OPTION_INT, "-width", "width", "Width",
+ DEF_LISTBOX_WIDTH, -1, Tk_Offset(Listbox, width), 0, 0, 0},
+ {TK_OPTION_STRING, "-xscrollcommand", "xScrollCommand", "ScrollCommand",
+ DEF_LISTBOX_SCROLL_COMMAND, -1, Tk_Offset(Listbox, xScrollCmd),
+ TK_OPTION_NULL_OK, 0, 0},
+ {TK_OPTION_STRING, "-yscrollcommand", "yScrollCommand", "ScrollCommand",
+ DEF_LISTBOX_SCROLL_COMMAND, -1, Tk_Offset(Listbox, yScrollCmd),
+ TK_OPTION_NULL_OK, 0, 0},
+ {TK_OPTION_STRING, "-listvariable", "listVariable", "Variable",
+ DEF_LISTBOX_LIST_VARIABLE, -1, Tk_Offset(Listbox, listVarName),
+ TK_OPTION_NULL_OK, 0, 0},
+ {TK_OPTION_END, NULL, NULL, NULL, NULL, 0, -1, 0, 0, 0}
+};
+
+/*
+ * The itemAttrOptionSpecs table defines the valid configuration options for
+ * listbox items.
+ */
+
+static const Tk_OptionSpec itemAttrOptionSpecs[] = {
+ {TK_OPTION_BORDER, "-background", "background", "Background",
+ NULL, -1, Tk_Offset(ItemAttr, border),
+ TK_OPTION_NULL_OK|TK_OPTION_DONT_SET_DEFAULT,
+ DEF_LISTBOX_BG_MONO, 0},
+ {TK_OPTION_SYNONYM, "-bg", NULL, NULL,
+ NULL, 0, -1, 0, "-background", 0},
+ {TK_OPTION_SYNONYM, "-fg", "foreground", NULL,
+ NULL, 0, -1, 0, "-foreground", 0},
+ {TK_OPTION_COLOR, "-foreground", "foreground", "Foreground",
+ NULL, -1, Tk_Offset(ItemAttr, fgColor),
+ TK_OPTION_NULL_OK|TK_OPTION_DONT_SET_DEFAULT, 0, 0},
+ {TK_OPTION_BORDER, "-selectbackground", "selectBackground", "Foreground",
+ NULL, -1, Tk_Offset(ItemAttr, selBorder),
+ TK_OPTION_NULL_OK|TK_OPTION_DONT_SET_DEFAULT,
+ DEF_LISTBOX_SELECT_MONO, 0},
+ {TK_OPTION_COLOR, "-selectforeground", "selectForeground", "Background",
+ NULL, -1, Tk_Offset(ItemAttr, selFgColor),
+ TK_OPTION_NULL_OK|TK_OPTION_DONT_SET_DEFAULT,
+ DEF_LISTBOX_SELECT_FG_MONO, 0},
+ {TK_OPTION_END, NULL, NULL, NULL, NULL, 0, -1, 0, 0, 0}
+};
+
+/*
+ * The following tables define the listbox widget commands (and sub-commands)
+ * and map the indexes into the string tables into enumerated types used to
+ * dispatch the listbox widget command.
+ */
+
+static const char *const commandNames[] = {
+ "activate", "bbox", "cget", "configure", "curselection", "delete", "get",
+ "index", "insert", "itemcget", "itemconfigure", "nearest", "scan",
+ "see", "selection", "size", "xview", "yview", NULL
+};
+enum command {
+ COMMAND_ACTIVATE, COMMAND_BBOX, COMMAND_CGET, COMMAND_CONFIGURE,
+ COMMAND_CURSELECTION, COMMAND_DELETE, COMMAND_GET, COMMAND_INDEX,
+ COMMAND_INSERT, COMMAND_ITEMCGET, COMMAND_ITEMCONFIGURE,
+ COMMAND_NEAREST, COMMAND_SCAN, COMMAND_SEE, COMMAND_SELECTION,
+ COMMAND_SIZE, COMMAND_XVIEW, COMMAND_YVIEW
+};
+
+static const char *const selCommandNames[] = {
+ "anchor", "clear", "includes", "set", NULL
+};
+enum selcommand {
+ SELECTION_ANCHOR, SELECTION_CLEAR, SELECTION_INCLUDES, SELECTION_SET
+};
+
+static const char *const scanCommandNames[] = {
+ "mark", "dragto", NULL
+};
+enum scancommand {
+ SCAN_MARK, SCAN_DRAGTO
+};
+
+static const char *const indexNames[] = {
+ "active", "anchor", "end", NULL
+};
+enum indices {
+ INDEX_ACTIVE, INDEX_ANCHOR, INDEX_END
+};
+
+/*
+ * Declarations for procedures defined later in this file.
+ */
+
+static void ChangeListboxOffset(Listbox *listPtr, int offset);
+static void ChangeListboxView(Listbox *listPtr, int index);
+static int ConfigureListbox(Tcl_Interp *interp, Listbox *listPtr,
+ int objc, Tcl_Obj *const objv[]);
+static int ConfigureListboxItem(Tcl_Interp *interp,
+ Listbox *listPtr, ItemAttr *attrs, int objc,
+ Tcl_Obj *const objv[], int index);
+static int ListboxDeleteSubCmd(Listbox *listPtr,
+ int first, int last);
+static void DestroyListbox(void *memPtr);
+static void DestroyListboxOptionTables(ClientData clientData,
+ Tcl_Interp *interp);
+static void DisplayListbox(ClientData clientData);
+static int GetListboxIndex(Tcl_Interp *interp, Listbox *listPtr,
+ Tcl_Obj *index, int endIsSize, int *indexPtr);
+static int ListboxInsertSubCmd(Listbox *listPtr,
+ int index, int objc, Tcl_Obj *const objv[]);
+static void ListboxCmdDeletedProc(ClientData clientData);
+static void ListboxComputeGeometry(Listbox *listPtr,
+ int fontChanged, int maxIsStale, int updateGrid);
+static void ListboxEventProc(ClientData clientData,
+ XEvent *eventPtr);
+static int ListboxFetchSelection(ClientData clientData,
+ int offset, char *buffer, int maxBytes);
+static void ListboxLostSelection(ClientData clientData);
+static void GenerateListboxSelectEvent(Listbox *listPtr);
+static void EventuallyRedrawRange(Listbox *listPtr,
+ int first, int last);
+static void ListboxScanTo(Listbox *listPtr, int x, int y);
+static int ListboxSelect(Listbox *listPtr,
+ int first, int last, int select);
+static void ListboxUpdateHScrollbar(Listbox *listPtr);
+static void ListboxUpdateVScrollbar(Listbox *listPtr);
+static int ListboxWidgetObjCmd(ClientData clientData,
+ Tcl_Interp *interp, int objc,
+ Tcl_Obj *const objv[]);
+static int ListboxBboxSubCmd(Tcl_Interp *interp,
+ Listbox *listPtr, int index);
+static int ListboxSelectionSubCmd(Tcl_Interp *interp,
+ Listbox *listPtr, int objc, Tcl_Obj *const objv[]);
+static int ListboxXviewSubCmd(Tcl_Interp *interp,
+ Listbox *listPtr, int objc, Tcl_Obj *const objv[]);
+static int ListboxYviewSubCmd(Tcl_Interp *interp,
+ Listbox *listPtr, int objc, Tcl_Obj *const objv[]);
+static ItemAttr * ListboxGetItemAttributes(Tcl_Interp *interp,
+ Listbox *listPtr, int index);
+static void ListboxWorldChanged(ClientData instanceData);
+static int NearestListboxElement(Listbox *listPtr, int y);
+static char * ListboxListVarProc(ClientData clientData,
+ Tcl_Interp *interp, const char *name1,
+ const char *name2, int flags);
+static void MigrateHashEntries(Tcl_HashTable *table,
+ int first, int last, int offset);
+static int GetMaxOffset(Listbox *listPtr);
+
+/*
+ * The structure below defines button class behavior by means of procedures
+ * that can be invoked from generic window code.
+ */
+
+static const Tk_ClassProcs listboxClass = {
+ sizeof(Tk_ClassProcs), /* size */
+ ListboxWorldChanged, /* worldChangedProc */
+ NULL, /* createProc */
+ NULL /* modalProc */
+};
+
+/*
+ *--------------------------------------------------------------
+ *
+ * Tk_ListboxObjCmd --
+ *
+ * This procedure is invoked to process the "listbox" Tcl command. See
+ * the user documentation for details on what it does.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * See the user documentation.
+ *
+ *--------------------------------------------------------------
+ */
+
+int
+Tk_ListboxObjCmd(
+ ClientData clientData, /* NULL. */
+ Tcl_Interp *interp, /* Current interpreter. */
+ int objc, /* Number of arguments. */
+ Tcl_Obj *const objv[]) /* Argument objects. */
+{
+ register Listbox *listPtr;
+ Tk_Window tkwin;
+ ListboxOptionTables *optionTables;
+
+ if (objc < 2) {
+ Tcl_WrongNumArgs(interp, 1, objv, "pathName ?-option value ...?");
+ return TCL_ERROR;
+ }
+
+ tkwin = Tk_CreateWindowFromPath(interp, Tk_MainWindow(interp),
+ Tcl_GetString(objv[1]), NULL);
+ if (tkwin == NULL) {
+ return TCL_ERROR;
+ }
+
+ optionTables = Tcl_GetAssocData(interp, "ListboxOptionTables", NULL);
+ if (optionTables == NULL) {
+ /*
+ * We haven't created the option tables for this widget class yet. Do
+ * it now and save the a pointer to them as the ClientData for the
+ * command, so future invocations will have access to it.
+ */
+
+ optionTables = ckalloc(sizeof(ListboxOptionTables));
+
+ /*
+ * Set up an exit handler to free the optionTables struct.
+ */
+
+ Tcl_SetAssocData(interp, "ListboxOptionTables",
+ DestroyListboxOptionTables, optionTables);
+
+ /*
+ * Create the listbox option table and the listbox item option table.
+ */
+
+ optionTables->listboxOptionTable =
+ Tk_CreateOptionTable(interp, optionSpecs);
+ optionTables->itemAttrOptionTable =
+ Tk_CreateOptionTable(interp, itemAttrOptionSpecs);
+ }
+
+ /*
+ * Initialize the fields of the structure that won't be initialized by
+ * ConfigureListbox, or that ConfigureListbox requires to be initialized
+ * already (e.g. resource pointers).
+ */
+
+ listPtr = ckalloc(sizeof(Listbox));
+ memset(listPtr, 0, sizeof(Listbox));
+
+ listPtr->tkwin = tkwin;
+ listPtr->display = Tk_Display(tkwin);
+ listPtr->interp = interp;
+ listPtr->widgetCmd = Tcl_CreateObjCommand(interp,
+ Tk_PathName(listPtr->tkwin), ListboxWidgetObjCmd, listPtr,
+ ListboxCmdDeletedProc);
+ listPtr->optionTable = optionTables->listboxOptionTable;
+ listPtr->itemAttrOptionTable = optionTables->itemAttrOptionTable;
+ listPtr->selection = ckalloc(sizeof(Tcl_HashTable));
+ Tcl_InitHashTable(listPtr->selection, TCL_ONE_WORD_KEYS);
+ listPtr->itemAttrTable = ckalloc(sizeof(Tcl_HashTable));
+ Tcl_InitHashTable(listPtr->itemAttrTable, TCL_ONE_WORD_KEYS);
+ listPtr->relief = TK_RELIEF_RAISED;
+ listPtr->textGC = None;
+ listPtr->selFgColorPtr = None;
+ listPtr->selTextGC = None;
+ listPtr->fullLines = 1;
+ listPtr->xScrollUnit = 1;
+ listPtr->exportSelection = 1;
+ listPtr->cursor = None;
+ listPtr->state = STATE_NORMAL;
+ listPtr->gray = None;
+ listPtr->justify = TK_JUSTIFY_LEFT;
+
+ /*
+ * Keep a hold of the associated tkwin until we destroy the listbox,
+ * otherwise Tk might free it while we still need it.
+ */
+
+ Tcl_Preserve(listPtr->tkwin);
+
+ Tk_SetClass(listPtr->tkwin, "Listbox");
+ Tk_SetClassProcs(listPtr->tkwin, &listboxClass, listPtr);
+ Tk_CreateEventHandler(listPtr->tkwin,
+ ExposureMask|StructureNotifyMask|FocusChangeMask,
+ ListboxEventProc, listPtr);
+ Tk_CreateSelHandler(listPtr->tkwin, XA_PRIMARY, XA_STRING,
+ ListboxFetchSelection, listPtr, XA_STRING);
+ if (Tk_InitOptions(interp, (char *)listPtr,
+ optionTables->listboxOptionTable, tkwin) != TCL_OK) {
+ Tk_DestroyWindow(listPtr->tkwin);
+ return TCL_ERROR;
+ }
+
+ if (ConfigureListbox(interp, listPtr, objc-2, objv+2) != TCL_OK) {
+ Tk_DestroyWindow(listPtr->tkwin);
+ return TCL_ERROR;
+ }
+
+ Tcl_SetObjResult(interp, TkNewWindowObj(listPtr->tkwin));
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ListboxWidgetObjCmd --
+ *
+ * This Tcl_Obj based procedure is invoked to process the Tcl command
+ * that corresponds to a widget managed by this module. See the user
+ * documentation for details on what it does.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * See the user documentation.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+ListboxWidgetObjCmd(
+ ClientData clientData, /* Information about listbox widget. */
+ Tcl_Interp *interp, /* Current interpreter. */
+ int objc, /* Number of arguments. */
+ Tcl_Obj *const objv[]) /* Arguments as Tcl_Obj's. */
+{
+ register Listbox *listPtr = clientData;
+ int cmdIndex, index;
+ int result = TCL_OK;
+ Tcl_Obj *objPtr;
+
+ if (objc < 2) {
+ Tcl_WrongNumArgs(interp, 1, objv, "option ?arg ...?");
+ return TCL_ERROR;
+ }
+
+ /*
+ * Parse the command by looking up the second argument in the list of
+ * valid subcommand names.
+ */
+
+ result = Tcl_GetIndexFromObj(interp, objv[1], commandNames,
+ "option", 0, &cmdIndex);
+ if (result != TCL_OK) {
+ return result;
+ }
+
+ Tcl_Preserve(listPtr);
+
+ /*
+ * The subcommand was valid, so continue processing.
+ */
+
+ switch (cmdIndex) {
+ case COMMAND_ACTIVATE:
+ if (objc != 3) {
+ Tcl_WrongNumArgs(interp, 2, objv, "index");
+ result = TCL_ERROR;
+ break;
+ }
+ result = GetListboxIndex(interp, listPtr, objv[2], 0, &index);
+ if (result != TCL_OK) {
+ break;
+ }
+
+ if (!(listPtr->state & STATE_NORMAL)) {
+ break;
+ }
+
+ if (index >= listPtr->nElements) {
+ index = listPtr->nElements-1;
+ }
+ if (index < 0) {
+ index = 0;
+ }
+ listPtr->active = index;
+ EventuallyRedrawRange(listPtr, listPtr->active, listPtr->active);
+ result = TCL_OK;
+ break;
+
+ case COMMAND_BBOX:
+ if (objc != 3) {
+ Tcl_WrongNumArgs(interp, 2, objv, "index");
+ result = TCL_ERROR;
+ break;
+ }
+ result = GetListboxIndex(interp, listPtr, objv[2], 0, &index);
+ if (result != TCL_OK) {
+ break;
+ }
+
+ result = ListboxBboxSubCmd(interp, listPtr, index);
+ break;
+
+ case COMMAND_CGET:
+ 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:
+ if (objc <= 3) {
+ objPtr = Tk_GetOptionInfo(interp, (char *) listPtr,
+ listPtr->optionTable,
+ (objc == 3) ? objv[2] : NULL, listPtr->tkwin);
+ if (objPtr == NULL) {
+ result = TCL_ERROR;
+ break;
+ }
+ Tcl_SetObjResult(interp, objPtr);
+ result = TCL_OK;
+ } else {
+ result = ConfigureListbox(interp, listPtr, objc-2, objv+2);
+ }
+ break;
+
+ case COMMAND_CURSELECTION: {
+ 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.
+ */
+
+ objPtr = Tcl_NewObj();
+ for (i = 0; i < listPtr->nElements; i++) {
+ if (Tcl_FindHashEntry(listPtr->selection, KEY(i))) {
+ Tcl_ListObjAppendElement(NULL, objPtr, Tcl_NewIntObj(i));
+ }
+ }
+ Tcl_SetObjResult(interp, objPtr);
+ result = TCL_OK;
+ break;
+ }
+
+ case COMMAND_DELETE: {
+ int first, last;
+
+ if ((objc < 3) || (objc > 4)) {
+ Tcl_WrongNumArgs(interp, 2, objv, "firstIndex ?lastIndex?");
+ result = TCL_ERROR;
+ break;
+ }
+
+ result = GetListboxIndex(interp, listPtr, objv[2], 0, &first);
+ if (result != TCL_OK) {
+ break;
+ }
+
+ if (!(listPtr->state & STATE_NORMAL)) {
+ break;
+ }
+
+ if (first < listPtr->nElements) {
+ /*
+ * if a "last index" was given, get it now; otherwise, use the
+ * first index as the last index.
+ */
+
+ if (objc == 4) {
+ result = GetListboxIndex(interp, listPtr, objv[3], 0, &last);
+ if (result != TCL_OK) {
+ break;
+ }
+ } else {
+ last = first;
+ }
+ if (last >= listPtr->nElements) {
+ last = listPtr->nElements - 1;
+ }
+ result = ListboxDeleteSubCmd(listPtr, first, last);
+ } else {
+ result = TCL_OK;
+ }
+ break;
+ }
+
+ case COMMAND_GET: {
+ int first, last, listLen;
+ Tcl_Obj **elemPtrs;
+
+ 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_SetObjResult(interp,
+ Tcl_NewListObj(last-first+1, elemPtrs+first));
+ }
+ result = TCL_OK;
+ break;
+ }
+
+ case COMMAND_INDEX:
+ 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;
+ }
+ Tcl_SetObjResult(interp, Tcl_NewIntObj(index));
+ result = TCL_OK;
+ break;
+
+ case COMMAND_INSERT:
+ if (objc < 3) {
+ Tcl_WrongNumArgs(interp, 2, objv, "index ?element ...?");
+ result = TCL_ERROR;
+ break;
+ }
+
+ result = GetListboxIndex(interp, listPtr, objv[2], 1, &index);
+ if (result != TCL_OK) {
+ break;
+ }
+
+ if (!(listPtr->state & STATE_NORMAL)) {
+ break;
+ }
+
+ result = ListboxInsertSubCmd(listPtr, index, objc-3, objv+3);
+ break;
+
+ case COMMAND_ITEMCGET: {
+ 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_SetObjResult(interp, Tcl_ObjPrintf(
+ "item number \"%s\" out of range",
+ Tcl_GetString(objv[2])));
+ Tcl_SetErrorCode(interp, "TK", "LISTBOX", "ITEM_INDEX", 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: {
+ 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_SetObjResult(interp, Tcl_ObjPrintf(
+ "item number \"%s\" out of range",
+ Tcl_GetString(objv[2])));
+ Tcl_SetErrorCode(interp, "TK", "LISTBOX", "ITEM_INDEX", 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] : NULL, listPtr->tkwin);
+ if (objPtr == NULL) {
+ result = TCL_ERROR;
+ break;
+ }
+ Tcl_SetObjResult(interp, objPtr);
+ result = TCL_OK;
+ } else {
+ result = ConfigureListboxItem(interp, listPtr, attrPtr,
+ objc-3, objv+3, index);
+ }
+ break;
+ }
+
+ case COMMAND_NEAREST: {
+ 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);
+ Tcl_SetObjResult(interp, Tcl_NewIntObj(index));
+ result = TCL_OK;
+ break;
+ }
+
+ case COMMAND_SCAN: {
+ int x, y, scanCmdIndex;
+
+ if (objc != 5) {
+ Tcl_WrongNumArgs(interp, 2, objv, "mark|dragto x y");
+ result = TCL_ERROR;
+ break;
+ }
+
+ if (Tcl_GetIntFromObj(interp, objv[3], &x) != TCL_OK
+ || Tcl_GetIntFromObj(interp, objv[4], &y) != TCL_OK) {
+ result = TCL_ERROR;
+ break;
+ }
+
+ result = Tcl_GetIndexFromObj(interp, objv[2], scanCommandNames,
+ "option", 0, &scanCmdIndex);
+ if (result != TCL_OK) {
+ break;
+ }
+ switch (scanCmdIndex) {
+ case SCAN_MARK:
+ listPtr->scanMarkX = x;
+ listPtr->scanMarkY = y;
+ listPtr->scanMarkXOffset = listPtr->xOffset;
+ listPtr->scanMarkYIndex = listPtr->topIndex;
+ break;
+ case SCAN_DRAGTO:
+ ListboxScanTo(listPtr, x, y);
+ break;
+ }
+ result = TCL_OK;
+ break;
+ }
+
+ case COMMAND_SEE: {
+ int diff;
+
+ if (objc != 3) {
+ Tcl_WrongNumArgs(interp, 2, objv, "index");
+ result = TCL_ERROR;
+ break;
+ }
+ result = GetListboxIndex(interp, listPtr, objv[2], 0, &index);
+ if (result != TCL_OK) {
+ break;
+ }
+ if (index >= listPtr->nElements) {
+ index = listPtr->nElements - 1;
+ }
+ if (index < 0) {
+ index = 0;
+ }
+ diff = listPtr->topIndex - index;
+ if (diff > 0) {
+ if (diff <= listPtr->fullLines / 3) {
+ ChangeListboxView(listPtr, index);
+ } else {
+ ChangeListboxView(listPtr, index - (listPtr->fullLines-1)/2);
+ }
+ } else {
+ diff = index - (listPtr->topIndex + listPtr->fullLines - 1);
+ if (diff > 0) {
+ if (diff <= listPtr->fullLines / 3) {
+ ChangeListboxView(listPtr, listPtr->topIndex + diff);
+ } else {
+ ChangeListboxView(listPtr, index-(listPtr->fullLines-1)/2);
+ }
+ }
+ }
+ result = TCL_OK;
+ break;
+ }
+
+ case COMMAND_SELECTION:
+ result = ListboxSelectionSubCmd(interp, listPtr, objc, objv);
+ break;
+ case COMMAND_SIZE:
+ if (objc != 2) {
+ Tcl_WrongNumArgs(interp, 2, objv, NULL);
+ result = TCL_ERROR;
+ break;
+ }
+ Tcl_SetObjResult(interp, Tcl_NewIntObj(listPtr->nElements));
+ result = TCL_OK;
+ break;
+ case COMMAND_XVIEW:
+ result = ListboxXviewSubCmd(interp, listPtr, objc, objv);
+ break;
+ case COMMAND_YVIEW:
+ result = ListboxYviewSubCmd(interp, listPtr, objc, objv);
+ break;
+ }
+ Tcl_Release(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(
+ 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 */
+{
+ register Tk_Window tkwin = listPtr->tkwin;
+ 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)) {
+ Tcl_Obj *el, *results[4];
+ const 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);
+
+ if (listPtr->justify == TK_JUSTIFY_LEFT) {
+ x = (listPtr->inset + listPtr->selBorderWidth) - listPtr->xOffset;
+ } else if (listPtr->justify == TK_JUSTIFY_RIGHT) {
+ x = Tk_Width(tkwin) - (listPtr->inset + listPtr->selBorderWidth)
+ - pixelWidth - listPtr->xOffset + GetMaxOffset(listPtr);
+ } else {
+ x = (Tk_Width(tkwin) - pixelWidth)/2
+ - listPtr->xOffset + GetMaxOffset(listPtr)/2;
+ }
+ y = ((index - listPtr->topIndex)*listPtr->lineHeight)
+ + listPtr->inset + listPtr->selBorderWidth;
+ results[0] = Tcl_NewIntObj(x);
+ results[1] = Tcl_NewIntObj(y);
+ results[2] = Tcl_NewIntObj(pixelWidth);
+ results[3] = Tcl_NewIntObj(fm.linespace);
+ Tcl_SetObjResult(interp, Tcl_NewListObj(4, results));
+ }
+ 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(
+ 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;
+ }
+
+ /*
+ * Only allow 'selection includes' to respond if disabled. [Bug #632514]
+ */
+
+ if ((listPtr->state == STATE_DISABLED)
+ && (selCmdIndex != SELECTION_INCLUDES)) {
+ return TCL_OK;
+ }
+
+ switch (selCmdIndex) {
+ case SELECTION_ANCHOR:
+ if (objc != 4) {
+ Tcl_WrongNumArgs(interp, 3, objv, "index");
+ return TCL_ERROR;
+ }
+ if (first >= listPtr->nElements) {
+ first = listPtr->nElements - 1;
+ }
+ if (first < 0) {
+ first = 0;
+ }
+ listPtr->selectAnchor = first;
+ result = TCL_OK;
+ break;
+ case SELECTION_CLEAR:
+ result = ListboxSelect(listPtr, first, last, 0);
+ break;
+ case SELECTION_INCLUDES:
+ if (objc != 4) {
+ Tcl_WrongNumArgs(interp, 3, objv, "index");
+ return TCL_ERROR;
+ }
+ Tcl_SetObjResult(interp, Tcl_NewBooleanObj(
+ Tcl_FindHashEntry(listPtr->selection, KEY(first)) != NULL));
+ 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(
+ 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, windowWidth, windowUnits;
+ int offset = 0; /* Initialized to stop gcc warnings. */
+ double fraction;
+
+ windowWidth = Tk_Width(listPtr->tkwin)
+ - 2*(listPtr->inset + listPtr->selBorderWidth);
+ if (objc == 2) {
+ Tcl_Obj *results[2];
+
+ if (listPtr->maxWidth == 0) {
+ results[0] = Tcl_NewDoubleObj(0.0);
+ results[1] = Tcl_NewDoubleObj(1.0);
+ } else {
+ double fraction2;
+
+ fraction = listPtr->xOffset / (double) listPtr->maxWidth;
+ fraction2 = (listPtr->xOffset + windowWidth)
+ / (double) listPtr->maxWidth;
+ if (fraction2 > 1.0) {
+ fraction2 = 1.0;
+ }
+ results[0] = Tcl_NewDoubleObj(fraction);
+ results[1] = Tcl_NewDoubleObj(fraction2);
+ }
+ Tcl_SetObjResult(interp, Tcl_NewListObj(2, results));
+ } else if (objc == 3) {
+ if (Tcl_GetIntFromObj(interp, objv[2], &index) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ ChangeListboxOffset(listPtr, index*listPtr->xScrollUnit);
+ } else {
+ switch (Tk_GetScrollInfoObj(interp, objc, objv, &fraction, &count)) {
+ case TK_SCROLL_ERROR:
+ return TCL_ERROR;
+ case TK_SCROLL_MOVETO:
+ offset = (int) (fraction*listPtr->maxWidth + 0.5);
+ break;
+ case TK_SCROLL_PAGES:
+ windowUnits = windowWidth / listPtr->xScrollUnit;
+ if (windowUnits > 2) {
+ offset = listPtr->xOffset
+ + count*listPtr->xScrollUnit*(windowUnits-2);
+ } else {
+ offset = listPtr->xOffset + count*listPtr->xScrollUnit;
+ }
+ break;
+ case TK_SCROLL_UNITS:
+ offset = listPtr->xOffset + count*listPtr->xScrollUnit;
+ break;
+ }
+ ChangeListboxOffset(listPtr, offset);
+ }
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ListboxYviewSubCmd --
+ *
+ * Process the listbox "yview" subcommand.
+ *
+ * Results:
+ * Standard Tcl result.
+ *
+ * Side effects:
+ * May change the listbox viewing area; may set the interpreter's result.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+ListboxYviewSubCmd(
+ 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;
+ double fraction;
+
+ if (objc == 2) {
+ Tcl_Obj *results[2];
+
+ if (listPtr->nElements == 0) {
+ results[0] = Tcl_NewDoubleObj(0.0);
+ results[1] = Tcl_NewDoubleObj(1.0);
+ } else {
+ double fraction2, numEls = (double) listPtr->nElements;
+
+ fraction = listPtr->topIndex / numEls;
+ fraction2 = (listPtr->topIndex+listPtr->fullLines) / numEls;
+ if (fraction2 > 1.0) {
+ fraction2 = 1.0;
+ }
+ results[0] = Tcl_NewDoubleObj(fraction);
+ results[1] = Tcl_NewDoubleObj(fraction2);
+ }
+ Tcl_SetObjResult(interp, Tcl_NewListObj(2, results));
+ } else if (objc == 3) {
+ if (GetListboxIndex(interp, listPtr, objv[2], 0, &index) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ ChangeListboxView(listPtr, index);
+ } else {
+ switch (Tk_GetScrollInfoObj(interp, objc, objv, &fraction, &count)) {
+ 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;
+ case TK_SCROLL_ERROR:
+ default:
+ return TCL_ERROR;
+ }
+ ChangeListboxView(listPtr, index);
+ }
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ListboxGetItemAttributes --
+ *
+ * Returns a pointer to the ItemAttr record for a given index, creating
+ * one if it does not already exist.
+ *
+ * Results:
+ * Pointer to an ItemAttr record.
+ *
+ * Side effects:
+ * Memory may be allocated for the ItemAttr record.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static ItemAttr *
+ListboxGetItemAttributes(
+ 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 isNew;
+ Tcl_HashEntry *entry;
+ ItemAttr *attrs;
+
+ entry = Tcl_CreateHashEntry(listPtr->itemAttrTable, KEY(index), &isNew);
+ if (isNew) {
+ attrs = 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, attrs);
+ } else {
+ attrs = Tcl_GetHashValue(entry);
+ }
+ return attrs;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * DestroyListbox --
+ *
+ * This procedure is invoked by Tcl_EventuallyFree or Tcl_Release to
+ * clean up the internal structure of a listbox at a safe time (when
+ * no-one is using it anymore).
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Everything associated with the listbox is freed up.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+DestroyListbox(
+ void *memPtr) /* Info about listbox widget. */
+{
+ register Listbox *listPtr = memPtr;
+ Tcl_HashEntry *entry;
+ Tcl_HashSearch search;
+
+ /*
+ * If we have an internal list object, free it.
+ */
+
+ if (listPtr->listObj != NULL) {
+ Tcl_DecrRefCount(listPtr->listObj);
+ listPtr->listObj = NULL;
+ }
+
+ if (listPtr->listVarName != NULL) {
+ Tcl_UntraceVar2(listPtr->interp, listPtr->listVarName, NULL,
+ TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS,
+ ListboxListVarProc, listPtr);
+ }
+
+ /*
+ * Free the selection hash table.
+ */
+
+ Tcl_DeleteHashTable(listPtr->selection);
+ ckfree(listPtr->selection);
+
+ /*
+ * Free the item attribute hash table.
+ */
+
+ for (entry = Tcl_FirstHashEntry(listPtr->itemAttrTable, &search);
+ entry != NULL; entry = Tcl_NextHashEntry(&search)) {
+ ckfree(Tcl_GetHashValue(entry));
+ }
+ Tcl_DeleteHashTable(listPtr->itemAttrTable);
+ ckfree(listPtr->itemAttrTable);
+
+ /*
+ * Free up all the stuff that requires special handling, then let
+ * Tk_FreeOptions handle all the standard option-related stuff.
+ */
+
+ if (listPtr->textGC != None) {
+ Tk_FreeGC(listPtr->display, listPtr->textGC);
+ }
+ if (listPtr->selTextGC != None) {
+ Tk_FreeGC(listPtr->display, listPtr->selTextGC);
+ }
+ if (listPtr->gray != None) {
+ Tk_FreeBitmap(Tk_Display(listPtr->tkwin), listPtr->gray);
+ }
+
+ Tk_FreeConfigOptions((char *) listPtr, listPtr->optionTable,
+ listPtr->tkwin);
+ Tcl_Release(listPtr->tkwin);
+ listPtr->tkwin = NULL;
+ ckfree(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 clientData, /* Pointer to the OptionTables struct */
+ Tcl_Interp *interp) /* Pointer to the calling interp */
+{
+ ckfree(clientData);
+ return;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ConfigureListbox --
+ *
+ * This procedure is called to process an objv/objc list, plus the Tk
+ * option database, in order to configure (or reconfigure) a listbox
+ * widget.
+ *
+ * Results:
+ * The return value is a standard Tcl result. If TCL_ERROR is returned,
+ * then the interp's result contains an error message.
+ *
+ * Side effects:
+ * Configuration information, such as colors, border width, etc. get set
+ * for listPtr; old resources get freed, if there were any.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+ConfigureListbox(
+ Tcl_Interp *interp, /* Used for error reporting. */
+ register Listbox *listPtr, /* Information about widget; may or may not
+ * already have values for some fields. */
+ int objc, /* Number of valid entries in argv. */
+ Tcl_Obj *const objv[]) /* Arguments. */
+{
+ Tk_SavedOptions savedOptions;
+ Tcl_Obj *oldListObj = NULL;
+ Tcl_Obj *errorResult = NULL;
+ int oldExport, error;
+
+ oldExport = listPtr->exportSelection;
+ if (listPtr->listVarName != NULL) {
+ Tcl_UntraceVar2(interp, listPtr->listVarName, NULL,
+ TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS,
+ ListboxListVarProc, listPtr);
+ }
+
+ for (error = 0; error <= 1; error++) {
+ if (!error) {
+ /*
+ * First pass: set options to new values.
+ */
+
+ if (Tk_SetOptions(interp, (char *) listPtr,
+ listPtr->optionTable, objc, objv,
+ listPtr->tkwin, &savedOptions, NULL) != TCL_OK) {
+ continue;
+ }
+ } else {
+ /*
+ * Second pass: restore options to old values.
+ */
+
+ errorResult = Tcl_GetObjResult(interp);
+ Tcl_IncrRefCount(errorResult);
+ Tk_RestoreSavedOptions(&savedOptions);
+ }
+
+ /*
+ * A few options need special processing, such as setting the
+ * background from a 3-D border.
+ */
+
+ Tk_SetBackgroundFromBorder(listPtr->tkwin, listPtr->normalBorder);
+
+ if (listPtr->highlightWidth < 0) {
+ listPtr->highlightWidth = 0;
+ }
+ listPtr->inset = listPtr->highlightWidth + listPtr->borderWidth;
+
+ /*
+ * Claim the selection if we've suddenly started exporting it and
+ * there is a selection to export.
+ */
+
+ if (listPtr->exportSelection && !oldExport
+ && (listPtr->numSelected != 0)) {
+ Tk_OwnSelection(listPtr->tkwin, XA_PRIMARY,
+ ListboxLostSelection, 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,
+ NULL, TCL_GLOBAL_ONLY);
+ int dummy;
+
+ if (listVarObj == NULL) {
+ listVarObj = (oldListObj ? oldListObj : Tcl_NewObj());
+ if (Tcl_SetVar2Ex(interp, listPtr->listVarName, NULL,
+ listVarObj, TCL_GLOBAL_ONLY|TCL_LEAVE_ERR_MSG)
+ == NULL) {
+ continue;
+ }
+ }
+
+ /*
+ * Make sure the object is a good list object.
+ */
+
+ if (Tcl_ListObjLength(listPtr->interp, listVarObj, &dummy)
+ != TCL_OK) {
+ Tcl_AppendResult(listPtr->interp,
+ ": invalid -listvariable value", NULL);
+ continue;
+ }
+
+ listPtr->listObj = listVarObj;
+ Tcl_TraceVar2(listPtr->interp, listPtr->listVarName,
+ NULL, TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS,
+ ListboxListVarProc, listPtr);
+ } else if (listPtr->listObj == NULL) {
+ listPtr->listObj = Tcl_NewObj();
+ }
+ Tcl_IncrRefCount(listPtr->listObj);
+ if (oldListObj != NULL) {
+ Tcl_DecrRefCount(oldListObj);
+ }
+ break;
+ }
+ if (!error) {
+ Tk_FreeSavedOptions(&savedOptions);
+ }
+
+ /*
+ * Make sure that the list length is correct.
+ */
+
+ Tcl_ListObjLength(listPtr->interp, listPtr->listObj, &listPtr->nElements);
+
+ if (error) {
+ Tcl_SetObjResult(interp, errorResult);
+ Tcl_DecrRefCount(errorResult);
+ return TCL_ERROR;
+ }
+ ListboxWorldChanged(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(
+ 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. */
+ int index) /* Index of the listbox item being configure */
+{
+ Tk_SavedOptions savedOptions;
+
+ if (Tk_SetOptions(interp, (char *)attrs,
+ listPtr->itemAttrOptionTable, objc, objv, listPtr->tkwin,
+ &savedOptions, NULL) != TCL_OK) {
+ Tk_RestoreSavedOptions(&savedOptions);
+ return TCL_ERROR;
+ }
+ Tk_FreeSavedOptions(&savedOptions);
+
+ /*
+ * Redraw this index - ListboxWorldChanged would need to be called if item
+ * attributes were checked in the "world".
+ */
+
+ EventuallyRedrawRange(listPtr, index, index);
+ return TCL_OK;
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * ListboxWorldChanged --
+ *
+ * This procedure is called when the world has changed in some way and
+ * the widget needs to recompute all its graphics contexts and determine
+ * its new geometry.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Listbox will be relayed out and redisplayed.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+static void
+ListboxWorldChanged(
+ ClientData instanceData) /* Information about widget. */
+{
+ XGCValues gcValues;
+ GC gc;
+ unsigned long mask;
+ Listbox *listPtr = instanceData;
+
+ if (listPtr->state & STATE_NORMAL) {
+ gcValues.foreground = listPtr->fgColorPtr->pixel;
+ gcValues.graphics_exposures = False;
+ mask = GCForeground | GCFont | GCGraphicsExposures;
+ } else if (listPtr->dfgColorPtr != NULL) {
+ gcValues.foreground = listPtr->dfgColorPtr->pixel;
+ gcValues.graphics_exposures = False;
+ mask = GCForeground | GCFont | GCGraphicsExposures;
+ } else {
+ gcValues.foreground = listPtr->fgColorPtr->pixel;
+ mask = GCForeground | GCFont;
+ if (listPtr->gray == None) {
+ listPtr->gray = Tk_GetBitmap(NULL, listPtr->tkwin, "gray50");
+ }
+ if (listPtr->gray != None) {
+ gcValues.fill_style = FillStippled;
+ gcValues.stipple = listPtr->gray;
+ mask |= GCFillStyle | GCStipple;
+ }
+ }
+
+ gcValues.font = Tk_FontId(listPtr->tkfont);
+ gc = Tk_GetGC(listPtr->tkwin, mask, &gcValues);
+ if (listPtr->textGC != None) {
+ Tk_FreeGC(listPtr->display, listPtr->textGC);
+ }
+ listPtr->textGC = gc;
+
+ if (listPtr->selFgColorPtr != NULL) {
+ gcValues.foreground = listPtr->selFgColorPtr->pixel;
+ }
+ gcValues.font = Tk_FontId(listPtr->tkfont);
+ mask = GCForeground | GCFont;
+ gc = Tk_GetGC(listPtr->tkwin, mask, &gcValues);
+ if (listPtr->selTextGC != None) {
+ Tk_FreeGC(listPtr->display, listPtr->selTextGC);
+ }
+ listPtr->selTextGC = gc;
+
+ /*
+ * Register the desired geometry for the window and arrange for the window
+ * to be redisplayed.
+ */
+
+ ListboxComputeGeometry(listPtr, 1, 1, 1);
+ listPtr->flags |= UPDATE_V_SCROLLBAR|UPDATE_H_SCROLLBAR;
+ EventuallyRedrawRange(listPtr, 0, listPtr->nElements-1);
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * DisplayListbox --
+ *
+ * This procedure redraws the contents of a listbox window.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Information appears on the screen.
+ *
+ *--------------------------------------------------------------
+ */
+
+static void
+DisplayListbox(
+ ClientData clientData) /* Information about window. */
+{
+ register Listbox *listPtr = clientData;
+ register Tk_Window tkwin = listPtr->tkwin;
+ GC gc;
+ int i, limit, x, y, prevSelected, freeGC, stringLen;
+ Tk_FontMetrics fm;
+ Tcl_Obj *curElement;
+ Tcl_HashEntry *entry;
+ const char *stringRep;
+ 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;
+ int textWidth;
+
+ listPtr->flags &= ~REDRAW_PENDING;
+ if (listPtr->flags & LISTBOX_DELETED) {
+ return;
+ }
+
+ if (listPtr->flags & MAXWIDTH_IS_STALE) {
+ ListboxComputeGeometry(listPtr, 0, 1, 0);
+ listPtr->flags &= ~MAXWIDTH_IS_STALE;
+ listPtr->flags |= UPDATE_H_SCROLLBAR;
+ }
+
+ Tcl_Preserve(listPtr);
+ if (listPtr->flags & UPDATE_V_SCROLLBAR) {
+ ListboxUpdateVScrollbar(listPtr);
+ if ((listPtr->flags & LISTBOX_DELETED) || !Tk_IsMapped(tkwin)) {
+ Tcl_Release(listPtr);
+ return;
+ }
+ }
+ if (listPtr->flags & UPDATE_H_SCROLLBAR) {
+ ListboxUpdateHScrollbar(listPtr);
+ if ((listPtr->flags & LISTBOX_DELETED) || !Tk_IsMapped(tkwin)) {
+ Tcl_Release(listPtr);
+ return;
+ }
+ }
+ listPtr->flags &= ~(REDRAW_PENDING|UPDATE_V_SCROLLBAR|UPDATE_H_SCROLLBAR);
+ Tcl_Release(listPtr);
+
+#ifndef TK_NO_DOUBLE_BUFFERING
+ /*
+ * Redrawing is done in a temporary pixmap that is allocated here and
+ * freed at the end of the procedure. All drawing is done to the pixmap,
+ * and the pixmap is copied to the screen at the end of the procedure.
+ * This provides the smoothest possible visual effects (no flashing on the
+ * screen).
+ */
+
+ pixmap = Tk_GetPixmap(listPtr->display, Tk_WindowId(tkwin),
+ Tk_Width(tkwin), Tk_Height(tkwin), Tk_Depth(tkwin));
+#else
+ pixmap = Tk_WindowId(tkwin);
+#endif /* TK_NO_DOUBLE_BUFFERING */
+ Tk_Fill3DRectangle(tkwin, pixmap, listPtr->normalBorder, 0, 0,
+ Tk_Width(tkwin), Tk_Height(tkwin), 0, TK_RELIEF_FLAT);
+
+ /*
+ * Display each item in the listbox.
+ */
+
+ limit = listPtr->topIndex + listPtr->fullLines + listPtr->partialLine - 1;
+ if (limit >= listPtr->nElements) {
+ limit = listPtr->nElements-1;
+ }
+ left = right = 0;
+ if (listPtr->xOffset > 0) {
+ left = listPtr->selBorderWidth+1;
+ }
+ if ((listPtr->maxWidth - listPtr->xOffset) > (Tk_Width(listPtr->tkwin)
+ - 2*(listPtr->inset + listPtr->selBorderWidth))) {
+ right = listPtr->selBorderWidth+1;
+ }
+ prevSelected = 0;
+
+ for (i = listPtr->topIndex; i <= limit; i++) {
+ int width = Tk_Width(tkwin); /* zeroth approx to silence warning */
+
+ x = listPtr->inset;
+ y = ((i - listPtr->topIndex) * listPtr->lineHeight) + listPtr->inset;
+ gc = listPtr->textGC;
+ freeGC = 0;
+
+ /*
+ * Lookup this item in the item attributes table, to see if it has
+ * special foreground/background colors.
+ */
+
+ entry = Tcl_FindHashEntry(listPtr->itemAttrTable, KEY(i));
+
+ /*
+ * If the listbox is enabled, items may be drawn differently; they may
+ * be drawn selected, or they may have special foreground or
+ * background colors.
+ */
+
+ if (listPtr->state & STATE_NORMAL) {
+ if (Tcl_FindHashEntry(listPtr->selection, KEY(i))) {
+ /*
+ * Selected items are drawn differently.
+ */
+
+ gc = listPtr->selTextGC;
+ width = Tk_Width(tkwin) - 2*listPtr->inset;
+ selectedBg = listPtr->selBorder;
+
+ /*
+ * If there is attribute information for this item, adjust the
+ * drawing accordingly.
+ */
+
+ if (entry != NULL) {
+ attrs = Tcl_GetHashValue(entry);
+
+ /*
+ * Default GC has the values from the widget at large.
+ */
+
+ if (listPtr->selFgColorPtr) {
+ gcValues.foreground = listPtr->selFgColorPtr->pixel;
+ } else {
+ gcValues.foreground = listPtr->fgColorPtr->pixel;
+ }
+ gcValues.font = Tk_FontId(listPtr->tkfont);
+ gcValues.graphics_exposures = False;
+ mask = GCForeground | GCFont | GCGraphicsExposures;
+
+ if (attrs->selBorder != NULL) {
+ selectedBg = attrs->selBorder;
+ }
+
+ if (attrs->selFgColor != NULL) {
+ gcValues.foreground = attrs->selFgColor->pixel;
+ gc = Tk_GetGC(listPtr->tkwin, mask, &gcValues);
+ freeGC = 1;
+ }
+ }
+
+ Tk_Fill3DRectangle(tkwin, pixmap, selectedBg, x, y,
+ width, listPtr->lineHeight, 0, TK_RELIEF_FLAT);
+
+ /*
+ * Draw beveled edges around the selection, if there are
+ * visible edges next to this element. Special considerations:
+ *
+ * 1. The left and right bevels may not be visible if
+ * horizontal scrolling is enabled (the "left" & "right"
+ * variables are zero to indicate that the corresponding
+ * bevel is visible).
+ * 2. Top and bottom bevels are only drawn if this is the
+ * first or last seleted item.
+ * 3. If the left or right bevel isn't visible, then the
+ * "left" & "right" vars, computed above, have non-zero
+ * values that extend the top and bottom bevels so that
+ * the mitered corners are off-screen.
+ */
+
+ /* Draw left bevel */
+ if (left == 0) {
+ Tk_3DVerticalBevel(tkwin, pixmap, selectedBg,
+ x, y, listPtr->selBorderWidth, listPtr->lineHeight,
+ 1, TK_RELIEF_RAISED);
+ }
+ /* Draw right bevel */
+ if (right == 0) {
+ Tk_3DVerticalBevel(tkwin, pixmap, selectedBg,
+ x + width - listPtr->selBorderWidth, y,
+ listPtr->selBorderWidth, listPtr->lineHeight,
+ 0, TK_RELIEF_RAISED);
+ }
+ /* Draw top bevel */
+ if (!prevSelected) {
+ Tk_3DHorizontalBevel(tkwin, pixmap, selectedBg,
+ x-left, y, width+left+right,
+ listPtr->selBorderWidth,
+ 1, 1, 1, TK_RELIEF_RAISED);
+ }
+ /* Draw bottom bevel */
+ if (i + 1 == listPtr->nElements ||
+ !Tcl_FindHashEntry(listPtr->selection, KEY(i + 1))) {
+ 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 = Tcl_GetHashValue(entry);
+ gcValues.foreground = listPtr->fgColorPtr->pixel;
+ gcValues.font = Tk_FontId(listPtr->tkfont);
+ gcValues.graphics_exposures = False;
+ mask = GCForeground | GCFont | GCGraphicsExposures;
+
+ /*
+ * If the item has its own background color, draw it now.
+ */
+
+ if (attrs->border != NULL) {
+ width = Tk_Width(tkwin) - 2*listPtr->inset;
+ Tk_Fill3DRectangle(tkwin, pixmap, attrs->border, x, y,
+ width, listPtr->lineHeight, 0, TK_RELIEF_FLAT);
+ }
+
+ /*
+ * If the item has its own foreground, use it to override
+ * the value in the gcValues structure.
+ */
+
+ if ((listPtr->state & STATE_NORMAL)
+ && attrs->fgColor != NULL) {
+ gcValues.foreground = attrs->fgColor->pixel;
+ gc = Tk_GetGC(listPtr->tkwin, mask, &gcValues);
+ freeGC = 1;
+ }
+ }
+ prevSelected = 0;
+ }
+ }
+
+ /*
+ * Draw the actual text of this item.
+ */
+
+ Tcl_ListObjIndex(listPtr->interp, listPtr->listObj, i, &curElement);
+ stringRep = Tcl_GetStringFromObj(curElement, &stringLen);
+ textWidth = Tk_TextWidth(listPtr->tkfont, stringRep, stringLen);
+
+ Tk_GetFontMetrics(listPtr->tkfont, &fm);
+ y += fm.ascent + listPtr->selBorderWidth;
+
+ if (listPtr->justify == TK_JUSTIFY_LEFT) {
+ x = (listPtr->inset + listPtr->selBorderWidth) - listPtr->xOffset;
+ } else if (listPtr->justify == TK_JUSTIFY_RIGHT) {
+ x = Tk_Width(tkwin) - (listPtr->inset + listPtr->selBorderWidth)
+ - textWidth - listPtr->xOffset + GetMaxOffset(listPtr);
+ } else {
+ x = (Tk_Width(tkwin) - textWidth)/2
+ - listPtr->xOffset + GetMaxOffset(listPtr)/2;
+ }
+
+ Tk_DrawChars(listPtr->display, pixmap, gc, listPtr->tkfont,
+ stringRep, stringLen, x, y);
+
+ /*
+ * If this is the active element, apply the activestyle to it.
+ */
+
+ if ((i == listPtr->active) && (listPtr->flags & GOT_FOCUS)) {
+ if (listPtr->activeStyle == ACTIVE_STYLE_UNDERLINE) {
+ /*
+ * Underline the text.
+ */
+
+ Tk_UnderlineChars(listPtr->display, pixmap, gc,
+ listPtr->tkfont, stringRep, x, y, 0, stringLen);
+ } else if (listPtr->activeStyle == ACTIVE_STYLE_DOTBOX) {
+#ifdef _WIN32
+ /*
+ * This provides for exact default look and feel on Windows.
+ */
+
+ TkWinDCState state;
+ HDC dc;
+ RECT rect;
+
+ dc = TkWinGetDrawableDC(listPtr->display, pixmap, &state);
+ rect.left = listPtr->inset;
+ rect.top = ((i - listPtr->topIndex) * listPtr->lineHeight)
+ + listPtr->inset;
+ rect.right = rect.left + width;
+ rect.bottom = rect.top + listPtr->lineHeight;
+ DrawFocusRect(dc, &rect);
+ TkWinReleaseDrawableDC(pixmap, dc, &state);
+#else /* !_WIN32 */
+ /*
+ * Draw a dotted box around the text.
+ */
+
+ x = listPtr->inset;
+ y = ((i - listPtr->topIndex) * listPtr->lineHeight)
+ + listPtr->inset;
+ width = Tk_Width(tkwin) - 2*listPtr->inset - 1;
+
+ gcValues.line_style = LineOnOffDash;
+ gcValues.line_width = listPtr->selBorderWidth;
+ if (gcValues.line_width <= 0) {
+ gcValues.line_width = 1;
+ }
+ gcValues.dash_offset = 0;
+ gcValues.dashes = 1;
+
+ /*
+ * You would think the XSetDashes was necessary, but it
+ * appears that the default dotting for just saying we want
+ * dashes appears to work correctly.
+ static char dashList[] = { 1 };
+ static int dashLen = sizeof(dashList);
+ XSetDashes(listPtr->display, gc, 0, dashList, dashLen);
+ */
+
+ mask = GCLineWidth | GCLineStyle | GCDashList | GCDashOffset;
+ XChangeGC(listPtr->display, gc, mask, &gcValues);
+ XDrawRectangle(listPtr->display, pixmap, gc, x, y,
+ (unsigned) width, (unsigned) listPtr->lineHeight - 1);
+ if (!freeGC) {
+ /*
+ * Don't bother changing if it is about to be freed.
+ */
+
+ gcValues.line_style = LineSolid;
+ XChangeGC(listPtr->display, gc, GCLineStyle, &gcValues);
+ }
+#endif /* _WIN32 */
+ }
+ }
+
+ if (freeGC) {
+ Tk_FreeGC(listPtr->display, gc);
+ }
+ }
+
+ /*
+ * Redraw the border for the listbox to make sure that it's on top of any
+ * of the text of the listbox entries.
+ */
+
+ Tk_Draw3DRectangle(tkwin, pixmap, listPtr->normalBorder,
+ listPtr->highlightWidth, listPtr->highlightWidth,
+ Tk_Width(tkwin) - 2*listPtr->highlightWidth,
+ Tk_Height(tkwin) - 2*listPtr->highlightWidth,
+ listPtr->borderWidth, listPtr->relief);
+ if (listPtr->highlightWidth > 0) {
+ GC fgGC, bgGC;
+
+ bgGC = Tk_GCForColor(listPtr->highlightBgColorPtr, pixmap);
+ if (listPtr->flags & GOT_FOCUS) {
+ fgGC = Tk_GCForColor(listPtr->highlightColorPtr, pixmap);
+ TkpDrawHighlightBorder(tkwin, fgGC, bgGC,
+ listPtr->highlightWidth, pixmap);
+ } else {
+ TkpDrawHighlightBorder(tkwin, bgGC, bgGC,
+ listPtr->highlightWidth, pixmap);
+ }
+ }
+#ifndef TK_NO_DOUBLE_BUFFERING
+ XCopyArea(listPtr->display, pixmap, Tk_WindowId(tkwin),
+ listPtr->textGC, 0, 0, (unsigned) Tk_Width(tkwin),
+ (unsigned) Tk_Height(tkwin), 0, 0);
+ Tk_FreePixmap(listPtr->display, pixmap);
+#endif /* TK_NO_DOUBLE_BUFFERING */
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ListboxComputeGeometry --
+ *
+ * This procedure is invoked to recompute geometry information such as
+ * the sizes of the elements and the overall dimensions desired for the
+ * listbox.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Geometry information is updated and a new requested size is registered
+ * for the widget. Internal border and gridding information is also set.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+ListboxComputeGeometry(
+ Listbox *listPtr, /* Listbox whose geometry is to be
+ * recomputed. */
+ int fontChanged, /* Non-zero means the font may have changed so
+ * per-element width information also has to
+ * be computed. */
+ int maxIsStale, /* Non-zero means the "maxWidth" field may no
+ * longer be up-to-date and must be
+ * recomputed. If fontChanged is 1 then this
+ * must be 1. */
+ int updateGrid) /* Non-zero means call Tk_SetGrid or
+ * Tk_UnsetGrid to update gridding for the
+ * window. */
+{
+ int width, height, pixelWidth, pixelHeight, textLength, i, result;
+ Tk_FontMetrics fm;
+ Tcl_Obj *element;
+ const char *text;
+
+ if (fontChanged || maxIsStale) {
+ listPtr->xScrollUnit = Tk_TextWidth(listPtr->tkfont, "0", 1);
+ if (listPtr->xScrollUnit == 0) {
+ listPtr->xScrollUnit = 1;
+ }
+ listPtr->maxWidth = 0;
+ for (i = 0; i < listPtr->nElements; i++) {
+ /*
+ * Compute the pixel width of the current element.
+ */
+
+ result = Tcl_ListObjIndex(listPtr->interp, listPtr->listObj, i,
+ &element);
+ if (result != TCL_OK) {
+ continue;
+ }
+ text = Tcl_GetStringFromObj(element, &textLength);
+ Tk_GetFontMetrics(listPtr->tkfont, &fm);
+ pixelWidth = Tk_TextWidth(listPtr->tkfont, text, textLength);
+ if (pixelWidth > listPtr->maxWidth) {
+ listPtr->maxWidth = pixelWidth;
+ }
+ }
+ }
+
+ Tk_GetFontMetrics(listPtr->tkfont, &fm);
+ listPtr->lineHeight = fm.linespace + 1 + 2*listPtr->selBorderWidth;
+ width = listPtr->width;
+ if (width <= 0) {
+ width = (listPtr->maxWidth + listPtr->xScrollUnit - 1)
+ / listPtr->xScrollUnit;
+ if (width < 1) {
+ width = 1;
+ }
+ }
+ pixelWidth = width*listPtr->xScrollUnit + 2*listPtr->inset
+ + 2*listPtr->selBorderWidth;
+ height = listPtr->height;
+ if (listPtr->height <= 0) {
+ height = listPtr->nElements;
+ if (height < 1) {
+ height = 1;
+ }
+ }
+ pixelHeight = height*listPtr->lineHeight + 2*listPtr->inset;
+ Tk_GeometryRequest(listPtr->tkwin, pixelWidth, pixelHeight);
+ Tk_SetInternalBorder(listPtr->tkwin, listPtr->inset);
+ if (updateGrid) {
+ if (listPtr->setGrid) {
+ Tk_SetGrid(listPtr->tkwin, width, height, listPtr->xScrollUnit,
+ listPtr->lineHeight);
+ } else {
+ Tk_UnsetGrid(listPtr->tkwin);
+ }
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ListboxInsertSubCmd --
+ *
+ * This procedure is invoked to handle the listbox "insert" subcommand.
+ *
+ * Results:
+ * Standard Tcl result.
+ *
+ * Side effects:
+ * New elements are added to the listbox pointed to by listPtr; a refresh
+ * callback is registered for the listbox.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+ListboxInsertSubCmd(
+ register Listbox *listPtr, /* Listbox that is to get the new elements. */
+ int index, /* Add the new elements before this
+ * element. */
+ int objc, /* Number of new elements to add. */
+ Tcl_Obj *const objv[]) /* New elements (one per entry). */
+{
+ int i, oldMaxWidth, pixelWidth, result, length;
+ Tcl_Obj *newListObj;
+ const char *stringRep;
+
+ oldMaxWidth = listPtr->maxWidth;
+ for (i = 0; i < objc; i++) {
+ /*
+ * Check if any of the new elements are wider than the current widest;
+ * if so, update our notion of "widest."
+ */
+
+ stringRep = Tcl_GetStringFromObj(objv[i], &length);
+ pixelWidth = Tk_TextWidth(listPtr->tkfont, stringRep, length);
+ if (pixelWidth > listPtr->maxWidth) {
+ listPtr->maxWidth = pixelWidth;
+ }
+ }
+
+ /*
+ * Adjust selection and attribute information for every index after the
+ * first index.
+ */
+
+ MigrateHashEntries(listPtr->selection, index, listPtr->nElements-1, objc);
+ MigrateHashEntries(listPtr->itemAttrTable, index, listPtr->nElements-1,
+ objc);
+
+ /*
+ * If the object is shared, duplicate it before writing to it.
+ */
+
+ if (Tcl_IsShared(listPtr->listObj)) {
+ newListObj = Tcl_DuplicateObj(listPtr->listObj);
+ } else {
+ newListObj = listPtr->listObj;
+ }
+ result = Tcl_ListObjReplace(listPtr->interp, newListObj, index, 0,
+ objc, objv);
+ if (result != TCL_OK) {
+ return result;
+ }
+
+ /*
+ * Replace the current object and set attached listvar, if any. This may
+ * error if listvar points to a var in a deleted namespace, but we ignore
+ * those errors. If the namespace is recreated, it will auto-sync with the
+ * current value. [Bug 1424513]
+ */
+
+ Tcl_IncrRefCount(newListObj);
+ Tcl_DecrRefCount(listPtr->listObj);
+ listPtr->listObj = newListObj;
+ if (listPtr->listVarName != NULL) {
+ Tcl_SetVar2Ex(listPtr->interp, listPtr->listVarName, NULL,
+ listPtr->listObj, TCL_GLOBAL_ONLY);
+ }
+
+ /*
+ * Get the new list length.
+ */
+
+ Tcl_ListObjLength(listPtr->interp, listPtr->listObj, &listPtr->nElements);
+
+ /*
+ * Update the "special" indices (anchor, topIndex, active) to account for
+ * the renumbering that just occurred. Then arrange for the new
+ * information to be displayed.
+ */
+
+ if (index <= listPtr->selectAnchor) {
+ listPtr->selectAnchor += objc;
+ }
+ if (index < listPtr->topIndex) {
+ listPtr->topIndex += objc;
+ }
+ if (index <= listPtr->active) {
+ listPtr->active += objc;
+ if ((listPtr->active >= listPtr->nElements) &&
+ (listPtr->nElements > 0)) {
+ listPtr->active = listPtr->nElements-1;
+ }
+ }
+ listPtr->flags |= UPDATE_V_SCROLLBAR;
+ if (listPtr->maxWidth != oldMaxWidth) {
+ listPtr->flags |= UPDATE_H_SCROLLBAR;
+ }
+ ListboxComputeGeometry(listPtr, 0, 0, 0);
+ EventuallyRedrawRange(listPtr, index, listPtr->nElements-1);
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ListboxDeleteSubCmd --
+ *
+ * Process a listbox "delete" subcommand by removing one or more elements
+ * from a listbox widget.
+ *
+ * Results:
+ * Standard Tcl result.
+ *
+ * Side effects:
+ * The listbox will be modified and (eventually) redisplayed.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+ListboxDeleteSubCmd(
+ register Listbox *listPtr, /* Listbox widget to modify. */
+ int first, /* Index of first element to delete. */
+ int last) /* Index of last element to delete. */
+{
+ int count, i, widthChanged, length, result, pixelWidth;
+ Tcl_Obj *newListObj, *element;
+ const char *stringRep;
+ Tcl_HashEntry *entry;
+
+ /*
+ * Adjust the range to fit within the existing elements of the listbox,
+ * and make sure there's something to delete.
+ */
+
+ if (first < 0) {
+ first = 0;
+ }
+ if (last >= listPtr->nElements) {
+ last = listPtr->nElements-1;
+ }
+ count = last + 1 - first;
+ if (count <= 0) {
+ return TCL_OK;
+ }
+
+ /*
+ * Foreach deleted index we must:
+ * a) remove selection information,
+ * b) check the width of the element; if it is equal to the max, set
+ * widthChanged to 1, because it may be the only element with that
+ * width.
+ */
+
+ widthChanged = 0;
+ for (i = first; i <= last; i++) {
+ /*
+ * Remove selection information.
+ */
+
+ entry = Tcl_FindHashEntry(listPtr->selection, KEY(i));
+ if (entry != NULL) {
+ listPtr->numSelected--;
+ Tcl_DeleteHashEntry(entry);
+ }
+
+ entry = Tcl_FindHashEntry(listPtr->itemAttrTable, KEY(i));
+ if (entry != NULL) {
+ ckfree(Tcl_GetHashValue(entry));
+ Tcl_DeleteHashEntry(entry);
+ }
+
+ /*
+ * Check width of the element. We only have to check if widthChanged
+ * has not already been set to 1, because we only need one maxWidth
+ * element to disappear for us to have to recompute the width.
+ */
+
+ if (widthChanged == 0) {
+ Tcl_ListObjIndex(listPtr->interp, listPtr->listObj, i, &element);
+ stringRep = Tcl_GetStringFromObj(element, &length);
+ pixelWidth = Tk_TextWidth(listPtr->tkfont, stringRep, length);
+ if (pixelWidth == listPtr->maxWidth) {
+ widthChanged = 1;
+ }
+ }
+ }
+
+ /*
+ * Adjust selection and attribute info for indices after lastIndex.
+ */
+
+ MigrateHashEntries(listPtr->selection, last+1,
+ listPtr->nElements-1, count*-1);
+ MigrateHashEntries(listPtr->itemAttrTable, last+1,
+ listPtr->nElements-1, count*-1);
+
+ /*
+ * Delete the requested elements.
+ */
+
+ if (Tcl_IsShared(listPtr->listObj)) {
+ newListObj = Tcl_DuplicateObj(listPtr->listObj);
+ } else {
+ newListObj = listPtr->listObj;
+ }
+ result = Tcl_ListObjReplace(listPtr->interp,
+ newListObj, first, count, 0, NULL);
+ if (result != TCL_OK) {
+ return result;
+ }
+
+ /*
+ * Replace the current object and set attached listvar, if any. This may
+ * error if listvar points to a var in a deleted namespace, but we ignore
+ * those errors. If the namespace is recreated, it will auto-sync with the
+ * current value. [Bug 1424513]
+ */
+
+ Tcl_IncrRefCount(newListObj);
+ Tcl_DecrRefCount(listPtr->listObj);
+ listPtr->listObj = newListObj;
+ if (listPtr->listVarName != NULL) {
+ Tcl_SetVar2Ex(listPtr->interp, listPtr->listVarName, NULL,
+ listPtr->listObj, TCL_GLOBAL_ONLY);
+ }
+
+ /*
+ * Get the new list length.
+ */
+
+ Tcl_ListObjLength(listPtr->interp, listPtr->listObj, &listPtr->nElements);
+
+ /*
+ * Update the selection and viewing information to reflect the change in
+ * the element numbering, and redisplay to slide information up over the
+ * elements that were deleted.
+ */
+
+ if (first <= listPtr->selectAnchor) {
+ listPtr->selectAnchor -= count;
+ if (listPtr->selectAnchor < first) {
+ listPtr->selectAnchor = first;
+ }
+ }
+ if (first <= listPtr->topIndex) {
+ listPtr->topIndex -= count;
+ if (listPtr->topIndex < first) {
+ listPtr->topIndex = first;
+ }
+ }
+ if (listPtr->topIndex > (listPtr->nElements - listPtr->fullLines)) {
+ listPtr->topIndex = listPtr->nElements - listPtr->fullLines;
+ if (listPtr->topIndex < 0) {
+ listPtr->topIndex = 0;
+ }
+ }
+ if (listPtr->active > last) {
+ listPtr->active -= count;
+ } else if (listPtr->active >= first) {
+ listPtr->active = first;
+ if ((listPtr->active >= listPtr->nElements) &&
+ (listPtr->nElements > 0)) {
+ listPtr->active = listPtr->nElements-1;
+ }
+ }
+ listPtr->flags |= UPDATE_V_SCROLLBAR;
+ ListboxComputeGeometry(listPtr, 0, widthChanged, 0);
+ if (widthChanged) {
+ listPtr->flags |= UPDATE_H_SCROLLBAR;
+ }
+ EventuallyRedrawRange(listPtr, first, listPtr->nElements-1);
+ return TCL_OK;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * ListboxEventProc --
+ *
+ * This procedure is invoked by the Tk dispatcher for various events on
+ * listboxes.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * When the window gets deleted, internal structures get cleaned up. When
+ * it gets exposed, it is redisplayed.
+ *
+ *--------------------------------------------------------------
+ */
+
+static void
+ListboxEventProc(
+ ClientData clientData, /* Information about window. */
+ XEvent *eventPtr) /* Information about event. */
+{
+ Listbox *listPtr = clientData;
+
+ if (eventPtr->type == Expose) {
+ EventuallyRedrawRange(listPtr,
+ NearestListboxElement(listPtr, eventPtr->xexpose.y),
+ NearestListboxElement(listPtr, eventPtr->xexpose.y
+ + eventPtr->xexpose.height));
+ } else if (eventPtr->type == DestroyNotify) {
+ if (!(listPtr->flags & LISTBOX_DELETED)) {
+ listPtr->flags |= LISTBOX_DELETED;
+ Tcl_DeleteCommandFromToken(listPtr->interp, listPtr->widgetCmd);
+ if (listPtr->setGrid) {
+ Tk_UnsetGrid(listPtr->tkwin);
+ }
+ if (listPtr->flags & REDRAW_PENDING) {
+ Tcl_CancelIdleCall(DisplayListbox, clientData);
+ }
+ Tcl_EventuallyFree(clientData, (Tcl_FreeProc *) DestroyListbox);
+ }
+ } else if (eventPtr->type == ConfigureNotify) {
+ int vertSpace;
+
+ vertSpace = Tk_Height(listPtr->tkwin) - 2*listPtr->inset;
+ listPtr->fullLines = vertSpace / listPtr->lineHeight;
+ if ((listPtr->fullLines*listPtr->lineHeight) < vertSpace) {
+ listPtr->partialLine = 1;
+ } else {
+ listPtr->partialLine = 0;
+ }
+ listPtr->flags |= UPDATE_V_SCROLLBAR|UPDATE_H_SCROLLBAR;
+ ChangeListboxView(listPtr, listPtr->topIndex);
+ ChangeListboxOffset(listPtr, listPtr->xOffset);
+
+ /*
+ * Redraw the whole listbox. It's hard to tell what needs to be
+ * redrawn (e.g. if the listbox has shrunk then we may only need to
+ * redraw the borders), so just redraw everything for safety.
+ */
+
+ EventuallyRedrawRange(listPtr, 0, listPtr->nElements-1);
+ } else if (eventPtr->type == FocusIn) {
+ if (eventPtr->xfocus.detail != NotifyInferior) {
+ listPtr->flags |= GOT_FOCUS;
+ EventuallyRedrawRange(listPtr, 0, listPtr->nElements-1);
+ }
+ } else if (eventPtr->type == FocusOut) {
+ if (eventPtr->xfocus.detail != NotifyInferior) {
+ listPtr->flags &= ~GOT_FOCUS;
+ EventuallyRedrawRange(listPtr, 0, listPtr->nElements-1);
+ }
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ListboxCmdDeletedProc --
+ *
+ * This procedure is invoked when a widget command is deleted. If the
+ * widget isn't already in the process of being destroyed, this command
+ * destroys it.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The widget is destroyed.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+ListboxCmdDeletedProc(
+ ClientData clientData) /* Pointer to widget record for widget. */
+{
+ Listbox *listPtr = clientData;
+
+ /*
+ * This procedure could be invoked either because the window was destroyed
+ * and the command was then deleted (in which case tkwin is NULL) or
+ * because the command was deleted, and then this procedure destroys the
+ * widget.
+ */
+
+ if (!(listPtr->flags & LISTBOX_DELETED)) {
+ Tk_DestroyWindow(listPtr->tkwin);
+ }
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * GetListboxIndex --
+ *
+ * Parse an index into a listbox and return either its value or an error.
+ *
+ * Results:
+ * A standard Tcl result. If all went well, then *indexPtr is filled in
+ * with the index (into listPtr) corresponding to string. Otherwise an
+ * error message is left in the interp's result.
+ *
+ * Side effects:
+ * None.
+ *
+ *--------------------------------------------------------------
+ */
+
+static int
+GetListboxIndex(
+ Tcl_Interp *interp, /* For error messages. */
+ Listbox *listPtr, /* Listbox for which the index is being
+ * specified. */
+ Tcl_Obj *indexObj, /* Specifies an element in the listbox. */
+ int endIsSize, /* If 1, "end" refers to the number of entries
+ * in the listbox. If 0, "end" refers to 1
+ * less than the number of entries. */
+ int *indexPtr) /* Where to store converted index. */
+{
+ int result, index;
+ const char *stringRep;
+
+ /*
+ * First see if the index is one of the named indices.
+ */
+
+ result = Tcl_GetIndexFromObj(NULL, indexObj, indexNames, "", 0, &index);
+ if (result == TCL_OK) {
+ switch (index) {
+ case INDEX_ACTIVE:
+ /* "active" index */
+ *indexPtr = listPtr->active;
+ break;
+ case INDEX_ANCHOR:
+ /* "anchor" index */
+ *indexPtr = listPtr->selectAnchor;
+ break;
+ case INDEX_END:
+ /* "end" index */
+ if (endIsSize) {
+ *indexPtr = listPtr->nElements;
+ } else {
+ *indexPtr = listPtr->nElements - 1;
+ }
+ break;
+ }
+ return TCL_OK;
+ }
+
+ /*
+ * The index didn't match any of the named indices; maybe it's an @x,y
+ */
+
+ stringRep = Tcl_GetString(indexObj);
+ if (stringRep[0] == '@') {
+
+ /*
+ * @x,y index
+ */
+
+ int y;
+ const char *start;
+ char *end;
+
+ start = stringRep + 1;
+ y = strtol(start, &end, 0);
+ if ((start == end) || (*end != ',')) {
+ goto badIndex;
+ }
+ start = end+1;
+ y = strtol(start, &end, 0);
+ if ((start == end) || (*end != '\0')) {
+ goto badIndex;
+ }
+ *indexPtr = NearestListboxElement(listPtr, y);
+ return TCL_OK;
+ }
+
+ /*
+ * Maybe the index is just an integer.
+ */
+
+ if (Tcl_GetIntFromObj(interp, indexObj, indexPtr) == TCL_OK) {
+ return TCL_OK;
+ }
+
+ /*
+ * Everything failed, nothing matched. Throw up an error message.
+ */
+
+ badIndex:
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "bad listbox index \"%s\": must be active, anchor, end, @x,y,"
+ " or a number", Tcl_GetString(indexObj)));
+ Tcl_SetErrorCode(interp, "TK", "VALUE", "LISTBOX_INDEX", NULL);
+ return TCL_ERROR;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ChangeListboxView --
+ *
+ * Change the view on a listbox widget so that a given element is
+ * displayed at the top.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * What's displayed on the screen is changed. If there is a scrollbar
+ * associated with this widget, then the scrollbar is instructed to
+ * change its display too.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+ChangeListboxView(
+ register Listbox *listPtr, /* Information about widget. */
+ int index) /* Index of element in listPtr that should now
+ * appear at the top of the listbox. */
+{
+ if (index >= (listPtr->nElements - listPtr->fullLines)) {
+ index = listPtr->nElements - listPtr->fullLines;
+ }
+ if (index < 0) {
+ index = 0;
+ }
+ if (listPtr->topIndex != index) {
+ listPtr->topIndex = index;
+ EventuallyRedrawRange(listPtr, 0, listPtr->nElements-1);
+ listPtr->flags |= UPDATE_V_SCROLLBAR;
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ChangListboxOffset --
+ *
+ * Change the horizontal offset for a listbox.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The listbox may be redrawn to reflect its new horizontal offset.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+ChangeListboxOffset(
+ register Listbox *listPtr, /* Information about widget. */
+ int offset) /* Desired new "xOffset" for listbox. */
+{
+ int maxOffset;
+
+ /*
+ * Make sure that the new offset is within the allowable range, and round
+ * it off to an even multiple of xScrollUnit.
+ *
+ * Add half a scroll unit to do entry/text-like synchronization. [Bug
+ * #225025]
+ */
+
+ offset += listPtr->xScrollUnit / 2;
+ maxOffset = GetMaxOffset(listPtr);
+ if (offset > maxOffset) {
+ offset = maxOffset;
+ }
+ if (offset < 0) {
+ offset = 0;
+ }
+ offset -= offset % listPtr->xScrollUnit;
+ if (offset != listPtr->xOffset) {
+ listPtr->xOffset = offset;
+ listPtr->flags |= UPDATE_H_SCROLLBAR;
+ EventuallyRedrawRange(listPtr, 0, listPtr->nElements-1);
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ListboxScanTo --
+ *
+ * Given a point (presumably of the curent mouse location) drag the view
+ * in the window to implement the scan operation.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The view in the window may change.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+ListboxScanTo(
+ register Listbox *listPtr, /* Information about widget. */
+ int x, /* X-coordinate to use for scan operation. */
+ int y) /* Y-coordinate to use for scan operation. */
+{
+ int newTopIndex, newOffset, maxIndex, maxOffset;
+
+ maxIndex = listPtr->nElements - listPtr->fullLines;
+ maxOffset = GetMaxOffset(listPtr);
+
+ /*
+ * Compute new top line for screen by amplifying the difference between
+ * the current position and the place where the scan started (the "mark"
+ * position). If we run off the top or bottom of the list, then reset the
+ * mark point so that the current position continues to correspond to the
+ * edge of the window. This means that the picture will start dragging as
+ * soon as the mouse reverses direction (without this reset, might have to
+ * slide mouse a long ways back before the picture starts moving again).
+ */
+
+ newTopIndex = listPtr->scanMarkYIndex
+ - (10*(y - listPtr->scanMarkY)) / listPtr->lineHeight;
+ if (newTopIndex > maxIndex) {
+ newTopIndex = listPtr->scanMarkYIndex = maxIndex;
+ listPtr->scanMarkY = y;
+ } else if (newTopIndex < 0) {
+ newTopIndex = listPtr->scanMarkYIndex = 0;
+ listPtr->scanMarkY = y;
+ }
+ ChangeListboxView(listPtr, newTopIndex);
+
+ /*
+ * Compute new left edge for display in a similar fashion by amplifying
+ * the difference between the current position and the place where the
+ * scan started.
+ */
+
+ newOffset = listPtr->scanMarkXOffset - 10*(x - listPtr->scanMarkX);
+ if (newOffset > maxOffset) {
+ newOffset = listPtr->scanMarkXOffset = maxOffset;
+ listPtr->scanMarkX = x;
+ } else if (newOffset < 0) {
+ newOffset = listPtr->scanMarkXOffset = 0;
+ listPtr->scanMarkX = x;
+ }
+ ChangeListboxOffset(listPtr, newOffset);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * NearestListboxElement --
+ *
+ * Given a y-coordinate inside a listbox, compute the index of the
+ * element under that y-coordinate (or closest to that y-coordinate).
+ *
+ * Results:
+ * The return value is an index of an element of listPtr. If listPtr has
+ * no elements, then 0 is always returned.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+NearestListboxElement(
+ register Listbox *listPtr, /* Information about widget. */
+ int y) /* Y-coordinate in listPtr's window. */
+{
+ int index;
+
+ index = (y - listPtr->inset) / listPtr->lineHeight;
+ if (index >= (listPtr->fullLines + listPtr->partialLine)) {
+ index = listPtr->fullLines + listPtr->partialLine - 1;
+ }
+ if (index < 0) {
+ index = 0;
+ }
+ index += listPtr->topIndex;
+ if (index >= listPtr->nElements) {
+ index = listPtr->nElements-1;
+ }
+ return index;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ListboxSelect --
+ *
+ * Select or deselect one or more elements in a listbox..
+ *
+ * Results:
+ * Standard Tcl result.
+ *
+ * Side effects:
+ * All of the elements in the range between first and last are marked as
+ * either selected or deselected, depending on the "select" argument. Any
+ * items whose state changes are redisplayed. The selection is claimed
+ * from X when the number of selected elements changes from zero to
+ * non-zero.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+ListboxSelect(
+ register Listbox *listPtr, /* Information about widget. */
+ int first, /* Index of first element to select or
+ * deselect. */
+ int last, /* Index of last element to select or
+ * deselect. */
+ int select) /* 1 means select items, 0 means deselect
+ * them. */
+{
+ int i, firstRedisplay, oldCount, isNew;
+ Tcl_HashEntry *entry;
+
+ if (last < first) {
+ i = first;
+ first = last;
+ last = i;
+ }
+ if ((last < 0) || (first >= listPtr->nElements)) {
+ return TCL_OK;
+ }
+ if (first < 0) {
+ first = 0;
+ }
+ if (last >= listPtr->nElements) {
+ last = listPtr->nElements - 1;
+ }
+ oldCount = listPtr->numSelected;
+ firstRedisplay = -1;
+
+ /*
+ * 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, KEY(i));
+ if (entry != NULL) {
+ if (!select) {
+ Tcl_DeleteHashEntry(entry);
+ listPtr->numSelected--;
+ if (firstRedisplay < 0) {
+ firstRedisplay = i;
+ }
+ }
+ } else {
+ if (select) {
+ entry = Tcl_CreateHashEntry(listPtr->selection, KEY(i),
+ &isNew);
+ Tcl_SetHashValue(entry, NULL);
+ listPtr->numSelected++;
+ if (firstRedisplay < 0) {
+ firstRedisplay = i;
+ }
+ }
+ }
+ }
+
+ if (firstRedisplay >= 0) {
+ EventuallyRedrawRange(listPtr, first, last);
+ }
+ if ((oldCount == 0) && (listPtr->numSelected > 0)
+ && listPtr->exportSelection) {
+ Tk_OwnSelection(listPtr->tkwin, XA_PRIMARY,
+ ListboxLostSelection, listPtr);
+ }
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ListboxFetchSelection --
+ *
+ * This procedure is called back by Tk when the selection is requested by
+ * someone. It returns part or all of the selection in a buffer provided
+ * by the caller.
+ *
+ * Results:
+ * The return value is the number of non-NULL bytes stored at buffer.
+ * Buffer is filled (or partially filled) with a NULL-terminated string
+ * containing part or all of the selection, as given by offset and
+ * maxBytes. The selection is returned as a Tcl list with one list
+ * element for each element in the listbox.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+ListboxFetchSelection(
+ ClientData clientData, /* Information about listbox widget. */
+ int offset, /* Offset within selection of first byte to be
+ * returned. */
+ char *buffer, /* Location in which to place selection. */
+ int maxBytes) /* Maximum number of bytes to place at buffer,
+ * not including terminating NULL
+ * character. */
+{
+ register Listbox *listPtr = clientData;
+ Tcl_DString selection;
+ int length, count, needNewline, stringLen, i;
+ Tcl_Obj *curElement;
+ const char *stringRep;
+ Tcl_HashEntry *entry;
+
+ if (!listPtr->exportSelection) {
+ return -1;
+ }
+
+ /*
+ * Use a dynamic string to accumulate the contents of the selection.
+ */
+
+ needNewline = 0;
+ Tcl_DStringInit(&selection);
+ for (i = 0; i < listPtr->nElements; i++) {
+ entry = Tcl_FindHashEntry(listPtr->selection, KEY(i));
+ if (entry != NULL) {
+ if (needNewline) {
+ Tcl_DStringAppend(&selection, "\n", 1);
+ }
+ Tcl_ListObjIndex(listPtr->interp, listPtr->listObj, i,
+ &curElement);
+ stringRep = Tcl_GetStringFromObj(curElement, &stringLen);
+ Tcl_DStringAppend(&selection, stringRep, stringLen);
+ needNewline = 1;
+ }
+ }
+
+ length = Tcl_DStringLength(&selection);
+ if (length == 0) {
+ return -1;
+ }
+
+ /*
+ * Copy the requested portion of the selection to the buffer.
+ */
+
+ count = length - offset;
+ if (count <= 0) {
+ count = 0;
+ } else {
+ if (count > maxBytes) {
+ count = maxBytes;
+ }
+ memcpy(buffer, Tcl_DStringValue(&selection) + offset, (size_t) count);
+ }
+ buffer[count] = '\0';
+ Tcl_DStringFree(&selection);
+ return count;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ListboxLostSelection --
+ *
+ * This procedure is called back by Tk when the selection is grabbed away
+ * from a listbox widget.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The existing selection is unhighlighted, and the window is marked as
+ * not containing a selection.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+ListboxLostSelection(
+ ClientData clientData) /* Information about listbox widget. */
+{
+ register Listbox *listPtr = clientData;
+
+ if ((listPtr->exportSelection) && (listPtr->nElements > 0)) {
+ ListboxSelect(listPtr, 0, listPtr->nElements-1, 0);
+ GenerateListboxSelectEvent(listPtr);
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * GenerateListboxSelectEvent --
+ *
+ * Send an event that the listbox selection was updated. This is
+ * equivalent to event generate $listboxWidget <<ListboxSelect>>
+ *
+ * Results:
+ * None
+ *
+ * Side effects:
+ * Any side effect possible, depending on bindings to this event.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+GenerateListboxSelectEvent(
+ Listbox *listPtr) /* Information about widget. */
+{
+ TkSendVirtualEvent(listPtr->tkwin, "ListboxSelect", NULL);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * EventuallyRedrawRange --
+ *
+ * Ensure that a given range of elements is eventually redrawn on the
+ * display (if those elements in fact appear on the display).
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Information gets redisplayed.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+EventuallyRedrawRange(
+ register Listbox *listPtr, /* Information about widget. */
+ int first, /* Index of first element in list that needs
+ * to be redrawn. */
+ int last) /* Index of last element in list that needs to
+ * be redrawn. May be less than first; these
+ * just bracket a range. */
+{
+ /*
+ * We don't have to register a redraw callback if one is already pending,
+ * or if the window doesn't exist, or if the window isn't mapped.
+ */
+
+ if ((listPtr->flags & REDRAW_PENDING)
+ || (listPtr->flags & LISTBOX_DELETED)
+ || !Tk_IsMapped(listPtr->tkwin)) {
+ return;
+ }
+ listPtr->flags |= REDRAW_PENDING;
+ Tcl_DoWhenIdle(DisplayListbox, listPtr);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ListboxUpdateVScrollbar --
+ *
+ * This procedure is invoked whenever information has changed in a
+ * listbox in a way that would invalidate a vertical scrollbar display.
+ * If there is an associated scrollbar, then this command updates it by
+ * invoking a Tcl command.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * A Tcl command is invoked, and an additional command may be invoked to
+ * process errors in the command.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+ListboxUpdateVScrollbar(
+ register Listbox *listPtr) /* Information about widget. */
+{
+ char firstStr[TCL_DOUBLE_SPACE], lastStr[TCL_DOUBLE_SPACE];
+ double first, last;
+ int result;
+ Tcl_Interp *interp;
+ Tcl_DString buf;
+
+ if (listPtr->yScrollCmd == NULL) {
+ return;
+ }
+ if (listPtr->nElements == 0) {
+ first = 0.0;
+ last = 1.0;
+ } else {
+ first = listPtr->topIndex / (double) listPtr->nElements;
+ last = (listPtr->topIndex + listPtr->fullLines)
+ / (double) listPtr->nElements;
+ if (last > 1.0) {
+ last = 1.0;
+ }
+ }
+ Tcl_PrintDouble(NULL, first, firstStr);
+ Tcl_PrintDouble(NULL, last, lastStr);
+
+ /*
+ * We must hold onto the interpreter from the listPtr because the data at
+ * listPtr might be freed as a result of the Tcl_VarEval.
+ */
+
+ interp = listPtr->interp;
+ Tcl_Preserve(interp);
+ Tcl_DStringInit(&buf);
+ Tcl_DStringAppend(&buf, listPtr->yScrollCmd, -1);
+ Tcl_DStringAppend(&buf, " ", -1);
+ Tcl_DStringAppend(&buf, firstStr, -1);
+ Tcl_DStringAppend(&buf, " ", -1);
+ Tcl_DStringAppend(&buf, lastStr, -1);
+ result = Tcl_EvalEx(interp, Tcl_DStringValue(&buf), -1, 0);
+ Tcl_DStringFree(&buf);
+ if (result != TCL_OK) {
+ Tcl_AddErrorInfo(interp,
+ "\n (vertical scrolling command executed by listbox)");
+ Tcl_BackgroundException(interp, result);
+ }
+ Tcl_Release(interp);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ListboxUpdateHScrollbar --
+ *
+ * This procedure is invoked whenever information has changed in a
+ * listbox in a way that would invalidate a horizontal scrollbar display.
+ * If there is an associated horizontal scrollbar, then this command
+ * updates it by invoking a Tcl command.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * A Tcl command is invoked, and an additional command may be invoked to
+ * process errors in the command.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+ListboxUpdateHScrollbar(
+ register Listbox *listPtr) /* Information about widget. */
+{
+ char firstStr[TCL_DOUBLE_SPACE], lastStr[TCL_DOUBLE_SPACE];
+ int result, windowWidth;
+ double first, last;
+ Tcl_Interp *interp;
+ Tcl_DString buf;
+
+ if (listPtr->xScrollCmd == NULL) {
+ return;
+ }
+
+ windowWidth = Tk_Width(listPtr->tkwin)
+ - 2*(listPtr->inset + listPtr->selBorderWidth);
+ if (listPtr->maxWidth == 0) {
+ first = 0;
+ last = 1.0;
+ } else {
+ first = listPtr->xOffset / (double) listPtr->maxWidth;
+ last = (listPtr->xOffset + windowWidth) / (double) listPtr->maxWidth;
+ if (last > 1.0) {
+ last = 1.0;
+ }
+ }
+ Tcl_PrintDouble(NULL, first, firstStr);
+ Tcl_PrintDouble(NULL, last, lastStr);
+
+ /*
+ * We must hold onto the interpreter because the data referred to at
+ * listPtr might be freed as a result of the call to Tcl_VarEval.
+ */
+
+ interp = listPtr->interp;
+ Tcl_Preserve(interp);
+ Tcl_DStringInit(&buf);
+ Tcl_DStringAppend(&buf, listPtr->xScrollCmd, -1);
+ Tcl_DStringAppend(&buf, " ", -1);
+ Tcl_DStringAppend(&buf, firstStr, -1);
+ Tcl_DStringAppend(&buf, " ", -1);
+ Tcl_DStringAppend(&buf, lastStr, -1);
+ result = Tcl_EvalEx(interp, Tcl_DStringValue(&buf), -1, 0);
+ Tcl_DStringFree(&buf);
+ if (result != TCL_OK) {
+ Tcl_AddErrorInfo(interp,
+ "\n (horizontal scrolling command executed by listbox)");
+ Tcl_BackgroundException(interp, result);
+ }
+ Tcl_Release(interp);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ListboxListVarProc --
+ *
+ * Called whenever the trace on the listbox list var fires.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static char *
+ListboxListVarProc(
+ ClientData clientData, /* Information about button. */
+ Tcl_Interp *interp, /* Interpreter containing variable. */
+ const char *name1, /* Not used. */
+ const char *name2, /* Not used. */
+ int flags) /* Information about what happened. */
+{
+ Listbox *listPtr = clientData;
+ Tcl_Obj *oldListObj, *varListObj;
+ int oldLength, 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, NULL,
+ listPtr->listObj, TCL_GLOBAL_ONLY);
+ Tcl_TraceVar2(interp, listPtr->listVarName,
+ NULL, TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS,
+ ListboxListVarProc, clientData);
+ return NULL;
+ }
+ } else {
+ oldListObj = listPtr->listObj;
+ varListObj = Tcl_GetVar2Ex(listPtr->interp, listPtr->listVarName,
+ 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, NULL, oldListObj,
+ TCL_GLOBAL_ONLY);
+ return (char *) "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, KEY(i));
+ if (entry != NULL) {
+ listPtr->numSelected--;
+ Tcl_DeleteHashEntry(entry);
+ }
+
+ /*
+ * Clean up attributes.
+ */
+
+ entry = Tcl_FindHashEntry(listPtr->itemAttrTable, KEY(i));
+ if (entry != NULL) {
+ ckfree(Tcl_GetHashValue(entry));
+ 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 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(
+ Tcl_HashTable *table,
+ int first,
+ int last,
+ int offset)
+{
+ int i, isNew;
+ 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, KEY(i));
+ if (entry != NULL) {
+ clientData = Tcl_GetHashValue(entry);
+ Tcl_DeleteHashEntry(entry);
+ entry = Tcl_CreateHashEntry(table, KEY(i + offset), &isNew);
+ Tcl_SetHashValue(entry, clientData);
+ }
+ }
+ } else {
+ for (i = first; i <= last; i++) {
+ entry = Tcl_FindHashEntry(table, KEY(i));
+ if (entry != NULL) {
+ clientData = Tcl_GetHashValue(entry);
+ Tcl_DeleteHashEntry(entry);
+ entry = Tcl_CreateHashEntry(table, KEY(i + offset), &isNew);
+ Tcl_SetHashValue(entry, clientData);
+ }
+ }
+ }
+ return;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * GetMaxOffset --
+ *
+ * Passing in a listbox pointer, returns the maximum offset for the box,
+ * i.e. the maximum possible horizontal scrolling value (in pixels).
+ *
+ * Results:
+ * Listbox's maxOffset.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+*/
+static int GetMaxOffset(
+ register Listbox *listPtr)
+{
+ int maxOffset;
+
+ maxOffset = listPtr->maxWidth -
+ (Tk_Width(listPtr->tkwin) - 2*listPtr->inset -
+ 2*listPtr->selBorderWidth) + listPtr->xScrollUnit - 1;
+ if (maxOffset < 0) {
+
+ /*
+ * Listbox is larger in width than its largest width item.
+ */
+
+ maxOffset = 0;
+ }
+ maxOffset -= maxOffset % listPtr->xScrollUnit;
+
+ return maxOffset;
+}
+/*
+ * Local Variables:
+ * mode: c
+ * c-basic-offset: 4
+ * fill-column: 78
+ * End:
+ */
diff --git a/tk8.6/generic/tkMacWinMenu.c b/tk8.6/generic/tkMacWinMenu.c
new file mode 100644
index 0000000..9449838
--- /dev/null
+++ b/tk8.6/generic/tkMacWinMenu.c
@@ -0,0 +1,146 @@
+/*
+ * tkMacWinMenu.c --
+ *
+ * This module implements the common elements of the Mac and Windows
+ * specific features of menus. This file is not used for UNIX.
+ *
+ * Copyright (c) 1996-1997 by Sun Microsystems, Inc.
+ *
+ * See the file "license.terms" for information on usage and redistribution of
+ * this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ */
+
+#include "tkInt.h"
+#include "tkMenu.h"
+
+typedef struct ThreadSpecificData {
+ int postCommandGeneration;
+} ThreadSpecificData;
+static Tcl_ThreadDataKey dataKey;
+
+static int PreprocessMenu(TkMenu *menuPtr);
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * PreprocessMenu --
+ *
+ * The guts of the preprocessing. Recursive.
+ *
+ * Results:
+ * The return value is a standard Tcl result (errors can occur while the
+ * postcommands are being processed).
+ *
+ * Side effects:
+ * Since commands can get executed while this routine is being executed,
+ * the entire world can change.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+PreprocessMenu(
+ TkMenu *menuPtr)
+{
+ int index, result, finished;
+ ThreadSpecificData *tsdPtr =
+ Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
+
+ Tcl_Preserve(menuPtr);
+
+ /*
+ * First, let's process the post command on ourselves. If this command
+ * destroys this menu, or if there was an error, we are done.
+ */
+
+ result = TkPostCommand(menuPtr);
+ if ((result != TCL_OK) || (menuPtr->tkwin == NULL)) {
+ goto done;
+ }
+
+ /*
+ * Now, we go through structure and process all of the commands. Since the
+ * structure is changing, we stop after we do one command, and start over.
+ * When we get through without doing any, we are done.
+ */
+
+ do {
+ finished = 1;
+ for (index = 0; index < menuPtr->numEntries; index++) {
+ register TkMenuEntry *entryPtr = menuPtr->entries[index];
+
+ if ((entryPtr->type == CASCADE_ENTRY)
+ && (entryPtr->namePtr != NULL)
+ && (entryPtr->childMenuRefPtr != NULL)
+ && (entryPtr->childMenuRefPtr->menuPtr != NULL)) {
+ TkMenu *cascadeMenuPtr = entryPtr->childMenuRefPtr->menuPtr;
+
+ if (cascadeMenuPtr->postCommandGeneration !=
+ tsdPtr->postCommandGeneration) {
+ cascadeMenuPtr->postCommandGeneration =
+ tsdPtr->postCommandGeneration;
+ result = PreprocessMenu(cascadeMenuPtr);
+ if (result != TCL_OK) {
+ goto done;
+ }
+ finished = 0;
+ break;
+ }
+ }
+ }
+ } while (!finished);
+
+ done:
+ Tcl_Release(menuPtr);
+ return result;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkPreprocessMenu --
+ *
+ * On the Mac and on Windows, all of the postcommand processing has to be
+ * done on the entire tree underneath the main window to be posted. This
+ * means that we have to traverse the menu tree and issue the
+ * postcommands for all of the menus that have cascades attached. Since
+ * the postcommands can change the menu structure while we are
+ * traversing, we have to be extremely careful. Basically, the idea is to
+ * traverse the structure until we succesfully process one postcommand.
+ * Then we start over, and do it again until we traverse the whole
+ * structure without processing any postcommands.
+ *
+ * We are also going to set up the cascade back pointers in here since we
+ * have to traverse the entire structure underneath the menu anyway. We
+ * can clear the postcommand marks while we do that.
+ *
+ * Results:
+ * The return value is a standard Tcl result (errors can occur while the
+ * postcommands are being processed).
+ *
+ * Side effects:
+ * Since commands can get executed while this routine is being executed,
+ * the entire world can change.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TkPreprocessMenu(
+ TkMenu *menuPtr)
+{
+ ThreadSpecificData *tsdPtr =
+ Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
+
+ tsdPtr->postCommandGeneration++;
+ menuPtr->postCommandGeneration = tsdPtr->postCommandGeneration;
+ return PreprocessMenu(menuPtr);
+}
+
+/*
+ * Local Variables:
+ * mode: c
+ * c-basic-offset: 4
+ * fill-column: 78
+ * End:
+ */
diff --git a/tk8.6/generic/tkMain.c b/tk8.6/generic/tkMain.c
new file mode 100644
index 0000000..1b21223
--- /dev/null
+++ b/tk8.6/generic/tkMain.c
@@ -0,0 +1,549 @@
+/*
+ * tkMain.c --
+ *
+ * This file contains a generic main program for Tk-based applications.
+ * It can be used as-is for many applications, just by supplying a
+ * different appInitProc function for each specific application. Or, it
+ * can be used as a template for creating new main programs for Tk
+ * applications.
+ *
+ * Copyright (c) 1990-1994 The Regents of the University of California.
+ * Copyright (c) 1994-1997 Sun Microsystems, Inc.
+ *
+ * See the file "license.terms" for information on usage and redistribution of
+ * this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ */
+
+/**
+ * On Windows, this file needs to be compiled twice, once with
+ * TK_ASCII_MAIN defined. This way both Tk_MainEx and Tk_MainExW
+ * can be implemented, sharing the same source code.
+ */
+#if defined(TK_ASCII_MAIN)
+# ifdef UNICODE
+# undef UNICODE
+# undef _UNICODE
+# else
+# define UNICODE
+# define _UNICODE
+# endif
+#endif
+
+#include "tkInt.h"
+#include <ctype.h>
+#include <stdio.h>
+#include <string.h>
+#ifdef NO_STDLIB_H
+# include "../compat/stdlib.h"
+#else
+# include <stdlib.h>
+#endif
+
+extern int TkCygwinMainEx(int, char **, Tcl_AppInitProc *, Tcl_Interp *);
+
+/*
+ * The default prompt used when the user has not overridden it.
+ */
+
+#define DEFAULT_PRIMARY_PROMPT "% "
+
+/*
+ * This file can be compiled on Windows in UNICODE mode, as well as
+ * on all other platforms using the native encoding. This is done
+ * by using the normal Windows functions like _tcscmp, but on
+ * platforms which don't have <tchar.h> we have to translate that
+ * to strcmp here.
+ */
+#ifdef _WIN32
+/* Little hack to eliminate the need for "tclInt.h" here:
+ Just copy a small portion of TclIntPlatStubs, just
+ enough to make it work. See [600b72bfbc] */
+typedef struct {
+ int magic;
+ void *hooks;
+ void (*dummy[16]) (void); /* dummy entries 0-15, not used */
+ int (*tclpIsAtty) (int fd); /* 16 */
+} TclIntPlatStubs;
+extern const TclIntPlatStubs *tclIntPlatStubsPtr;
+# include "tkWinInt.h"
+#else
+# define TCHAR char
+# define TEXT(arg) arg
+# define _tcscmp strcmp
+# define _tcslen strlen
+# define _tcsncmp strncmp
+#endif
+
+#ifdef MAC_OSX_TK
+#include "tkMacOSXInt.h"
+#endif
+
+/*
+ * Further on, in UNICODE mode, we need to use Tcl_NewUnicodeObj,
+ * while otherwise NewNativeObj is needed (which provides proper
+ * conversion from native encoding to UTF-8).
+ */
+#ifdef UNICODE
+# define NewNativeObj Tcl_NewUnicodeObj
+#else /* !UNICODE */
+ static Tcl_Obj *NewNativeObj(char *string, int length) {
+ Tcl_Obj *obj;
+ Tcl_DString ds;
+ Tcl_ExternalToUtfDString(NULL, string, length, &ds);
+ obj = Tcl_NewStringObj(Tcl_DStringValue(&ds), Tcl_DStringLength(&ds));
+ Tcl_DStringFree(&ds);
+ return obj;
+}
+#endif /* !UNICODE */
+
+/*
+ * Declarations for various library functions and variables (don't want to
+ * include tkInt.h or tkPort.h here, because people might copy this file out
+ * of the Tk source directory to make their own modified versions). Note: do
+ * not declare "exit" here even though a declaration is really needed, because
+ * it will conflict with a declaration elsewhere on some systems.
+ */
+
+#if defined(_WIN32)
+#define isatty WinIsTty
+static int WinIsTty(int fd) {
+ HANDLE handle;
+
+ /*
+ * For now, under Windows, we assume we are not running as a console mode
+ * app, so we need to use the GUI console. In order to enable this, we
+ * always claim to be running on a tty. This probably isn't the right way
+ * to do it.
+ */
+
+#if !defined(STATIC_BUILD)
+ if (tclStubsPtr->reserved9 && tclIntPlatStubsPtr->tclpIsAtty) {
+ /* We are running on Cygwin */
+ return tclIntPlatStubsPtr->tclpIsAtty(fd);
+ }
+#endif
+ handle = GetStdHandle(STD_INPUT_HANDLE + fd);
+ /*
+ * If it's a bad or closed handle, then it's been connected to a wish
+ * console window. A character file handle is a tty by definition.
+ */
+ return (handle == INVALID_HANDLE_VALUE) || (handle == 0)
+ || (GetFileType(handle) == FILE_TYPE_UNKNOWN)
+ || (GetFileType(handle) == FILE_TYPE_CHAR);
+}
+#else
+extern int isatty(int fd);
+#endif
+
+typedef struct InteractiveState {
+ Tcl_Channel input; /* The standard input channel from which lines
+ * are read. */
+ int tty; /* Non-zero means standard input is a
+ * terminal-like device. Zero means it's a
+ * file. */
+ 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 gotPartial;
+ Tcl_Interp *interp; /* Interpreter that evaluates interactive
+ * commands. */
+} InteractiveState;
+
+/*
+ * Forward declarations for functions defined later in this file.
+ */
+
+static void Prompt(Tcl_Interp *interp, InteractiveState *isPtr);
+static void StdinProc(ClientData clientData, int mask);
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_MainEx --
+ *
+ * Main program for Wish and most other Tk-based applications.
+ *
+ * Results:
+ * None. This function never returns (it exits the process when it's
+ * done).
+ *
+ * Side effects:
+ * This function initializes the Tk world and then starts interpreting
+ * commands; almost anything could happen, depending on the script being
+ * interpreted.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tk_MainEx(
+ int argc, /* Number of arguments. */
+ TCHAR **argv, /* Array of argument strings. */
+ Tcl_AppInitProc *appInitProc,
+ /* Application-specific initialization
+ * function to call after most initialization
+ * but before starting to execute commands. */
+ Tcl_Interp *interp)
+{
+ Tcl_Obj *path, *argvPtr, *appName;
+ const char *encodingName;
+ int code, nullStdin = 0;
+ Tcl_Channel chan;
+ InteractiveState is;
+
+ /*
+ * Ensure that we are getting a compatible version of Tcl.
+ */
+
+ if (Tcl_InitStubs(interp, "8.6", 0) == NULL) {
+ if (Tcl_InitStubs(interp, "8.1", 0) == NULL) {
+ abort();
+ } else {
+ Tcl_Panic("%s", Tcl_GetString(Tcl_GetObjResult(interp)));
+ }
+ }
+
+#if defined(_WIN32) && !defined(UNICODE) && !defined(STATIC_BUILD)
+
+ if (tclStubsPtr->reserved9) {
+ /* We are running win32 Tk under Cygwin, so let's check
+ * whether the env("DISPLAY") variable or the -display
+ * argument is set. If so, we really want to run the
+ * Tk_MainEx function of libtk8.?.dll, not this one. */
+ if (Tcl_GetVar2(interp, "env", "DISPLAY", TCL_GLOBAL_ONLY)) {
+ loadCygwinTk:
+ if (TkCygwinMainEx(argc, argv, appInitProc, interp)) {
+ /* Should never reach here. */
+ return;
+ }
+ } else {
+ int i;
+
+ for (i = 1; i < argc; ++i) {
+ if (!_tcscmp(argv[i], TEXT("-display"))) {
+ goto loadCygwinTk;
+ }
+ }
+ }
+ }
+#endif
+
+ Tcl_InitMemory(interp);
+
+ is.interp = interp;
+ is.gotPartial = 0;
+ Tcl_Preserve(interp);
+
+#if defined(_WIN32) && !defined(__CYGWIN__)
+ Tk_InitConsoleChannels(interp);
+#endif
+
+#ifdef MAC_OSX_TK
+ if (Tcl_GetStartupScript(NULL) == NULL) {
+ TkMacOSXDefaultStartupScript();
+ }
+#endif
+
+ /*
+ * If the application has not already set a startup script, parse the
+ * first few command line arguments to determine the script path and
+ * encoding.
+ */
+
+ if (NULL == Tcl_GetStartupScript(NULL)) {
+ size_t length;
+
+ /*
+ * Check whether first 3 args (argv[1] - argv[3]) look like
+ * -encoding ENCODING FILENAME
+ * or like
+ * FILENAME
+ * or like
+ * -file FILENAME (ancient history support only)
+ */
+
+ if ((argc > 3) && (0 == _tcscmp(TEXT("-encoding"), argv[1]))
+ && (TEXT('-') != argv[3][0])) {
+ Tcl_Obj *value = NewNativeObj(argv[2], -1);
+ Tcl_SetStartupScript(NewNativeObj(argv[3], -1), Tcl_GetString(value));
+ Tcl_DecrRefCount(value);
+ argc -= 3;
+ argv += 3;
+ } else if ((argc > 1) && (TEXT('-') != argv[1][0])) {
+ Tcl_SetStartupScript(NewNativeObj(argv[1], -1), NULL);
+ argc--;
+ argv++;
+ } else if ((argc > 2) && (length = _tcslen(argv[1]))
+ && (length > 1) && (0 == _tcsncmp(TEXT("-file"), argv[1], length))
+ && (TEXT('-') != argv[2][0])) {
+ Tcl_SetStartupScript(NewNativeObj(argv[2], -1), NULL);
+ argc -= 2;
+ argv += 2;
+ }
+ }
+
+ path = Tcl_GetStartupScript(&encodingName);
+ if (path == NULL) {
+ appName = NewNativeObj(argv[0], -1);
+ } else {
+ appName = path;
+ }
+ Tcl_SetVar2Ex(interp, "argv0", NULL, appName, TCL_GLOBAL_ONLY);
+ argc--;
+ argv++;
+
+ Tcl_SetVar2Ex(interp, "argc", NULL, Tcl_NewIntObj(argc), TCL_GLOBAL_ONLY);
+
+ argvPtr = Tcl_NewListObj(0, NULL);
+ while (argc--) {
+ Tcl_ListObjAppendElement(NULL, argvPtr, NewNativeObj(*argv++, -1));
+ }
+ Tcl_SetVar2Ex(interp, "argv", NULL, argvPtr, TCL_GLOBAL_ONLY);
+
+ /*
+ * Set the "tcl_interactive" variable.
+ */
+
+ is.tty = isatty(0);
+#if defined(MAC_OSX_TK)
+ /*
+ * On TkAqua, if we don't have a TTY and stdin is a special character file
+ * of length 0, (e.g. /dev/null, which is what Finder sets when double
+ * clicking Wish) then use the GUI console.
+ */
+
+ if (!is.tty) {
+ struct stat st;
+
+ nullStdin = fstat(0, &st) || (S_ISCHR(st.st_mode) && !st.st_blocks);
+ }
+#endif
+ Tcl_SetVar2Ex(interp, "tcl_interactive", NULL,
+ Tcl_NewIntObj(!path && (is.tty || nullStdin)), TCL_GLOBAL_ONLY);
+
+ /*
+ * Invoke application-specific initialization.
+ */
+
+ if (appInitProc(interp) != TCL_OK) {
+ TkpDisplayWarning(Tcl_GetString(Tcl_GetObjResult(interp)),
+ "application-specific initialization failed");
+ }
+
+ /*
+ * Invoke the script specified on the command line, if any. Must fetch it
+ * again, as the appInitProc might have reset it.
+ */
+
+ path = Tcl_GetStartupScript(&encodingName);
+ if (path != NULL) {
+ Tcl_ResetResult(interp);
+ code = Tcl_FSEvalFileEx(interp, path, encodingName);
+ if (code != TCL_OK) {
+ /*
+ * The following statement guarantees that the errorInfo variable
+ * is set properly.
+ */
+
+ Tcl_AddErrorInfo(interp, "");
+ TkpDisplayWarning(Tcl_GetVar2(interp, "errorInfo", NULL,
+ TCL_GLOBAL_ONLY), "Error in startup script");
+ Tcl_DeleteInterp(interp);
+ Tcl_Exit(1);
+ }
+ is.tty = 0;
+ } else {
+
+ /*
+ * Evaluate the .rc file, if one has been specified.
+ */
+
+ Tcl_SourceRCFile(interp);
+
+ /*
+ * Establish a channel handler for stdin.
+ */
+
+ is.input = Tcl_GetStdChannel(TCL_STDIN);
+ if (is.input) {
+ Tcl_CreateChannelHandler(is.input, TCL_READABLE, StdinProc, &is);
+ }
+ if (is.tty) {
+ Prompt(interp, &is);
+ }
+ }
+
+ chan = Tcl_GetStdChannel(TCL_STDOUT);
+ if (chan) {
+ Tcl_Flush(chan);
+ }
+ Tcl_DStringInit(&is.command);
+ Tcl_DStringInit(&is.line);
+ Tcl_ResetResult(interp);
+
+ /*
+ * Loop infinitely, waiting for commands to execute. When there are no
+ * windows left, Tk_MainLoop returns and we exit.
+ */
+
+ Tk_MainLoop();
+ Tcl_DeleteInterp(interp);
+ Tcl_Release(interp);
+ Tcl_SetStartupScript(NULL, NULL);
+ Tcl_Exit(0);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * StdinProc --
+ *
+ * This function is invoked by the event dispatcher whenever standard
+ * input becomes readable. It grabs the next line of input characters,
+ * adds them to a command being assembled, and executes the command if
+ * it's complete.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Could be almost arbitrary, depending on the command that's typed.
+ *
+ *----------------------------------------------------------------------
+ */
+
+ /* ARGSUSED */
+static void
+StdinProc(
+ ClientData clientData, /* The state of interactive cmd line */
+ int mask) /* Not used. */
+{
+ char *cmd;
+ int code, count;
+ InteractiveState *isPtr = clientData;
+ Tcl_Channel chan = isPtr->input;
+ Tcl_Interp *interp = isPtr->interp;
+
+ count = Tcl_Gets(chan, &isPtr->line);
+
+ if (count < 0 && !isPtr->gotPartial) {
+ if (isPtr->tty) {
+ Tcl_Exit(0);
+ } else {
+ Tcl_DeleteChannelHandler(chan, StdinProc, isPtr);
+ }
+ return;
+ }
+
+ Tcl_DStringAppend(&isPtr->command, Tcl_DStringValue(&isPtr->line), -1);
+ cmd = Tcl_DStringAppend(&isPtr->command, "\n", -1);
+ Tcl_DStringFree(&isPtr->line);
+ if (!Tcl_CommandComplete(cmd)) {
+ isPtr->gotPartial = 1;
+ goto prompt;
+ }
+ isPtr->gotPartial = 0;
+
+ /*
+ * Disable the stdin channel handler while evaluating the command;
+ * otherwise if the command re-enters the event loop we might process
+ * commands from stdin before the current command is finished. Among other
+ * things, this will trash the text of the command being evaluated.
+ */
+
+ Tcl_CreateChannelHandler(chan, 0, StdinProc, isPtr);
+ code = Tcl_RecordAndEval(interp, cmd, TCL_EVAL_GLOBAL);
+
+ isPtr->input = Tcl_GetStdChannel(TCL_STDIN);
+ if (isPtr->input) {
+ Tcl_CreateChannelHandler(isPtr->input, TCL_READABLE, StdinProc, isPtr);
+ }
+ Tcl_DStringFree(&isPtr->command);
+ if (Tcl_GetString(Tcl_GetObjResult(interp))[0] != '\0') {
+ if ((code != TCL_OK) || (isPtr->tty)) {
+ chan = Tcl_GetStdChannel((code != TCL_OK) ? TCL_STDERR : TCL_STDOUT);
+ if (chan) {
+ Tcl_WriteObj(chan, Tcl_GetObjResult(interp));
+ Tcl_WriteChars(chan, "\n", 1);
+ }
+ }
+ }
+
+ /*
+ * If a tty stdin is still around, output a prompt.
+ */
+
+ prompt:
+ if (isPtr->tty && (isPtr->input != NULL)) {
+ Prompt(interp, isPtr);
+ }
+ Tcl_ResetResult(interp);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Prompt --
+ *
+ * Issue a prompt on standard output, or invoke a script to issue the
+ * prompt.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * A prompt gets output, and a Tcl script may be evaluated in interp.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+Prompt(
+ Tcl_Interp *interp, /* Interpreter to use for prompting. */
+ InteractiveState *isPtr) /* InteractiveState. */
+{
+ Tcl_Obj *promptCmdPtr;
+ int code;
+ Tcl_Channel chan;
+
+ promptCmdPtr = Tcl_GetVar2Ex(interp,
+ isPtr->gotPartial ? "tcl_prompt2" : "tcl_prompt1", NULL, TCL_GLOBAL_ONLY);
+ if (promptCmdPtr == NULL) {
+ defaultPrompt:
+ if (!isPtr->gotPartial) {
+ chan = Tcl_GetStdChannel(TCL_STDOUT);
+ if (chan != NULL) {
+ Tcl_WriteChars(chan, DEFAULT_PRIMARY_PROMPT,
+ strlen(DEFAULT_PRIMARY_PROMPT));
+ }
+ }
+ } else {
+ code = Tcl_EvalObjEx(interp, promptCmdPtr, TCL_EVAL_GLOBAL);
+ if (code != TCL_OK) {
+ Tcl_AddErrorInfo(interp,
+ "\n (script that generates prompt)");
+ if (Tcl_GetString(Tcl_GetObjResult(interp))[0] != '\0') {
+ chan = Tcl_GetStdChannel(TCL_STDERR);
+ if (chan != NULL) {
+ Tcl_WriteObj(chan, Tcl_GetObjResult(interp));
+ Tcl_WriteChars(chan, "\n", 1);
+ }
+ }
+ goto defaultPrompt;
+ }
+ }
+
+ chan = Tcl_GetStdChannel(TCL_STDOUT);
+ if (chan != NULL) {
+ Tcl_Flush(chan);
+ }
+}
+
+/*
+ * Local Variables:
+ * mode: c
+ * c-basic-offset: 4
+ * fill-column: 78
+ * End:
+ */
diff --git a/tk8.6/generic/tkMenu.c b/tk8.6/generic/tkMenu.c
new file mode 100644
index 0000000..d24516f
--- /dev/null
+++ b/tk8.6/generic/tkMenu.c
@@ -0,0 +1,3611 @@
+/*
+ * tkMenu.c --
+ *
+ * This file contains most of the code for implementing menus in Tk. It takes
+ * care of all of the generic (platform-independent) parts of menus, and is
+ * supplemented by platform-specific files. The geometry calculation and
+ * drawing code for menus is in the file tkMenuDraw.c
+ *
+ * Copyright (c) 1990-1994 The Regents of the University of California.
+ * Copyright (c) 1994-1998 Sun Microsystems, Inc.
+ *
+ * See the file "license.terms" for information on usage and redistribution of
+ * this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ */
+
+/*
+ * Notes on implementation of menus:
+ *
+ * Menus can be used in three ways:
+ * - as a popup menu, either as part of a menubutton or standalone.
+ * - as a menubar. The menu's cascade items are arranged according to the
+ * specific platform to provide the user access to the menus at all times
+ * - as a tearoff palette. This is a window with the menu's items in it.
+ *
+ * The goal is to provide the Tk developer with a way to use a common set of
+ * menus for all of these tasks.
+ *
+ * In order to make the bindings for cascade menus work properly under Unix,
+ * the cascade menus' pathnames must be proper children of the menu that they
+ * are cascade from. So if there is a menu .m, and it has two cascades
+ * labelled "File" and "Edit", the cascade menus might have the pathnames
+ * .m.file and .m.edit. Another constraint is that the menus used for menubars
+ * must be children of the toplevel widget that they are attached to. And on
+ * the Macintosh, the platform specific menu handle for cascades attached to a
+ * menu bar must have a title that matches the label for the cascade menu.
+ *
+ * To handle all of the constraints, Tk menubars and tearoff menus are
+ * implemented using menu clones. Menu clones are full menus in their own
+ * right; they have a Tk window and pathname associated with them; they have a
+ * TkMenu structure and array of entries. However, they are linked with the
+ * original menu that they were cloned from. The reflect the attributes of the
+ * original, or "master", menu. So if an item is added to a menu, and that
+ * menu has clones, then the item must be added to all of its clones also.
+ * Menus are cloned when a menu is torn-off or when a menu is assigned as a
+ * menubar using the "-menu" option of the toplevel's pathname configure
+ * subcommand. When a clone is destroyed, only the clone is destroyed, but
+ * when the master menu is destroyed, all clones are also destroyed. This
+ * allows the developer to just deal with one set of menus when creating and
+ * destroying.
+ *
+ * Clones are rather tricky when a menu with cascade entries is cloned (such
+ * as a menubar). Not only does the menu have to be cloned, but each cascade
+ * entry's corresponding menu must also be cloned. This maintains the pathname
+ * parent-child hierarchy necessary for menubars and toplevels to work. This
+ * leads to several special cases:
+ *
+ * 1. When a new menu is created, and it is pointed to by cascade entries in
+ * cloned menus, the new menu has to be cloned to parallel the cascade
+ * structure.
+ * 2. When a cascade item is added to a menu that has been cloned, and the
+ * menu that the cascade item points to exists, that menu has to be cloned.
+ * 3. When the menu that a cascade entry points to is changed, the old cloned
+ * cascade menu has to be discarded, and the new one has to be cloned.
+ */
+
+#if 0
+
+/*
+ * used only to test for old config code
+ */
+
+#define __NO_OLD_CONFIG
+#endif
+
+#include "tkInt.h"
+#include "tkMenu.h"
+
+#define MENU_HASH_KEY "tkMenus"
+
+typedef struct ThreadSpecificData {
+ int menusInitialized; /* Flag indicates whether thread-specific
+ * elements of the Windows Menu module have
+ * been initialized. */
+ Tk_OptionTable menuOptionTable;
+ /* The option table for menus. */
+ Tk_OptionTable entryOptionTables[6];
+ /* The tables for menu entries. */
+} 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.
+ */
+
+static const char *const menuStateStrings[] = {"active", "normal", "disabled", NULL};
+
+static const char *const menuEntryTypeStrings[] = {
+ "cascade", "checkbutton", "command", "radiobutton", "separator", NULL
+};
+
+/*
+ * The following table defines the legal values for the -compound option. It
+ * is used with the "enum compound" declaration in tkMenu.h
+ */
+
+static const char *const compoundStrings[] = {
+ "bottom", "center", "left", "none", "right", "top", NULL
+};
+
+static const Tk_OptionSpec tkBasicMenuEntryConfigSpecs[] = {
+ {TK_OPTION_BORDER, "-activebackground", NULL, NULL,
+ DEF_MENU_ENTRY_ACTIVE_BG, Tk_Offset(TkMenuEntry, activeBorderPtr), -1,
+ TK_OPTION_NULL_OK, NULL, 0},
+ {TK_OPTION_COLOR, "-activeforeground", NULL, NULL,
+ DEF_MENU_ENTRY_ACTIVE_FG,
+ Tk_Offset(TkMenuEntry, activeFgPtr), -1, TK_OPTION_NULL_OK, NULL, 0},
+ {TK_OPTION_STRING, "-accelerator", NULL, NULL,
+ DEF_MENU_ENTRY_ACCELERATOR,
+ Tk_Offset(TkMenuEntry, accelPtr), -1, TK_OPTION_NULL_OK, NULL, 0},
+ {TK_OPTION_BORDER, "-background", NULL, NULL,
+ DEF_MENU_ENTRY_BG,
+ Tk_Offset(TkMenuEntry, borderPtr), -1, TK_OPTION_NULL_OK, NULL, 0},
+ {TK_OPTION_BITMAP, "-bitmap", NULL, NULL,
+ DEF_MENU_ENTRY_BITMAP,
+ Tk_Offset(TkMenuEntry, bitmapPtr), -1, TK_OPTION_NULL_OK, NULL, 0},
+ {TK_OPTION_BOOLEAN, "-columnbreak", NULL, NULL,
+ DEF_MENU_ENTRY_COLUMN_BREAK,
+ -1, Tk_Offset(TkMenuEntry, columnBreak), 0, NULL, 0},
+ {TK_OPTION_STRING, "-command", NULL, NULL,
+ DEF_MENU_ENTRY_COMMAND,
+ Tk_Offset(TkMenuEntry, commandPtr), -1, TK_OPTION_NULL_OK, NULL, 0},
+ {TK_OPTION_STRING_TABLE, "-compound", "compound", "Compound",
+ DEF_MENU_ENTRY_COMPOUND, -1, Tk_Offset(TkMenuEntry, compound), 0,
+ (ClientData) compoundStrings, 0},
+ {TK_OPTION_FONT, "-font", NULL, NULL,
+ DEF_MENU_ENTRY_FONT,
+ Tk_Offset(TkMenuEntry, fontPtr), -1, TK_OPTION_NULL_OK, NULL, 0},
+ {TK_OPTION_COLOR, "-foreground", NULL, NULL,
+ DEF_MENU_ENTRY_FG,
+ Tk_Offset(TkMenuEntry, fgPtr), -1, TK_OPTION_NULL_OK, NULL, 0},
+ {TK_OPTION_BOOLEAN, "-hidemargin", NULL, NULL,
+ DEF_MENU_ENTRY_HIDE_MARGIN,
+ -1, Tk_Offset(TkMenuEntry, hideMargin), 0, NULL, 0},
+ {TK_OPTION_STRING, "-image", NULL, NULL,
+ DEF_MENU_ENTRY_IMAGE,
+ Tk_Offset(TkMenuEntry, imagePtr), -1, TK_OPTION_NULL_OK, NULL, 0},
+ {TK_OPTION_STRING, "-label", NULL, NULL,
+ DEF_MENU_ENTRY_LABEL,
+ Tk_Offset(TkMenuEntry, labelPtr), -1, 0, NULL, 0},
+ {TK_OPTION_STRING_TABLE, "-state", NULL, NULL,
+ DEF_MENU_ENTRY_STATE,
+ -1, Tk_Offset(TkMenuEntry, state), 0,
+ (ClientData) menuStateStrings, 0},
+ {TK_OPTION_INT, "-underline", NULL, NULL,
+ DEF_MENU_ENTRY_UNDERLINE, -1, Tk_Offset(TkMenuEntry, underline), 0, NULL, 0},
+ {TK_OPTION_END, NULL, NULL, NULL, 0, 0, 0, 0, NULL, 0}
+};
+
+static const Tk_OptionSpec tkSeparatorEntryConfigSpecs[] = {
+ {TK_OPTION_BORDER, "-background", NULL, NULL,
+ DEF_MENU_ENTRY_BG,
+ Tk_Offset(TkMenuEntry, borderPtr), -1, TK_OPTION_NULL_OK, NULL, 0},
+ {TK_OPTION_END, NULL, NULL, NULL, 0, 0, 0, 0, NULL, 0}
+};
+
+static const Tk_OptionSpec tkCheckButtonEntryConfigSpecs[] = {
+ {TK_OPTION_BOOLEAN, "-indicatoron", NULL, NULL,
+ DEF_MENU_ENTRY_INDICATOR,
+ -1, Tk_Offset(TkMenuEntry, indicatorOn), 0, NULL, 0},
+ {TK_OPTION_STRING, "-offvalue", NULL, NULL,
+ DEF_MENU_ENTRY_OFF_VALUE,
+ Tk_Offset(TkMenuEntry, offValuePtr), -1, 0, NULL, 0},
+ {TK_OPTION_STRING, "-onvalue", NULL, NULL,
+ DEF_MENU_ENTRY_ON_VALUE,
+ Tk_Offset(TkMenuEntry, onValuePtr), -1, 0, NULL, 0},
+ {TK_OPTION_COLOR, "-selectcolor", NULL, NULL,
+ DEF_MENU_ENTRY_SELECT,
+ Tk_Offset(TkMenuEntry, indicatorFgPtr), -1, TK_OPTION_NULL_OK, NULL, 0},
+ {TK_OPTION_STRING, "-selectimage", NULL, NULL,
+ DEF_MENU_ENTRY_SELECT_IMAGE,
+ Tk_Offset(TkMenuEntry, selectImagePtr), -1, TK_OPTION_NULL_OK, NULL, 0},
+ {TK_OPTION_STRING, "-variable", NULL, NULL,
+ DEF_MENU_ENTRY_CHECK_VARIABLE,
+ Tk_Offset(TkMenuEntry, namePtr), -1, TK_OPTION_NULL_OK, NULL, 0},
+ {TK_OPTION_END, NULL, NULL, NULL,
+ NULL, 0, -1, 0, tkBasicMenuEntryConfigSpecs, 0}
+};
+
+static const Tk_OptionSpec tkRadioButtonEntryConfigSpecs[] = {
+ {TK_OPTION_BOOLEAN, "-indicatoron", NULL, NULL,
+ DEF_MENU_ENTRY_INDICATOR,
+ -1, Tk_Offset(TkMenuEntry, indicatorOn), 0, NULL, 0},
+ {TK_OPTION_COLOR, "-selectcolor", NULL, NULL,
+ DEF_MENU_ENTRY_SELECT,
+ Tk_Offset(TkMenuEntry, indicatorFgPtr), -1, TK_OPTION_NULL_OK, NULL, 0},
+ {TK_OPTION_STRING, "-selectimage", NULL, NULL,
+ DEF_MENU_ENTRY_SELECT_IMAGE,
+ Tk_Offset(TkMenuEntry, selectImagePtr), -1, TK_OPTION_NULL_OK, NULL, 0},
+ {TK_OPTION_STRING, "-value", NULL, NULL,
+ DEF_MENU_ENTRY_VALUE,
+ Tk_Offset(TkMenuEntry, onValuePtr), -1, TK_OPTION_NULL_OK, NULL, 0},
+ {TK_OPTION_STRING, "-variable", NULL, NULL,
+ DEF_MENU_ENTRY_RADIO_VARIABLE,
+ Tk_Offset(TkMenuEntry, namePtr), -1, 0, NULL, 0},
+ {TK_OPTION_END, NULL, NULL, NULL,
+ NULL, 0, -1, 0, tkBasicMenuEntryConfigSpecs, 0}
+};
+
+static const Tk_OptionSpec tkCascadeEntryConfigSpecs[] = {
+ {TK_OPTION_STRING, "-menu", NULL, NULL,
+ DEF_MENU_ENTRY_MENU,
+ Tk_Offset(TkMenuEntry, namePtr), -1, TK_OPTION_NULL_OK, NULL, 0},
+ {TK_OPTION_END, NULL, NULL, NULL,
+ NULL, 0, -1, 0, tkBasicMenuEntryConfigSpecs, 0}
+};
+
+static const Tk_OptionSpec tkTearoffEntryConfigSpecs[] = {
+ {TK_OPTION_BORDER, "-background", NULL, NULL,
+ DEF_MENU_ENTRY_BG,
+ Tk_Offset(TkMenuEntry, borderPtr), -1, TK_OPTION_NULL_OK, NULL, 0},
+ {TK_OPTION_STRING_TABLE, "-state", NULL, NULL,
+ DEF_MENU_ENTRY_STATE, -1, Tk_Offset(TkMenuEntry, state), 0,
+ (ClientData) menuStateStrings, 0},
+ {TK_OPTION_END, NULL, NULL, NULL, 0, 0, 0, 0, NULL, 0}
+};
+
+static const Tk_OptionSpec *specsArray[] = {
+ tkCascadeEntryConfigSpecs, tkCheckButtonEntryConfigSpecs,
+ tkBasicMenuEntryConfigSpecs, tkRadioButtonEntryConfigSpecs,
+ tkSeparatorEntryConfigSpecs, tkTearoffEntryConfigSpecs
+};
+
+/*
+ * Menu type strings for use with Tcl_GetIndexFromObj.
+ */
+
+static const char *const menuTypeStrings[] = {
+ "normal", "tearoff", "menubar", NULL
+};
+
+static const 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, 0},
+ {TK_OPTION_PIXELS, "-activeborderwidth", "activeBorderWidth",
+ "BorderWidth", DEF_MENU_ACTIVE_BORDER_WIDTH,
+ Tk_Offset(TkMenu, activeBorderWidthPtr), -1, 0, NULL, 0},
+ {TK_OPTION_COLOR, "-activeforeground", "activeForeground",
+ "Background", DEF_MENU_ACTIVE_FG_COLOR,
+ Tk_Offset(TkMenu, activeFgPtr), -1, 0,
+ (ClientData) DEF_MENU_ACTIVE_FG_MONO, 0},
+ {TK_OPTION_BORDER, "-background", "background", "Background",
+ DEF_MENU_BG_COLOR, Tk_Offset(TkMenu, borderPtr), -1, 0,
+ (ClientData) DEF_MENU_BG_MONO, 0},
+ {TK_OPTION_SYNONYM, "-bd", NULL, NULL,
+ NULL, 0, -1, 0, "-borderwidth", 0},
+ {TK_OPTION_SYNONYM, "-bg", NULL, NULL,
+ NULL, 0, -1, 0, "-background", 0},
+ {TK_OPTION_PIXELS, "-borderwidth", "borderWidth", "BorderWidth",
+ DEF_MENU_BORDER_WIDTH,
+ Tk_Offset(TkMenu, borderWidthPtr), -1, 0, NULL, 0},
+ {TK_OPTION_CURSOR, "-cursor", "cursor", "Cursor",
+ DEF_MENU_CURSOR,
+ Tk_Offset(TkMenu, cursorPtr), -1, TK_OPTION_NULL_OK, NULL, 0},
+ {TK_OPTION_COLOR, "-disabledforeground", "disabledForeground",
+ "DisabledForeground", DEF_MENU_DISABLED_FG_COLOR,
+ Tk_Offset(TkMenu, disabledFgPtr), -1, TK_OPTION_NULL_OK,
+ (ClientData) DEF_MENU_DISABLED_FG_MONO, 0},
+ {TK_OPTION_SYNONYM, "-fg", NULL, NULL,
+ NULL, 0, -1, 0, "-foreground", 0},
+ {TK_OPTION_FONT, "-font", "font", "Font",
+ DEF_MENU_FONT, Tk_Offset(TkMenu, fontPtr), -1, 0, NULL, 0},
+ {TK_OPTION_COLOR, "-foreground", "foreground", "Foreground",
+ DEF_MENU_FG, Tk_Offset(TkMenu, fgPtr), -1, 0, NULL, 0},
+ {TK_OPTION_STRING, "-postcommand", "postCommand", "Command",
+ DEF_MENU_POST_COMMAND,
+ Tk_Offset(TkMenu, postCommandPtr), -1, TK_OPTION_NULL_OK, NULL, 0},
+ {TK_OPTION_RELIEF, "-relief", "relief", "Relief",
+ DEF_MENU_RELIEF, Tk_Offset(TkMenu, reliefPtr), -1, 0, NULL, 0},
+ {TK_OPTION_COLOR, "-selectcolor", "selectColor", "Background",
+ DEF_MENU_SELECT_COLOR, Tk_Offset(TkMenu, indicatorFgPtr), -1, 0,
+ (ClientData) DEF_MENU_SELECT_MONO, 0},
+ {TK_OPTION_STRING, "-takefocus", "takeFocus", "TakeFocus",
+ DEF_MENU_TAKE_FOCUS,
+ Tk_Offset(TkMenu, takeFocusPtr), -1, TK_OPTION_NULL_OK, NULL, 0},
+ {TK_OPTION_BOOLEAN, "-tearoff", "tearOff", "TearOff",
+ DEF_MENU_TEAROFF, -1, Tk_Offset(TkMenu, tearoff), 0, NULL, 0},
+ {TK_OPTION_STRING, "-tearoffcommand", "tearOffCommand",
+ "TearOffCommand", DEF_MENU_TEAROFF_CMD,
+ Tk_Offset(TkMenu, tearoffCommandPtr), -1, TK_OPTION_NULL_OK, NULL, 0},
+ {TK_OPTION_STRING, "-title", "title", "Title",
+ DEF_MENU_TITLE, Tk_Offset(TkMenu, titlePtr), -1,
+ TK_OPTION_NULL_OK, NULL, 0},
+ {TK_OPTION_STRING_TABLE, "-type", "type", "Type",
+ DEF_MENU_TYPE, Tk_Offset(TkMenu, menuTypePtr), -1, TK_OPTION_NULL_OK,
+ (ClientData) menuTypeStrings, 0},
+ {TK_OPTION_END, NULL, NULL, NULL, 0, 0, 0, 0, NULL, 0}
+};
+
+/*
+ * Command line options. Put here because MenuCmd has to look at them along
+ * with MenuWidgetObjCmd.
+ */
+
+static const char *const menuOptions[] = {
+ "activate", "add", "cget", "clone", "configure", "delete", "entrycget",
+ "entryconfigure", "index", "insert", "invoke", "post", "postcascade",
+ "type", "unpost", "xposition", "yposition", 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_XPOSITION, MENU_YPOSITION
+};
+
+/*
+ * Prototypes for static functions in this file:
+ */
+
+static int CloneMenu(TkMenu *menuPtr, Tcl_Obj *newMenuName,
+ Tcl_Obj *newMenuTypeString);
+static int ConfigureMenu(Tcl_Interp *interp, TkMenu *menuPtr,
+ int objc, Tcl_Obj *const objv[]);
+static int ConfigureMenuCloneEntries(Tcl_Interp *interp,
+ TkMenu *menuPtr, int index,
+ int objc, Tcl_Obj *const objv[]);
+static int ConfigureMenuEntry(TkMenuEntry *mePtr,
+ int objc, Tcl_Obj *const objv[]);
+static void DeleteMenuCloneEntries(TkMenu *menuPtr,
+ int first, int last);
+static void DestroyMenuHashTable(ClientData clientData,
+ Tcl_Interp *interp);
+static void DestroyMenuInstance(TkMenu *menuPtr);
+static void DestroyMenuEntry(void *memPtr);
+static int GetIndexFromCoords(Tcl_Interp *interp,
+ TkMenu *menuPtr, const char *string,
+ int *indexPtr);
+static int MenuDoYPosition(Tcl_Interp *interp,
+ TkMenu *menuPtr, Tcl_Obj *objPtr);
+static int MenuDoXPosition(Tcl_Interp *interp,
+ TkMenu *menuPtr, Tcl_Obj *objPtr);
+static int MenuAddOrInsert(Tcl_Interp *interp,
+ TkMenu *menuPtr, Tcl_Obj *indexPtr, int objc,
+ Tcl_Obj *const objv[]);
+static void MenuCmdDeletedProc(ClientData clientData);
+static TkMenuEntry * MenuNewEntry(TkMenu *menuPtr, int index, int type);
+static char * MenuVarProc(ClientData clientData,
+ Tcl_Interp *interp, const char *name1,
+ const char *name2, int flags);
+static int MenuWidgetObjCmd(ClientData clientData,
+ Tcl_Interp *interp, int objc,
+ Tcl_Obj *const objv[]);
+static void MenuWorldChanged(ClientData instanceData);
+static int PostProcessEntry(TkMenuEntry *mePtr);
+static void RecursivelyDeleteMenu(TkMenu *menuPtr);
+static void UnhookCascadeEntry(TkMenuEntry *mePtr);
+static void TkMenuCleanup(ClientData unused);
+
+/*
+ * The structure below is a list of procs that respond to certain window
+ * manager events. One of these includes a font change, which forces the
+ * geometry proc to be called.
+ */
+
+static const Tk_ClassProcs menuClass = {
+ sizeof(Tk_ClassProcs), /* size */
+ MenuWorldChanged, /* worldChangedProc */
+ NULL, /* createProc */
+ NULL /* modalProc */
+};
+
+/*
+ *--------------------------------------------------------------
+ *
+ * Tk_MenuObjCmd --
+ *
+ * This function is invoked to process the "menu" Tcl command. See the
+ * user documentation for details on what it does.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * See the user documentation.
+ *
+ *--------------------------------------------------------------
+ */
+
+int
+Tk_MenuObjCmd(
+ ClientData clientData, /* Main window associated with interpreter. */
+ Tcl_Interp *interp, /* Current interpreter. */
+ int objc, /* Number of arguments. */
+ Tcl_Obj *const objv[]) /* Argument strings. */
+{
+ Tk_Window tkwin = clientData;
+ Tk_Window newWin;
+ register TkMenu *menuPtr;
+ TkMenuReferences *menuRefPtr;
+ int i, index, toplevel;
+ const char *windowName;
+ static const char *const typeStringList[] = {"-type", NULL};
+ ThreadSpecificData *tsdPtr =
+ Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
+
+ if (objc < 2) {
+ Tcl_WrongNumArgs(interp, 1, objv, "pathName ?-option value ...?");
+ return TCL_ERROR;
+ }
+
+ TkMenuInit();
+
+ toplevel = 1;
+ for (i = 2; i < (objc - 1); i++) {
+ if (Tcl_GetIndexFromObjStruct(NULL, objv[i], typeStringList,
+ sizeof(char *), NULL, 0, &index) != TCL_ERROR) {
+ if ((Tcl_GetIndexFromObjStruct(NULL, objv[i + 1], menuTypeStrings,
+ sizeof(char *), NULL, 0, &index) == TCL_OK) && (index == MENUBAR)) {
+ toplevel = 0;
+ }
+ break;
+ }
+ }
+
+ windowName = Tcl_GetString(objv[1]);
+ newWin = Tk_CreateWindowFromPath(interp, tkwin, windowName,
+ toplevel ? "" : NULL);
+ if (newWin == NULL) {
+ return TCL_ERROR;
+ }
+
+ /*
+ * Initialize the data structure for the menu. Note that the menuPtr is
+ * eventually freed in 'TkMenuEventProc' in tkMenuDraw.c, when
+ * Tcl_EventuallyFree is called.
+ */
+
+ menuPtr = ckalloc(sizeof(TkMenu));
+ memset(menuPtr, 0, sizeof(TkMenu));
+ menuPtr->tkwin = newWin;
+ menuPtr->display = Tk_Display(newWin);
+ menuPtr->interp = interp;
+ menuPtr->widgetCmd = Tcl_CreateObjCommand(interp,
+ Tk_PathName(menuPtr->tkwin), MenuWidgetObjCmd, menuPtr,
+ MenuCmdDeletedProc);
+ menuPtr->active = -1;
+ menuPtr->cursorPtr = None;
+ menuPtr->masterMenuPtr = menuPtr;
+ menuPtr->menuType = UNKNOWN_TYPE;
+ TkMenuInitializeDrawingFields(menuPtr);
+
+ Tk_SetClass(menuPtr->tkwin, "Menu");
+ Tk_SetClassProcs(menuPtr->tkwin, &menuClass, menuPtr);
+ Tk_CreateEventHandler(newWin,
+ ExposureMask|StructureNotifyMask|ActivateMask,
+ TkMenuEventProc, menuPtr);
+ if (Tk_InitOptions(interp, (char *) menuPtr,
+ tsdPtr->menuOptionTable, menuPtr->tkwin)
+ != TCL_OK) {
+ Tk_DestroyWindow(menuPtr->tkwin);
+ return TCL_ERROR;
+ }
+
+
+ menuRefPtr = TkCreateMenuReferences(menuPtr->interp,
+ Tk_PathName(menuPtr->tkwin));
+ menuRefPtr->menuPtr = menuPtr;
+ menuPtr->menuRefPtr = menuRefPtr;
+ if (TCL_OK != TkpNewMenu(menuPtr)) {
+ Tk_DestroyWindow(menuPtr->tkwin);
+ return TCL_ERROR;
+ }
+
+ if (ConfigureMenu(interp, menuPtr, objc - 2, objv + 2) != TCL_OK) {
+ Tk_DestroyWindow(menuPtr->tkwin);
+ return TCL_ERROR;
+ }
+
+ /*
+ * If a menu has a parent menu pointing to it as a cascade entry, the
+ * parent menu needs to be told that this menu now exists so that the
+ * platform-part of the menu is correctly updated.
+ *
+ * If a menu has an instance and has cascade entries, then each cascade
+ * menu must also have a parallel instance. This is especially true on the
+ * Mac, where each menu has to have a separate title everytime it is in a
+ * menubar. For instance, say you have a menu .m1 with a cascade entry for
+ * .m2, where .m2 does not exist yet. You then put .m1 into a menubar.
+ * This creates a menubar instance for .m1, but since .m2 is not there,
+ * nothing else happens. When we go to create .m2, we hook it up properly
+ * with .m1. However, we now need to clone .m2 and assign the clone of .m2
+ * to be the cascade entry for the clone of .m1. This is special case #1
+ * listed in the introductory comment.
+ */
+
+ if (menuRefPtr->parentEntryPtr != NULL) {
+ TkMenuEntry *cascadeListPtr = menuRefPtr->parentEntryPtr;
+ TkMenuEntry *nextCascadePtr;
+ Tcl_Obj *newMenuName, *newObjv[2];
+
+ while (cascadeListPtr != NULL) {
+ nextCascadePtr = cascadeListPtr->nextCascadePtr;
+
+ /*
+ * If we have a new master menu, and an existing cloned menu
+ * points to this menu in a cascade entry, we have to clone the
+ * new menu and point the entry to the clone instead of the menu
+ * we are creating. Otherwise, ConfigureMenuEntry will hook up the
+ * platform-specific cascade linkages now that the menu we are
+ * creating exists.
+ */
+
+ if ((menuPtr->masterMenuPtr != menuPtr)
+ || ((menuPtr->masterMenuPtr == menuPtr)
+ && ((cascadeListPtr->menuPtr->masterMenuPtr
+ == cascadeListPtr->menuPtr)))) {
+ newObjv[0] = Tcl_NewStringObj("-menu", -1);
+ newObjv[1] = Tcl_NewStringObj(Tk_PathName(menuPtr->tkwin),-1);
+ Tcl_IncrRefCount(newObjv[0]);
+ Tcl_IncrRefCount(newObjv[1]);
+ ConfigureMenuEntry(cascadeListPtr, 2, newObjv);
+ Tcl_DecrRefCount(newObjv[0]);
+ Tcl_DecrRefCount(newObjv[1]);
+ } else {
+ Tcl_Obj *normalPtr = Tcl_NewStringObj("normal", -1);
+ Tcl_Obj *windowNamePtr = Tcl_NewStringObj(
+ Tk_PathName(cascadeListPtr->menuPtr->tkwin), -1);
+
+ Tcl_IncrRefCount(normalPtr);
+ Tcl_IncrRefCount(windowNamePtr);
+ newMenuName = TkNewMenuName(menuPtr->interp,
+ windowNamePtr, menuPtr);
+ Tcl_IncrRefCount(newMenuName);
+ CloneMenu(menuPtr, newMenuName, normalPtr);
+
+ /*
+ * Now we can set the new menu instance to be the cascade
+ * entry of the parent's instance.
+ */
+
+ newObjv[0] = Tcl_NewStringObj("-menu", -1);
+ newObjv[1] = newMenuName;
+ Tcl_IncrRefCount(newObjv[0]);
+ ConfigureMenuEntry(cascadeListPtr, 2, newObjv);
+ Tcl_DecrRefCount(normalPtr);
+ Tcl_DecrRefCount(newObjv[0]);
+ Tcl_DecrRefCount(newObjv[1]);
+ Tcl_DecrRefCount(windowNamePtr);
+ }
+ cascadeListPtr = nextCascadePtr;
+ }
+ }
+
+ /*
+ * If there already exist toplevel widgets that refer to this menu, find
+ * them and notify them so that they can reconfigure their geometry to
+ * reflect the menu.
+ */
+
+ if (menuRefPtr->topLevelListPtr != NULL) {
+ TkMenuTopLevelList *topLevelListPtr = menuRefPtr->topLevelListPtr;
+ TkMenuTopLevelList *nextPtr;
+ Tk_Window listtkwin;
+
+ while (topLevelListPtr != NULL) {
+ /*
+ * Need to get the next pointer first. TkSetWindowMenuBar changes
+ * the list, so that the next pointer is different after calling
+ * it.
+ */
+
+ nextPtr = topLevelListPtr->nextPtr;
+ listtkwin = topLevelListPtr->tkwin;
+ TkSetWindowMenuBar(menuPtr->interp, listtkwin,
+ Tk_PathName(menuPtr->tkwin), Tk_PathName(menuPtr->tkwin));
+ topLevelListPtr = nextPtr;
+ }
+ }
+
+ Tcl_SetObjResult(interp, TkNewWindowObj(menuPtr->tkwin));
+ return TCL_OK;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * MenuWidgetObjCmd --
+ *
+ * This function is invoked to process the Tcl command that corresponds
+ * to a widget managed by this module. See the user documentation for
+ * details on what it does.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * See the user documentation.
+ *
+ *--------------------------------------------------------------
+ */
+
+static int
+MenuWidgetObjCmd(
+ ClientData clientData, /* Information about menu widget. */
+ Tcl_Interp *interp, /* Current interpreter. */
+ int objc, /* Number of arguments. */
+ Tcl_Obj *const objv[]) /* Argument strings. */
+{
+ register TkMenu *menuPtr = clientData;
+ register TkMenuEntry *mePtr;
+ int result = TCL_OK;
+ int option;
+ ThreadSpecificData *tsdPtr =
+ Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
+
+ if (objc < 2) {
+ Tcl_WrongNumArgs(interp, 1, objv, "option ?arg ...?");
+ return TCL_ERROR;
+ }
+ if (Tcl_GetIndexFromObjStruct(interp, objv[1], menuOptions,
+ sizeof(char *), "option", 0, &option) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ Tcl_Preserve(menuPtr);
+
+ switch ((enum options) option) {
+ case MENU_ACTIVATE: {
+ int index;
+
+ if (objc != 3) {
+ Tcl_WrongNumArgs(interp, 2, objv, "index");
+ goto error;
+ }
+ if (TkGetMenuIndex(interp, menuPtr, objv[2], 0, &index) != TCL_OK) {
+ goto error;
+ }
+ if (menuPtr->active == index) {
+ goto done;
+ }
+ if ((index >= 0) && ((menuPtr->entries[index]->type==SEPARATOR_ENTRY)
+ || (menuPtr->entries[index]->state == ENTRY_DISABLED))) {
+ index = -1;
+ }
+ result = TkActivateMenuEntry(menuPtr, index);
+ break;
+ }
+ case MENU_ADD:
+ if (objc < 3) {
+ Tcl_WrongNumArgs(interp, 2, objv, "type ?-option value ...?");
+ goto error;
+ }
+
+ if (MenuAddOrInsert(interp, menuPtr, NULL, objc-2, objv+2) != TCL_OK){
+ goto error;
+ }
+ break;
+ case MENU_CGET: {
+ Tcl_Obj *resultPtr;
+
+ if (objc != 3) {
+ Tcl_WrongNumArgs(interp, 2, objv, "option");
+ goto error;
+ }
+ resultPtr = Tk_GetOptionValue(interp, (char *) menuPtr,
+ tsdPtr->menuOptionTable, objv[2],
+ menuPtr->tkwin);
+ if (resultPtr == NULL) {
+ goto error;
+ }
+ Tcl_SetObjResult(interp, resultPtr);
+ break;
+ }
+ case MENU_CLONE:
+ if ((objc < 3) || (objc > 4)) {
+ Tcl_WrongNumArgs(interp, 2, objv, "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,
+ tsdPtr->menuOptionTable, 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,
+ tsdPtr->menuOptionTable, objv[2],
+ menuPtr->tkwin);
+ if (resultPtr == NULL) {
+ result = TCL_ERROR;
+ } else {
+ result = TCL_OK;
+ Tcl_SetObjResult(interp, resultPtr);
+ }
+ } else {
+ result = ConfigureMenu(interp, menuPtr, objc - 2, objv + 2);
+ }
+ if (result != TCL_OK) {
+ goto error;
+ }
+ break;
+ }
+ case MENU_DELETE: {
+ int first, last;
+
+ if ((objc != 3) && (objc != 4)) {
+ Tcl_WrongNumArgs(interp, 2, objv, "first ?last?");
+ goto error;
+ }
+
+ /*
+ * If 'first' explicitly refers to past the end of the menu, we don't
+ * do anything. [Bug 220950]
+ */
+
+ if (isdigit(UCHAR(Tcl_GetString(objv[2])[0]))
+ && Tcl_GetIntFromObj(NULL, objv[2], &first) == TCL_OK) {
+ if (first >= menuPtr->numEntries) {
+ goto done;
+ }
+ } else if (TkGetMenuIndex(interp,menuPtr,objv[2],0,&first) != TCL_OK){
+ goto error;
+ }
+ if (objc == 3) {
+ last = first;
+ } else if (TkGetMenuIndex(interp,menuPtr,objv[3],0,&last) != TCL_OK) {
+ goto error;
+ }
+
+ if (menuPtr->tearoff && (first == 0)) {
+ /*
+ * Sorry, can't delete the tearoff entry; must reconfigure the
+ * menu.
+ */
+
+ first = 1;
+ }
+ if ((first < 0) || (last < first)) {
+ goto done;
+ }
+ DeleteMenuCloneEntries(menuPtr, first, last);
+ break;
+ }
+ case MENU_ENTRYCGET: {
+ int index;
+ Tcl_Obj *resultPtr;
+
+ if (objc != 4) {
+ Tcl_WrongNumArgs(interp, 2, objv, "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(mePtr);
+ resultPtr = Tk_GetOptionValue(interp, (char *) mePtr,
+ mePtr->optionTable, objv[3], menuPtr->tkwin);
+ Tcl_Release(mePtr);
+ if (resultPtr == NULL) {
+ goto error;
+ }
+ Tcl_SetObjResult(interp, resultPtr);
+ break;
+ }
+ case MENU_ENTRYCONFIGURE: {
+ int index;
+ Tcl_Obj *resultPtr;
+
+ if (objc < 3) {
+ Tcl_WrongNumArgs(interp, 2, objv, "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(mePtr);
+ if (objc == 3) {
+ resultPtr = Tk_GetOptionInfo(interp, (char *) mePtr,
+ mePtr->optionTable, 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(mePtr);
+ break;
+ }
+ case MENU_INDEX: {
+ int index;
+
+ if (objc != 3) {
+ Tcl_WrongNumArgs(interp, 2, objv, "string");
+ goto error;
+ }
+ if (TkGetMenuIndex(interp, menuPtr, objv[2], 0, &index) != TCL_OK) {
+ goto error;
+ }
+ if (index < 0) {
+ Tcl_SetObjResult(interp, Tcl_NewStringObj("none", -1));
+ } else {
+ Tcl_SetObjResult(interp, Tcl_NewIntObj(index));
+ }
+ break;
+ }
+ case MENU_INSERT:
+ if (objc < 4) {
+ Tcl_WrongNumArgs(interp, 2, objv,
+ "index type ?-option value ...?");
+ 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, 2, objv, "index");
+ goto error;
+ }
+ if (TkGetMenuIndex(interp, menuPtr, objv[2], 0, &index) != TCL_OK) {
+ goto error;
+ }
+ if (index < 0) {
+ goto done;
+ }
+ result = TkInvokeMenu(interp, menuPtr, index);
+ break;
+ }
+ case MENU_POST: {
+ int x, y;
+
+ if (objc != 4) {
+ Tcl_WrongNumArgs(interp, 2, objv, "x y");
+ goto error;
+ }
+ if ((Tcl_GetIntFromObj(interp, objv[2], &x) != TCL_OK)
+ || (Tcl_GetIntFromObj(interp, objv[3], &y) != TCL_OK)) {
+ goto error;
+ }
+
+ /*
+ * 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.
+ * Also, menubar menues are not intended to be posted (bug 1567681,
+ * 2160206).
+ */
+
+ if (menuPtr->menuType == MENUBAR) {
+ Tcl_AppendResult(interp, "a menubar menu cannot be posted", NULL);
+ return TCL_ERROR;
+ } else if (menuPtr->menuType != TEAROFF_MENU) {
+ result = TkpPostMenu(interp, menuPtr, x, y);
+ } else {
+ result = TkPostTearoffMenu(interp, menuPtr, x, y);
+ }
+ break;
+ }
+ case MENU_POSTCASCADE: {
+ int index;
+
+ if (objc != 3) {
+ Tcl_WrongNumArgs(interp, 2, objv, "index");
+ goto error;
+ }
+
+ if (TkGetMenuIndex(interp, menuPtr, objv[2], 0, &index) != TCL_OK) {
+ goto error;
+ }
+ if ((index < 0) || (menuPtr->entries[index]->type != CASCADE_ENTRY)) {
+ result = TkPostSubmenu(interp, menuPtr, NULL);
+ } else {
+ result = TkPostSubmenu(interp, menuPtr, menuPtr->entries[index]);
+ }
+ break;
+ }
+ case MENU_TYPE: {
+ int index;
+ const char *typeStr;
+
+ if (objc != 3) {
+ Tcl_WrongNumArgs(interp, 2, objv, "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) {
+ typeStr = "tearoff";
+ } else {
+ typeStr = menuEntryTypeStrings[menuPtr->entries[index]->type];
+ }
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(typeStr, -1));
+ break;
+ }
+ case MENU_UNPOST:
+ if (objc != 2) {
+ Tcl_WrongNumArgs(interp, 2, objv, NULL);
+ goto error;
+ }
+ Tk_UnmapWindow(menuPtr->tkwin);
+ result = TkPostSubmenu(interp, menuPtr, NULL);
+ break;
+ case MENU_XPOSITION:
+ if (objc != 3) {
+ Tcl_WrongNumArgs(interp, 2, objv, "index");
+ goto error;
+ }
+ result = MenuDoXPosition(interp, menuPtr, objv[2]);
+ break;
+ case MENU_YPOSITION:
+ if (objc != 3) {
+ Tcl_WrongNumArgs(interp, 2, objv, "index");
+ goto error;
+ }
+ result = MenuDoYPosition(interp, menuPtr, objv[2]);
+ break;
+ }
+ done:
+ Tcl_Release(menuPtr);
+ return result;
+
+ error:
+ Tcl_Release(menuPtr);
+ return TCL_ERROR;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkInvokeMenu --
+ *
+ * Given a menu and an index, takes the appropriate action for the entry
+ * associated with that index.
+ *
+ * Results:
+ * Standard Tcl result.
+ *
+ * Side effects:
+ * Commands may get excecuted; variables may get set; sub-menus may get
+ * posted.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TkInvokeMenu(
+ Tcl_Interp *interp, /* The interp that the menu lives in. */
+ TkMenu *menuPtr, /* The menu we are invoking. */
+ int index) /* The zero based index of the item we are
+ * invoking. */
+{
+ int result = TCL_OK;
+ TkMenuEntry *mePtr;
+
+ if (index < 0) {
+ goto done;
+ }
+ mePtr = menuPtr->entries[index];
+ if (mePtr->state == ENTRY_DISABLED) {
+ goto done;
+ }
+
+ Tcl_Preserve(mePtr);
+ if (mePtr->type == TEAROFF_ENTRY) {
+ Tcl_DString ds;
+
+ Tcl_DStringInit(&ds);
+ Tcl_DStringAppend(&ds, "tk::TearOffMenu ", -1);
+ Tcl_DStringAppend(&ds, Tk_PathName(menuPtr->tkwin), -1);
+ result = Tcl_EvalEx(interp, Tcl_DStringValue(&ds), -1, 0);
+ Tcl_DStringFree(&ds);
+ } else if ((mePtr->type == CHECK_BUTTON_ENTRY)
+ && (mePtr->namePtr != NULL)) {
+ Tcl_Obj *valuePtr;
+
+ if (mePtr->entryFlags & ENTRY_SELECTED) {
+ valuePtr = mePtr->offValuePtr;
+ } else {
+ valuePtr = mePtr->onValuePtr;
+ }
+ if (valuePtr == NULL) {
+ valuePtr = Tcl_NewObj();
+ }
+ Tcl_IncrRefCount(valuePtr);
+ if (Tcl_ObjSetVar2(interp, mePtr->namePtr, NULL, valuePtr,
+ TCL_GLOBAL_ONLY|TCL_LEAVE_ERR_MSG) == NULL) {
+ result = TCL_ERROR;
+ }
+ Tcl_DecrRefCount(valuePtr);
+ } else if ((mePtr->type == RADIO_BUTTON_ENTRY)
+ && (mePtr->namePtr != NULL)) {
+ Tcl_Obj *valuePtr = mePtr->onValuePtr;
+
+ if (valuePtr == NULL) {
+ valuePtr = Tcl_NewObj();
+ }
+ Tcl_IncrRefCount(valuePtr);
+ if (Tcl_ObjSetVar2(interp, mePtr->namePtr, NULL, valuePtr,
+ TCL_GLOBAL_ONLY|TCL_LEAVE_ERR_MSG) == NULL) {
+ result = TCL_ERROR;
+ }
+ Tcl_DecrRefCount(valuePtr);
+ }
+
+ /*
+ * We check numEntries in addition to whether the menu entry has a command
+ * because that goes to zero if the menu gets deleted (e.g., during
+ * command evaluation).
+ */
+
+ if ((menuPtr->numEntries != 0) && (result == TCL_OK)
+ && (mePtr->commandPtr != NULL)) {
+ Tcl_Obj *commandPtr = mePtr->commandPtr;
+
+ Tcl_IncrRefCount(commandPtr);
+ result = Tcl_EvalObjEx(interp, commandPtr, TCL_EVAL_GLOBAL);
+ Tcl_DecrRefCount(commandPtr);
+ }
+ Tcl_Release(mePtr);
+
+ done:
+ return result;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * DestroyMenuInstance --
+ *
+ * This function is invoked by TkDestroyMenu to clean up the internal
+ * structure of a menu at a safe time (when no-one is using it anymore).
+ * Only takes care of one instance of the menu.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Everything associated with the menu is freed up.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+DestroyMenuInstance(
+ TkMenu *menuPtr) /* Info about menu widget. */
+{
+ int i;
+ TkMenu *menuInstancePtr;
+ TkMenuEntry *cascadePtr, *nextCascadePtr;
+ Tcl_Obj *newObjv[2];
+ TkMenu *parentMasterMenuPtr;
+ TkMenuEntry *parentMasterEntryPtr;
+ ThreadSpecificData *tsdPtr =
+ Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
+
+ /*
+ * If the menu has any cascade menu entries pointing to it, the cascade
+ * entries need to be told that the menu is going away. We need to clear
+ * the menu ptr field in the menu reference at this point in the code so
+ * that everything else can forget about this menu properly. We also need
+ * to reset -menu field of all entries that are not master menus back to
+ * this entry name if this is a master menu pointed to by another master
+ * menu. If there is a clone menu that points to this menu, then this menu
+ * is itself a clone, so when this menu goes away, the -menu field of the
+ * pointing entry must be set back to this menu's master menu name so that
+ * later if another menu is created the cascade hierarchy can be
+ * maintained.
+ */
+
+ TkpDestroyMenu(menuPtr);
+ if (menuPtr->menuRefPtr == NULL) {
+ return;
+ }
+ cascadePtr = menuPtr->menuRefPtr->parentEntryPtr;
+ menuPtr->menuRefPtr->menuPtr = NULL;
+ if (TkFreeMenuReferences(menuPtr->menuRefPtr)) {
+ menuPtr->menuRefPtr = NULL;
+ }
+
+ for (; cascadePtr != NULL; cascadePtr = nextCascadePtr) {
+ nextCascadePtr = cascadePtr->nextCascadePtr;
+
+ if (menuPtr->masterMenuPtr != menuPtr) {
+ Tcl_Obj *menuNamePtr = Tcl_NewStringObj("-menu", -1);
+
+ parentMasterMenuPtr = cascadePtr->menuPtr->masterMenuPtr;
+ parentMasterEntryPtr =
+ parentMasterMenuPtr->entries[cascadePtr->index];
+ newObjv[0] = menuNamePtr;
+ newObjv[1] = parentMasterEntryPtr->namePtr;
+
+ /*
+ * It is possible that the menu info is out of sync, and these
+ * things point to NULL, so verify existence [Bug: 3402]
+ */
+
+ if (newObjv[0] && newObjv[1]) {
+ Tcl_IncrRefCount(newObjv[0]);
+ Tcl_IncrRefCount(newObjv[1]);
+ ConfigureMenuEntry(cascadePtr, 2, newObjv);
+ Tcl_DecrRefCount(newObjv[0]);
+ Tcl_DecrRefCount(newObjv[1]);
+ }
+ } else {
+ ConfigureMenuEntry(cascadePtr, 0, NULL);
+ }
+ }
+
+ if (menuPtr->masterMenuPtr != menuPtr) {
+ for (menuInstancePtr = menuPtr->masterMenuPtr;
+ menuInstancePtr != NULL;
+ menuInstancePtr = menuInstancePtr->nextInstancePtr) {
+ if (menuInstancePtr->nextInstancePtr == menuPtr) {
+ menuInstancePtr->nextInstancePtr =
+ menuInstancePtr->nextInstancePtr->nextInstancePtr;
+ break;
+ }
+ }
+ } else if (menuPtr->nextInstancePtr != NULL) {
+ Tcl_Panic("Attempting to delete master menu when there are still clones");
+ }
+
+ /*
+ * Free up all the stuff that requires special handling, then let
+ * Tk_FreeConfigOptions handle all the standard option-related stuff.
+ */
+
+ for (i = menuPtr->numEntries; --i >= 0; ) {
+ /*
+ * As each menu entry is deleted from the end of the array of entries,
+ * decrement menuPtr->numEntries. Otherwise, the act of deleting menu
+ * entry i will dereference freed memory attempting to queue a redraw
+ * for menu entries (i+1)...numEntries.
+ */
+
+ DestroyMenuEntry(menuPtr->entries[i]);
+ menuPtr->numEntries = i;
+ }
+ if (menuPtr->entries != NULL) {
+ ckfree(menuPtr->entries);
+ }
+ TkMenuFreeDrawOptions(menuPtr);
+ Tk_FreeConfigOptions((char *) menuPtr,
+ tsdPtr->menuOptionTable, menuPtr->tkwin);
+ if (menuPtr->tkwin != NULL) {
+ Tk_Window tkwin = menuPtr->tkwin;
+
+ menuPtr->tkwin = NULL;
+ Tk_DestroyWindow(tkwin);
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkDestroyMenu --
+ *
+ * This function is invoked by Tcl_EventuallyFree or Tcl_Release to clean
+ * up the internal structure of a menu at a safe time (when no-one is
+ * using it anymore). If called on a master instance, destroys all of the
+ * slave instances. If called on a non-master instance, just destroys
+ * that instance.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Everything associated with the menu is freed up.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TkDestroyMenu(
+ TkMenu *menuPtr) /* Info about menu widget. */
+{
+ TkMenu *menuInstancePtr;
+ TkMenuTopLevelList *topLevelListPtr, *nextTopLevelPtr;
+
+ if (menuPtr->menuFlags & MENU_DELETION_PENDING) {
+ return;
+ }
+
+ Tcl_Preserve(menuPtr);
+
+ /*
+ * Now destroy all non-tearoff instances of this menu if this is a parent
+ * menu. Is this loop safe enough? Are there going to be destroy bindings
+ * on child menus which kill the parent? If not, we have to do a slightly
+ * more complex scheme.
+ */
+
+ menuPtr->menuFlags |= MENU_DELETION_PENDING;
+ if (menuPtr->menuRefPtr != NULL) {
+ /*
+ * If any toplevel widgets have this menu as their menubar, the
+ * geometry of the window may have to be recalculated.
+ */
+
+ topLevelListPtr = menuPtr->menuRefPtr->topLevelListPtr;
+ while (topLevelListPtr != NULL) {
+ nextTopLevelPtr = topLevelListPtr->nextPtr;
+ TkpSetWindowMenuBar(topLevelListPtr->tkwin, NULL);
+ topLevelListPtr = nextTopLevelPtr;
+ }
+ }
+ if (menuPtr->masterMenuPtr == menuPtr) {
+ while (menuPtr->nextInstancePtr != NULL) {
+ menuInstancePtr = menuPtr->nextInstancePtr;
+ menuPtr->nextInstancePtr = menuInstancePtr->nextInstancePtr;
+ if (menuInstancePtr->tkwin != NULL) {
+ Tk_Window tkwin = menuInstancePtr->tkwin;
+
+ /*
+ * Note: it may be desirable to NULL out the tkwin field of
+ * menuInstancePtr here:
+ * menuInstancePtr->tkwin = NULL;
+ */
+
+ Tk_DestroyWindow(tkwin);
+ }
+ }
+ }
+
+ DestroyMenuInstance(menuPtr);
+
+ Tcl_Release(menuPtr);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * UnhookCascadeEntry --
+ *
+ * This entry is removed from the list of entries that point to the
+ * cascade menu. This is done in preparation for changing the menu that
+ * this entry points to.
+ *
+ * At the end of this function, the menu entry no longer contains a
+ * reference to a 'TkMenuReferences' structure, and therefore no such
+ * structure contains a reference to this menu entry either.
+ *
+ * Results:
+ * None
+ *
+ * Side effects:
+ * The appropriate lists are modified.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+UnhookCascadeEntry(
+ TkMenuEntry *mePtr) /* The cascade entry we are removing from the
+ * cascade list. */
+{
+ TkMenuEntry *cascadeEntryPtr;
+ TkMenuEntry *prevCascadePtr;
+ TkMenuReferences *menuRefPtr;
+
+ menuRefPtr = mePtr->childMenuRefPtr;
+ if (menuRefPtr == NULL) {
+ return;
+ }
+
+ cascadeEntryPtr = menuRefPtr->parentEntryPtr;
+ if (cascadeEntryPtr == NULL) {
+ TkFreeMenuReferences(menuRefPtr);
+ mePtr->childMenuRefPtr = NULL;
+ return;
+ }
+
+ /*
+ * Singularly linked list deletion. The two special cases are 1. one
+ * element; 2. The first element is the one we want.
+ */
+
+ if (cascadeEntryPtr == mePtr) {
+ if (cascadeEntryPtr->nextCascadePtr == NULL) {
+ /*
+ * This is the last menu entry which points to this menu, so we
+ * need to clear out the list pointer in the cascade itself.
+ */
+
+ menuRefPtr->parentEntryPtr = NULL;
+
+ /*
+ * The original field is set to zero below, after it is freed.
+ */
+
+ TkFreeMenuReferences(menuRefPtr);
+ } else {
+ menuRefPtr->parentEntryPtr = cascadeEntryPtr->nextCascadePtr;
+ }
+ mePtr->nextCascadePtr = NULL;
+ } else {
+ for (prevCascadePtr = cascadeEntryPtr,
+ cascadeEntryPtr = cascadeEntryPtr->nextCascadePtr;
+ cascadeEntryPtr != NULL;
+ prevCascadePtr = cascadeEntryPtr,
+ cascadeEntryPtr = cascadeEntryPtr->nextCascadePtr) {
+ if (cascadeEntryPtr == mePtr){
+ prevCascadePtr->nextCascadePtr =
+ cascadeEntryPtr->nextCascadePtr;
+ cascadeEntryPtr->nextCascadePtr = NULL;
+ break;
+ }
+ }
+ mePtr->nextCascadePtr = NULL;
+ }
+ mePtr->childMenuRefPtr = NULL;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * DestroyMenuEntry --
+ *
+ * This function is invoked by Tcl_EventuallyFree or Tcl_Release to clean
+ * up the internal structure of a menu entry at a safe time (when no-one
+ * is using it anymore).
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Everything associated with the menu entry is freed.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+DestroyMenuEntry(
+ void *memPtr) /* Pointer to entry to be freed. */
+{
+ register TkMenuEntry *mePtr = memPtr;
+ TkMenu *menuPtr = mePtr->menuPtr;
+
+ if (menuPtr->postedCascade == mePtr) {
+ /*
+ * Ignore errors while unposting the menu, since it's possible that
+ * the menu has already been deleted and the unpost will generate an
+ * error.
+ */
+
+ TkPostSubmenu(menuPtr->interp, menuPtr, NULL);
+ }
+
+ /*
+ * Free up all the stuff that requires special handling, then let
+ * Tk_FreeConfigOptions handle all the standard option-related stuff.
+ */
+
+ if (mePtr->type == CASCADE_ENTRY) {
+ if (menuPtr->masterMenuPtr != menuPtr) {
+ TkMenu *destroyThis = NULL;
+ TkMenuReferences *menuRefPtr = mePtr->childMenuRefPtr;
+
+ /*
+ * The menu as a whole is a clone. We must delete the clone of the
+ * cascaded menu for the particular entry we are destroying.
+ */
+
+ if (menuRefPtr != NULL) {
+ destroyThis = menuRefPtr->menuPtr;
+
+ /*
+ * But only if it is a clone. What can happen is that we are
+ * in the middle of deleting a menu and this menu pointer has
+ * already been reset to point to the original menu. In that
+ * case we have nothing special to do.
+ */
+
+ if ((destroyThis != NULL)
+ && (destroyThis->masterMenuPtr == destroyThis)) {
+ destroyThis = NULL;
+ }
+ }
+ UnhookCascadeEntry(mePtr);
+ menuRefPtr = mePtr->childMenuRefPtr;
+ if (menuRefPtr != NULL) {
+ if (menuRefPtr->menuPtr == destroyThis) {
+ menuRefPtr->menuPtr = NULL;
+ }
+ }
+ if (destroyThis != NULL) {
+ TkDestroyMenu(destroyThis);
+ }
+ } else {
+ UnhookCascadeEntry(mePtr);
+ }
+ }
+ if (mePtr->image != NULL) {
+ Tk_FreeImage(mePtr->image);
+ }
+ if (mePtr->selectImage != NULL) {
+ Tk_FreeImage(mePtr->selectImage);
+ }
+ if (((mePtr->type == CHECK_BUTTON_ENTRY)
+ || (mePtr->type == RADIO_BUTTON_ENTRY))
+ && (mePtr->namePtr != NULL)) {
+ const char *varName = Tcl_GetString(mePtr->namePtr);
+
+ Tcl_UntraceVar2(menuPtr->interp, varName, NULL,
+ TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS,
+ MenuVarProc, mePtr);
+ }
+ TkpDestroyMenuEntry(mePtr);
+ TkMenuEntryFreeDrawOptions(mePtr);
+ Tk_FreeConfigOptions((char *) mePtr, mePtr->optionTable, menuPtr->tkwin);
+ ckfree(mePtr);
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * MenuWorldChanged --
+ *
+ * This function is called when the world has changed in some way (such
+ * as the fonts in the system changing) and the widget needs to recompute
+ * all its graphics contexts and determine its new geometry.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Menu will be relayed out and redisplayed.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+static void
+MenuWorldChanged(
+ ClientData instanceData) /* Information about widget. */
+{
+ TkMenu *menuPtr = instanceData;
+ int i;
+
+ TkMenuConfigureDrawOptions(menuPtr);
+ for (i = 0; i < menuPtr->numEntries; i++) {
+ TkMenuConfigureEntryDrawOptions(menuPtr->entries[i],
+ menuPtr->entries[i]->index);
+ TkpConfigureMenuEntry(menuPtr->entries[i]);
+ }
+ TkEventuallyRecomputeMenu(menuPtr);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ConfigureMenu --
+ *
+ * This function is called to process an argv/argc list, plus the Tk
+ * option database, in order to configure (or reconfigure) a menu widget.
+ *
+ * Results:
+ * The return value is a standard Tcl result. If TCL_ERROR is returned,
+ * then the interp's result contains an error message.
+ *
+ * Side effects:
+ * Configuration information, such as colors, font, etc. get set for
+ * menuPtr; old resources get freed, if there were any.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+ConfigureMenu(
+ Tcl_Interp *interp, /* Used for error reporting. */
+ register TkMenu *menuPtr, /* Information about widget; may or may not
+ * already have values for some fields. */
+ int objc, /* Number of valid entries in argv. */
+ Tcl_Obj *const objv[]) /* Arguments. */
+{
+ int i;
+ TkMenu *menuListPtr, *cleanupPtr;
+ int result;
+ ThreadSpecificData *tsdPtr =
+ Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
+
+ for (menuListPtr = menuPtr->masterMenuPtr; menuListPtr != NULL;
+ menuListPtr = menuListPtr->nextInstancePtr) {
+ menuListPtr->errorStructPtr = ckalloc(sizeof(Tk_SavedOptions));
+ result = Tk_SetOptions(interp, (char *) menuListPtr,
+ tsdPtr->menuOptionTable, objc, objv,
+ menuListPtr->tkwin, menuListPtr->errorStructPtr, NULL);
+ if (result != TCL_OK) {
+ for (cleanupPtr = menuPtr->masterMenuPtr;
+ cleanupPtr != menuListPtr;
+ cleanupPtr = cleanupPtr->nextInstancePtr) {
+ Tk_RestoreSavedOptions(cleanupPtr->errorStructPtr);
+ ckfree(cleanupPtr->errorStructPtr);
+ cleanupPtr->errorStructPtr = NULL;
+ }
+ if (menuListPtr->errorStructPtr != NULL) {
+ Tk_RestoreSavedOptions(menuListPtr->errorStructPtr);
+ ckfree(menuListPtr->errorStructPtr);
+ menuListPtr->errorStructPtr = NULL;
+ }
+ return TCL_ERROR;
+ }
+
+ /*
+ * When a menu is created, the type is in all of the arguments to the
+ * menu command. Let Tk_ConfigureWidget take care of parsing them, and
+ * then set the type after we can look at the type string. Once set, a
+ * menu's type cannot be changed
+ */
+
+ if (menuListPtr->menuType == UNKNOWN_TYPE) {
+ Tcl_GetIndexFromObjStruct(NULL, menuListPtr->menuTypePtr,
+ menuTypeStrings, sizeof(char *), 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) {
+ int typeFlag = TK_MAKE_MENU_POPUP;
+ Tk_Window tkwin = menuPtr->tkwin;
+
+ /*
+ * Work out if we are the child of a menubar or a popup.
+ */
+
+ while (1) {
+ Tk_Window parent = Tk_Parent(tkwin);
+
+ if (Tk_Class(parent) != Tk_Class(menuPtr->tkwin)) {
+ break;
+ }
+ tkwin = parent;
+ }
+ if (((TkMenu *) tkwin)->menuType == MENUBAR) {
+ typeFlag = TK_MAKE_MENU_DROPDOWN;
+ }
+
+ TkpMakeMenuWindow(menuListPtr->tkwin, typeFlag);
+ } else if (menuListPtr->menuType == TEAROFF_MENU) {
+ TkpMakeMenuWindow(menuListPtr->tkwin, TK_MAKE_MENU_TEAROFF);
+ }
+ }
+
+ /*
+ * Depending on the -tearOff option, make sure that there is or isn't
+ * an initial tear-off entry at the beginning of the menu.
+ */
+
+ if (menuListPtr->tearoff) {
+ if ((menuListPtr->numEntries == 0)
+ || (menuListPtr->entries[0]->type != TEAROFF_ENTRY)) {
+ if (MenuNewEntry(menuListPtr, 0, TEAROFF_ENTRY) == NULL) {
+ for (cleanupPtr = menuPtr->masterMenuPtr;
+ cleanupPtr != menuListPtr;
+ cleanupPtr = cleanupPtr->nextInstancePtr) {
+ Tk_RestoreSavedOptions(cleanupPtr->errorStructPtr);
+ ckfree(cleanupPtr->errorStructPtr);
+ cleanupPtr->errorStructPtr = NULL;
+ }
+ if (menuListPtr->errorStructPtr != NULL) {
+ Tk_RestoreSavedOptions(menuListPtr->errorStructPtr);
+ ckfree(menuListPtr->errorStructPtr);
+ menuListPtr->errorStructPtr = NULL;
+ }
+ return TCL_ERROR;
+ }
+ }
+ } else if ((menuListPtr->numEntries > 0)
+ && (menuListPtr->entries[0]->type == TEAROFF_ENTRY)) {
+ int i;
+
+ Tcl_EventuallyFree(menuListPtr->entries[0], (Tcl_FreeProc *) DestroyMenuEntry);
+
+ for (i = 0; i < menuListPtr->numEntries - 1; i++) {
+ menuListPtr->entries[i] = menuListPtr->entries[i + 1];
+ menuListPtr->entries[i]->index = i;
+ }
+ menuListPtr->numEntries--;
+ if (menuListPtr->numEntries == 0) {
+ ckfree(menuListPtr->entries);
+ menuListPtr->entries = NULL;
+ }
+ }
+
+ TkMenuConfigureDrawOptions(menuListPtr);
+
+ /*
+ * After reconfiguring a menu, we need to reconfigure all of the
+ * entries in the menu, since some of the things in the children (such
+ * as graphics contexts) may have to change to reflect changes in the
+ * parent.
+ */
+
+ for (i = 0; i < menuListPtr->numEntries; i++) {
+ TkMenuEntry *mePtr;
+
+ mePtr = menuListPtr->entries[i];
+ ConfigureMenuEntry(mePtr, 0, NULL);
+ }
+
+ TkEventuallyRecomputeMenu(menuListPtr);
+ }
+
+ for (cleanupPtr = menuPtr->masterMenuPtr; cleanupPtr != NULL;
+ cleanupPtr = cleanupPtr->nextInstancePtr) {
+ Tk_FreeSavedOptions(cleanupPtr->errorStructPtr);
+ ckfree(cleanupPtr->errorStructPtr);
+ cleanupPtr->errorStructPtr = NULL;
+ }
+
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * PostProcessEntry --
+ *
+ * This is called by ConfigureMenuEntry to do all of the configuration
+ * after Tk_SetOptions is called. This is separate so that error handling
+ * is easier.
+ *
+ * Results:
+ * The return value is a standard Tcl result. If TCL_ERROR is returned,
+ * then the interp's result contains an error message.
+ *
+ * Side effects:
+ * Configuration information such as label and accelerator get set for
+ * mePtr; old resources get freed, if there were any.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+PostProcessEntry(
+ TkMenuEntry *mePtr) /* The entry we are configuring. */
+{
+ TkMenu *menuPtr = mePtr->menuPtr;
+ int index = mePtr->index;
+ const char *name;
+ Tk_Image image;
+
+ /*
+ * The code below handles special configuration stuff not taken care of by
+ * Tk_ConfigureWidget, such as special processing for defaults, sizing
+ * strings, graphics contexts, etc.
+ */
+
+ if (mePtr->labelPtr == NULL) {
+ mePtr->labelLength = 0;
+ } else {
+ (void)Tcl_GetStringFromObj(mePtr->labelPtr, &mePtr->labelLength);
+ }
+ if (mePtr->accelPtr == NULL) {
+ mePtr->accelLength = 0;
+ } else {
+ (void)Tcl_GetStringFromObj(mePtr->accelPtr, &mePtr->accelLength);
+ }
+
+ /*
+ * If this is a cascade entry, the platform-specific data of the child
+ * menu has to be updated. Also, the links that point to parents and
+ * cascades have to be updated.
+ */
+
+ if ((mePtr->type == CASCADE_ENTRY) && (mePtr->namePtr != NULL)) {
+ TkMenuEntry *cascadeEntryPtr;
+ int alreadyThere;
+ TkMenuReferences *menuRefPtr;
+ char *oldHashKey = NULL; /* Initialization only needed to
+ * prevent compiler warning. */
+
+ /*
+ * This is a cascade entry. If the menu that the cascade entry is
+ * pointing to has changed, we need to remove this entry from the list
+ * of entries pointing to the old menu, and add a cascade reference to
+ * the list of entries pointing to the new menu.
+ *
+ * BUG: We are not recloning for special case #3 yet.
+ */
+
+ name = Tcl_GetString(mePtr->namePtr);
+ if (mePtr->childMenuRefPtr != NULL) {
+ oldHashKey = Tcl_GetHashKey(TkGetMenuHashTable(menuPtr->interp),
+ mePtr->childMenuRefPtr->hashEntryPtr);
+ if (strcmp(oldHashKey, name) != 0) {
+ UnhookCascadeEntry(mePtr);
+ }
+ }
+
+ if ((mePtr->childMenuRefPtr == NULL)
+ || (strcmp(oldHashKey, name) != 0)) {
+ menuRefPtr = TkCreateMenuReferences(menuPtr->interp, name);
+ mePtr->childMenuRefPtr = menuRefPtr;
+
+ if (menuRefPtr->parentEntryPtr == NULL) {
+ menuRefPtr->parentEntryPtr = mePtr;
+ } else {
+ alreadyThere = 0;
+ for (cascadeEntryPtr = menuRefPtr->parentEntryPtr;
+ cascadeEntryPtr != NULL;
+ cascadeEntryPtr =
+ cascadeEntryPtr->nextCascadePtr) {
+ if (cascadeEntryPtr == mePtr) {
+ alreadyThere = 1;
+ break;
+ }
+ }
+
+ /*
+ * Put the item at the front of the list.
+ */
+
+ if (!alreadyThere) {
+ mePtr->nextCascadePtr = menuRefPtr->parentEntryPtr;
+ menuRefPtr->parentEntryPtr = mePtr;
+ }
+ }
+ }
+ }
+
+ if (TkMenuConfigureEntryDrawOptions(mePtr, index) != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ /*
+ * Get the images for the entry, if there are any. Allocate the new images
+ * before freeing the old ones, so that the reference counts don't go to
+ * zero and cause image data to be discarded.
+ */
+
+ if (mePtr->imagePtr != NULL) {
+ const char *imageString = Tcl_GetString(mePtr->imagePtr);
+
+ image = Tk_GetImage(menuPtr->interp, menuPtr->tkwin, imageString,
+ TkMenuImageProc, mePtr);
+ if (image == NULL) {
+ return TCL_ERROR;
+ }
+ } else {
+ image = NULL;
+ }
+ if (mePtr->image != NULL) {
+ Tk_FreeImage(mePtr->image);
+ }
+ mePtr->image = image;
+ if (mePtr->selectImagePtr != NULL) {
+ const char *selectImageString = Tcl_GetString(mePtr->selectImagePtr);
+
+ image = Tk_GetImage(menuPtr->interp, menuPtr->tkwin, selectImageString,
+ TkMenuSelectImageProc, mePtr);
+ if (image == NULL) {
+ return TCL_ERROR;
+ }
+ } else {
+ image = NULL;
+ }
+ if (mePtr->selectImage != NULL) {
+ Tk_FreeImage(mePtr->selectImage);
+ }
+ mePtr->selectImage = image;
+
+ if ((mePtr->type == CHECK_BUTTON_ENTRY)
+ || (mePtr->type == RADIO_BUTTON_ENTRY)) {
+ Tcl_Obj *valuePtr;
+ const 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) {
+ const char *value = Tcl_GetString(valuePtr);
+ const char *onValue = Tcl_GetString(mePtr->onValuePtr);
+
+ 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_GetString(mePtr->namePtr);
+ Tcl_TraceVar2(menuPtr->interp, name,
+ NULL, TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS,
+ MenuVarProc, mePtr);
+ }
+ }
+
+ if (TkpConfigureMenuEntry(mePtr) != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ConfigureMenuEntry --
+ *
+ * This function 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(
+ 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 function.
+ */
+
+ if ((mePtr->namePtr != NULL)
+ && ((mePtr->type == CHECK_BUTTON_ENTRY)
+ || (mePtr->type == RADIO_BUTTON_ENTRY))) {
+ const char *name = Tcl_GetString(mePtr->namePtr);
+
+ Tcl_UntraceVar2(menuPtr->interp, name, NULL,
+ TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS,
+ MenuVarProc, mePtr);
+ }
+
+ result = TCL_OK;
+ if (menuPtr->tkwin != NULL) {
+ if (Tk_SetOptions(menuPtr->interp, (char *) mePtr,
+ mePtr->optionTable, objc, objv, menuPtr->tkwin,
+ &errorStruct, NULL) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ result = PostProcessEntry(mePtr);
+ if (result != TCL_OK) {
+ Tk_RestoreSavedOptions(&errorStruct);
+ PostProcessEntry(mePtr);
+ }
+ Tk_FreeSavedOptions(&errorStruct);
+ }
+
+ TkEventuallyRecomputeMenu(menuPtr);
+
+ return result;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ConfigureMenuCloneEntries --
+ *
+ * Calls ConfigureMenuEntry for each menu in the clone chain.
+ *
+ * Results:
+ * The return value is a standard Tcl result. If TCL_ERROR is returned,
+ * then the interp's result contains an error message.
+ *
+ * Side effects:
+ * Configuration information such as label and accelerator get set for
+ * mePtr; old resources get freed, if there were any.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+ConfigureMenuCloneEntries(
+ Tcl_Interp *interp, /* Used for error reporting. */
+ TkMenu *menuPtr, /* Information about whole menu. */
+ int index, /* Index of mePtr within menuPtr's entries. */
+ int objc, /* Number of valid entries in argv. */
+ Tcl_Obj *const objv[]) /* Arguments. */
+{
+ TkMenuEntry *mePtr;
+ TkMenu *menuListPtr;
+ int cascadeEntryChanged = 0;
+ TkMenuReferences *oldCascadeMenuRefPtr, *cascadeMenuRefPtr = NULL;
+ Tcl_Obj *oldCascadePtr = NULL;
+ const char *newCascadeName;
+
+ /*
+ * Cascades are kind of tricky here. This is special case #3 in the
+ * comment at the top of this file. Basically, if a menu is the master
+ * menu of a clone chain, and has an entry with a cascade menu, the clones
+ * of the menu will point to clones of the cascade menu. We have to
+ * destroy the clones of the cascades, clone the new cascade menu, and
+ * configure the entry to point to the new clone.
+ */
+
+ mePtr = menuPtr->masterMenuPtr->entries[index];
+ if (mePtr->type == CASCADE_ENTRY) {
+ oldCascadePtr = mePtr->namePtr;
+ if (oldCascadePtr != NULL) {
+ Tcl_IncrRefCount(oldCascadePtr);
+ }
+ }
+
+ if (ConfigureMenuEntry(mePtr, objc, objv) != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ if (mePtr->type == CASCADE_ENTRY) {
+ const char *oldCascadeName;
+
+ if (mePtr->namePtr != NULL) {
+ newCascadeName = Tcl_GetString(mePtr->namePtr);
+ } 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_GetString(oldCascadePtr);
+ cascadeEntryChanged = (strcmp(oldCascadeName, newCascadeName)
+ != 0);
+ }
+ if (oldCascadePtr != NULL) {
+ Tcl_DecrRefCount(oldCascadePtr);
+ }
+ }
+
+ if (cascadeEntryChanged) {
+ if (mePtr->namePtr != NULL) {
+ newCascadeName = Tcl_GetString(mePtr->namePtr);
+ cascadeMenuRefPtr = TkFindMenuReferences(menuPtr->interp,
+ newCascadeName);
+ }
+ }
+
+ for (menuListPtr = menuPtr->masterMenuPtr->nextInstancePtr;
+ menuListPtr != NULL;
+ menuListPtr = menuListPtr->nextInstancePtr) {
+
+ mePtr = menuListPtr->entries[index];
+
+ if (cascadeEntryChanged && (mePtr->namePtr != NULL)) {
+ oldCascadeMenuRefPtr = TkFindMenuReferencesObj(menuPtr->interp,
+ mePtr->namePtr);
+
+ if ((oldCascadeMenuRefPtr != NULL)
+ && (oldCascadeMenuRefPtr->menuPtr != NULL)) {
+ RecursivelyDeleteMenu(oldCascadeMenuRefPtr->menuPtr);
+ }
+ }
+
+ if (ConfigureMenuEntry(mePtr, objc, objv) != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ if (cascadeEntryChanged && (mePtr->namePtr != NULL)) {
+ if (cascadeMenuRefPtr && cascadeMenuRefPtr->menuPtr != NULL) {
+ Tcl_Obj *newObjv[2];
+ Tcl_Obj *newCloneNamePtr;
+ Tcl_Obj *pathNamePtr = Tcl_NewStringObj(
+ Tk_PathName(menuListPtr->tkwin), -1);
+ Tcl_Obj *normalPtr = Tcl_NewStringObj("normal", -1);
+ Tcl_Obj *menuObjPtr = Tcl_NewStringObj("-menu", -1);
+
+ Tcl_IncrRefCount(pathNamePtr);
+ newCloneNamePtr = TkNewMenuName(menuPtr->interp,
+ pathNamePtr,
+ cascadeMenuRefPtr->menuPtr);
+ Tcl_IncrRefCount(newCloneNamePtr);
+ Tcl_IncrRefCount(normalPtr);
+ CloneMenu(cascadeMenuRefPtr->menuPtr, newCloneNamePtr,
+ normalPtr);
+
+ newObjv[0] = menuObjPtr;
+ newObjv[1] = newCloneNamePtr;
+ Tcl_IncrRefCount(menuObjPtr);
+ ConfigureMenuEntry(mePtr, 2, newObjv);
+ Tcl_DecrRefCount(newCloneNamePtr);
+ Tcl_DecrRefCount(pathNamePtr);
+ Tcl_DecrRefCount(normalPtr);
+ Tcl_DecrRefCount(menuObjPtr);
+ }
+ }
+ }
+ return TCL_OK;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * TkGetMenuIndex --
+ *
+ * Parse a textual index into a menu and return the numerical index of
+ * the indicated entry.
+ *
+ * Results:
+ * A standard Tcl result. If all went well, then *indexPtr is filled in
+ * with the entry index corresponding to string (ranges from -1 to the
+ * number of entries in the menu minus one). Otherwise an error message
+ * is left in the interp's result.
+ *
+ * Side effects:
+ * None.
+ *
+ *--------------------------------------------------------------
+ */
+
+int
+TkGetMenuIndex(
+ Tcl_Interp *interp, /* For error messages. */
+ TkMenu *menuPtr, /* Menu for which the index is being
+ * specified. */
+ Tcl_Obj *objPtr, /* Specification of an entry in menu. See
+ * manual entry for valid .*/
+ int lastOK, /* Non-zero means its OK to return index just
+ * *after* last entry. */
+ int *indexPtr) /* Where to store converted index. */
+{
+ int i;
+ const char *string = Tcl_GetString(objPtr);
+
+ if ((string[0] == 'a') && (strcmp(string, "active") == 0)) {
+ *indexPtr = menuPtr->active;
+ goto success;
+ }
+
+ if (((string[0] == 'l') && (strcmp(string, "last") == 0))
+ || ((string[0] == 'e') && (strcmp(string, "end") == 0))) {
+ *indexPtr = menuPtr->numEntries - ((lastOK) ? 0 : 1);
+ goto success;
+ }
+
+ if ((string[0] == 'n') && (strcmp(string, "none") == 0)) {
+ *indexPtr = -1;
+ goto success;
+ }
+
+ if (string[0] == '@') {
+ if (GetIndexFromCoords(interp, menuPtr, string, indexPtr)
+ == TCL_OK) {
+ goto success;
+ }
+ }
+
+ if (isdigit(UCHAR(string[0]))) {
+ if (Tcl_GetInt(interp, string, &i) == TCL_OK) {
+ if (i >= menuPtr->numEntries) {
+ if (lastOK) {
+ i = menuPtr->numEntries;
+ } else {
+ i = menuPtr->numEntries-1;
+ }
+ } else if (i < 0) {
+ i = -1;
+ }
+ *indexPtr = i;
+ goto success;
+ }
+ Tcl_ResetResult(interp);
+ }
+
+ for (i = 0; i < menuPtr->numEntries; i++) {
+ Tcl_Obj *labelPtr = menuPtr->entries[i]->labelPtr;
+ const char *label = (labelPtr == NULL) ? NULL : Tcl_GetString(labelPtr);
+
+ if ((label != NULL) && (Tcl_StringMatch(label, string))) {
+ *indexPtr = i;
+ goto success;
+ }
+ }
+
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "bad menu entry index \"%s\"", string));
+ Tcl_SetErrorCode(interp, "TK", "MENU", "INDEX", NULL);
+ return TCL_ERROR;
+
+ success:
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * MenuCmdDeletedProc --
+ *
+ * This function is invoked when a widget command is deleted. If the
+ * widget isn't already in the process of being destroyed, this command
+ * destroys it.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The widget is destroyed.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+MenuCmdDeletedProc(
+ ClientData clientData) /* Pointer to widget record for widget. */
+{
+ TkMenu *menuPtr = clientData;
+ Tk_Window tkwin = menuPtr->tkwin;
+
+ /*
+ * This function 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 function destroys the
+ * widget.
+ */
+
+ if (tkwin != NULL) {
+ /*
+ * Note: it may be desirable to NULL out the tkwin field of menuPtr
+ * here:
+ * menuPtr->tkwin = NULL;
+ */
+
+ Tk_DestroyWindow(tkwin);
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * MenuNewEntry --
+ *
+ * This function allocates and initializes a new menu entry.
+ *
+ * Results:
+ * The return value is a pointer to a new menu entry structure, which has
+ * been malloc-ed, initialized, and entered into the entry array for the
+ * menu.
+ *
+ * Side effects:
+ * Storage gets allocated.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static TkMenuEntry *
+MenuNewEntry(
+ TkMenu *menuPtr, /* Menu that will hold the new entry. */
+ int index, /* Where in the menu the new entry is to
+ * go. */
+ int type) /* The type of the new entry. */
+{
+ TkMenuEntry *mePtr;
+ TkMenuEntry **newEntries;
+ int i;
+ ThreadSpecificData *tsdPtr =
+ Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
+
+ /*
+ * Create a new array of entries with an empty slot for the new entry.
+ */
+
+ newEntries = ckalloc((menuPtr->numEntries+1) * sizeof(TkMenuEntry *));
+ for (i = 0; i < index; i++) {
+ newEntries[i] = menuPtr->entries[i];
+ }
+ for (; i < menuPtr->numEntries; i++) {
+ newEntries[i+1] = menuPtr->entries[i];
+ newEntries[i+1]->index = i + 1;
+ }
+ if (menuPtr->numEntries != 0) {
+ ckfree(menuPtr->entries);
+ }
+ menuPtr->entries = newEntries;
+ menuPtr->numEntries++;
+ mePtr = ckalloc(sizeof(TkMenuEntry));
+ menuPtr->entries[index] = mePtr;
+ mePtr->type = type;
+ mePtr->optionTable = tsdPtr->entryOptionTables[type];
+ mePtr->menuPtr = menuPtr;
+ mePtr->labelPtr = NULL;
+ mePtr->labelLength = 0;
+ mePtr->underline = -1;
+ mePtr->bitmapPtr = NULL;
+ mePtr->imagePtr = NULL;
+ mePtr->image = NULL;
+ mePtr->selectImagePtr = NULL;
+ mePtr->selectImage = NULL;
+ mePtr->accelPtr = NULL;
+ mePtr->accelLength = 0;
+ mePtr->state = ENTRY_DISABLED;
+ mePtr->borderPtr = NULL;
+ mePtr->fgPtr = NULL;
+ mePtr->activeBorderPtr = NULL;
+ mePtr->activeFgPtr = NULL;
+ mePtr->fontPtr = NULL;
+ mePtr->indicatorOn = 0;
+ mePtr->indicatorFgPtr = NULL;
+ mePtr->columnBreak = 0;
+ mePtr->hideMargin = 0;
+ mePtr->commandPtr = NULL;
+ mePtr->namePtr = NULL;
+ mePtr->childMenuRefPtr = NULL;
+ mePtr->onValuePtr = NULL;
+ mePtr->offValuePtr = NULL;
+ mePtr->entryFlags = 0;
+ mePtr->index = index;
+ mePtr->nextCascadePtr = NULL;
+ if (Tk_InitOptions(menuPtr->interp, (char *) mePtr,
+ mePtr->optionTable, menuPtr->tkwin) != TCL_OK) {
+ ckfree(mePtr);
+ return NULL;
+ }
+ TkMenuInitializeEntryDrawingFields(mePtr);
+ if (TkpMenuNewEntry(mePtr) != TCL_OK) {
+ Tk_FreeConfigOptions((char *) mePtr, mePtr->optionTable,
+ menuPtr->tkwin);
+ ckfree(mePtr);
+ return NULL;
+ }
+
+ return mePtr;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * MenuAddOrInsert --
+ *
+ * This function does all of the work of the "add" and "insert" widget
+ * commands, allowing the code for these to be shared.
+ *
+ * Results:
+ * A standard Tcl return value.
+ *
+ * Side effects:
+ * A new menu entry is created in menuPtr.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+MenuAddOrInsert(
+ Tcl_Interp *interp, /* Used for error reporting. */
+ TkMenu *menuPtr, /* Widget in which to create new entry. */
+ Tcl_Obj *indexPtr, /* Object describing index at which to insert.
+ * NULL means insert at end. */
+ int objc, /* Number of elements in objv. */
+ Tcl_Obj *const objv[]) /* Arguments to command: first arg is type of
+ * entry, others are config options. */
+{
+ int type, index;
+ TkMenuEntry *mePtr;
+ TkMenu *menuListPtr;
+
+ if (indexPtr != NULL) {
+ if (TkGetMenuIndex(interp, menuPtr, indexPtr, 1, &index) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ } else {
+ index = menuPtr->numEntries;
+ }
+ if (index < 0) {
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "bad index \"%s\"", Tcl_GetString(indexPtr)));
+ Tcl_SetErrorCode(interp, "TK", "MENU", "INDEX", NULL);
+ return TCL_ERROR;
+ }
+ if (menuPtr->tearoff && (index == 0)) {
+ index = 1;
+ }
+
+ /*
+ * Figure out the type of the new entry.
+ */
+
+ if (Tcl_GetIndexFromObjStruct(interp, objv[0], menuEntryTypeStrings,
+ sizeof(char *), "menu entry type", 0, &type) != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ /*
+ * Now we have to add an entry for every instance related to this menu.
+ */
+
+ for (menuListPtr = menuPtr->masterMenuPtr; menuListPtr != NULL;
+ menuListPtr = menuListPtr->nextInstancePtr) {
+
+ mePtr = MenuNewEntry(menuListPtr, index, type);
+ if (mePtr == NULL) {
+ return TCL_ERROR;
+ }
+ if (ConfigureMenuEntry(mePtr, objc - 1, objv + 1) != TCL_OK) {
+ TkMenu *errorMenuPtr;
+ int i;
+
+ for (errorMenuPtr = menuPtr->masterMenuPtr;
+ errorMenuPtr != NULL;
+ errorMenuPtr = errorMenuPtr->nextInstancePtr) {
+ Tcl_EventuallyFree(errorMenuPtr->entries[index],
+ (Tcl_FreeProc *) DestroyMenuEntry);
+ for (i = index; i < errorMenuPtr->numEntries - 1; i++) {
+ errorMenuPtr->entries[i] = errorMenuPtr->entries[i + 1];
+ errorMenuPtr->entries[i]->index = i;
+ }
+ errorMenuPtr->numEntries--;
+ if (errorMenuPtr->numEntries == 0) {
+ ckfree(errorMenuPtr->entries);
+ errorMenuPtr->entries = NULL;
+ }
+ if (errorMenuPtr == menuListPtr) {
+ break;
+ }
+ }
+ return TCL_ERROR;
+ }
+
+ /*
+ * If a menu has cascades, then every instance of the menu has to have
+ * its own parallel cascade structure. So adding an entry to a menu
+ * with clones means that the menu that the entry points to has to be
+ * cloned for every clone the master menu has. This is special case #2
+ * in the comment at the top of this file.
+ */
+
+ if ((menuPtr != menuListPtr) && (type == CASCADE_ENTRY)) {
+ if ((mePtr->namePtr != NULL)
+ && (mePtr->childMenuRefPtr != NULL)
+ && (mePtr->childMenuRefPtr->menuPtr != NULL)) {
+ TkMenu *cascadeMenuPtr =
+ mePtr->childMenuRefPtr->menuPtr->masterMenuPtr;
+ Tcl_Obj *newCascadePtr, *newObjv[2];
+ Tcl_Obj *menuNamePtr = Tcl_NewStringObj("-menu", -1);
+ Tcl_Obj *windowNamePtr =
+ Tcl_NewStringObj(Tk_PathName(menuListPtr->tkwin), -1);
+ Tcl_Obj *normalPtr = Tcl_NewStringObj("normal", -1);
+ TkMenuReferences *menuRefPtr;
+
+ Tcl_IncrRefCount(windowNamePtr);
+ newCascadePtr = TkNewMenuName(menuListPtr->interp,
+ windowNamePtr, cascadeMenuPtr);
+ Tcl_IncrRefCount(newCascadePtr);
+ Tcl_IncrRefCount(normalPtr);
+ CloneMenu(cascadeMenuPtr, newCascadePtr, normalPtr);
+
+ menuRefPtr = TkFindMenuReferencesObj(menuListPtr->interp,
+ newCascadePtr);
+ if (menuRefPtr == NULL) {
+ Tcl_Panic("CloneMenu failed inside of MenuAddOrInsert");
+ }
+ newObjv[0] = menuNamePtr;
+ newObjv[1] = newCascadePtr;
+ Tcl_IncrRefCount(menuNamePtr);
+ Tcl_IncrRefCount(newCascadePtr);
+ ConfigureMenuEntry(mePtr, 2, newObjv);
+ Tcl_DecrRefCount(newCascadePtr);
+ Tcl_DecrRefCount(menuNamePtr);
+ Tcl_DecrRefCount(windowNamePtr);
+ Tcl_DecrRefCount(normalPtr);
+ }
+ }
+ }
+ return TCL_OK;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * MenuVarProc --
+ *
+ * This function is invoked when someone changes the state variable
+ * associated with a radiobutton or checkbutton menu entry. The entry's
+ * selected state is set to match the value of the variable.
+ *
+ * Results:
+ * NULL is always returned.
+ *
+ * Side effects:
+ * The menu entry may become selected or deselected.
+ *
+ *--------------------------------------------------------------
+ */
+
+static char *
+MenuVarProc(
+ ClientData clientData, /* Information about menu entry. */
+ Tcl_Interp *interp, /* Interpreter containing variable. */
+ const char *name1, /* First part of variable's name. */
+ const char *name2, /* Second part of variable's name. */
+ int flags) /* Describes what just happened. */
+{
+ TkMenuEntry *mePtr = clientData;
+ TkMenu *menuPtr;
+ const char *value;
+ const char *name, *onValue;
+
+ if (flags & TCL_INTERP_DESTROYED) {
+ /*
+ * Do nothing if the interpreter is going away.
+ */
+
+ return NULL;
+ }
+
+ menuPtr = mePtr->menuPtr;
+ name = Tcl_GetString(mePtr->namePtr);
+
+ /*
+ * If the variable is being unset, then re-establish the trace.
+ */
+
+ if (flags & TCL_TRACE_UNSETS) {
+ mePtr->entryFlags &= ~ENTRY_SELECTED;
+ if (flags & TCL_TRACE_DESTROYED) {
+ Tcl_TraceVar2(interp, name, NULL,
+ TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS,
+ MenuVarProc, clientData);
+ }
+ TkpConfigureMenuEntry(mePtr);
+ TkEventuallyRedrawMenu(menuPtr, NULL);
+ return NULL;
+ }
+
+ /*
+ * Use the value of the variable to update the selected status of the menu
+ * entry.
+ */
+
+ value = Tcl_GetVar2(interp, name, NULL, TCL_GLOBAL_ONLY);
+ if (value == NULL) {
+ value = "";
+ }
+ if (mePtr->onValuePtr != NULL) {
+ onValue = Tcl_GetString(mePtr->onValuePtr);
+ if (strcmp(value, onValue) == 0) {
+ if (mePtr->entryFlags & ENTRY_SELECTED) {
+ return NULL;
+ }
+ mePtr->entryFlags |= ENTRY_SELECTED;
+ } else if (mePtr->entryFlags & ENTRY_SELECTED) {
+ mePtr->entryFlags &= ~ENTRY_SELECTED;
+ } else {
+ return NULL;
+ }
+ } else {
+ return NULL;
+ }
+ TkpConfigureMenuEntry(mePtr);
+ TkEventuallyRedrawMenu(menuPtr, mePtr);
+ return NULL;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkActivateMenuEntry --
+ *
+ * This function is invoked to make a particular menu entry the active
+ * one, deactivating any other entry that might currently be active.
+ *
+ * Results:
+ * The return value is a standard Tcl result (errors can occur while
+ * posting and unposting submenus).
+ *
+ * Side effects:
+ * Menu entries get redisplayed, and the active entry changes. Submenus
+ * may get posted and unposted.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TkActivateMenuEntry(
+ register TkMenu *menuPtr, /* Menu in which to activate. */
+ int index) /* Index of entry to activate, or -1 to
+ * deactivate all entries. */
+{
+ register TkMenuEntry *mePtr;
+ int result = TCL_OK;
+
+ if (menuPtr->active >= 0) {
+ mePtr = menuPtr->entries[menuPtr->active];
+
+ /*
+ * Don't change the state unless it's currently active (state might
+ * already have been changed to disabled).
+ */
+
+ if (mePtr->state == ENTRY_ACTIVE) {
+ mePtr->state = ENTRY_NORMAL;
+ }
+ TkEventuallyRedrawMenu(menuPtr, menuPtr->entries[menuPtr->active]);
+ }
+ menuPtr->active = index;
+ if (index >= 0) {
+ mePtr = menuPtr->entries[index];
+ mePtr->state = ENTRY_ACTIVE;
+ TkEventuallyRedrawMenu(menuPtr, mePtr);
+ }
+ return result;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkPostCommand --
+ *
+ * Execute the postcommand for the given menu.
+ *
+ * Results:
+ * The return value is a standard Tcl result (errors can occur while the
+ * postcommands are being processed).
+ *
+ * Side effects:
+ * Since commands can get executed while this routine is being executed,
+ * the entire world can change.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TkPostCommand(
+ TkMenu *menuPtr)
+{
+ int result;
+
+ /*
+ * If there is a command for the menu, execute it. This may change the
+ * size of the menu, so be sure to recompute the menu's geometry if
+ * needed.
+ */
+
+ if (menuPtr->postCommandPtr != NULL) {
+ Tcl_Obj *postCommandPtr = menuPtr->postCommandPtr;
+
+ Tcl_IncrRefCount(postCommandPtr);
+ result = Tcl_EvalObjEx(menuPtr->interp, postCommandPtr,
+ TCL_EVAL_GLOBAL);
+ Tcl_DecrRefCount(postCommandPtr);
+ if (result != TCL_OK) {
+ return result;
+ }
+ TkRecomputeMenu(menuPtr);
+ }
+ return TCL_OK;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * CloneMenu --
+ *
+ * Creates a child copy of the menu. It will be inserted into the menu's
+ * instance chain. All attributes and entry attributes will be
+ * duplicated.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * Allocates storage. After the menu is created, any configuration done
+ * with this menu or any related one will be reflected in all of them.
+ *
+ *--------------------------------------------------------------
+ */
+
+static int
+CloneMenu(
+ TkMenu *menuPtr, /* The menu we are going to clone. */
+ Tcl_Obj *newMenuNamePtr, /* The name to give the new menu. */
+ Tcl_Obj *newMenuTypePtr) /* What kind of menu is this, a normal menu a
+ * menubar, or a tearoff? */
+{
+ int returnResult;
+ int menuType, i;
+ TkMenuReferences *menuRefPtr;
+ Tcl_Obj *menuDupCommandArray[4];
+
+ if (newMenuTypePtr == NULL) {
+ menuType = MASTER_MENU;
+ } else {
+ if (Tcl_GetIndexFromObjStruct(menuPtr->interp, newMenuTypePtr,
+ menuTypeStrings, sizeof(char *), "menu type", 0, &menuType) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ }
+
+ menuDupCommandArray[0] = Tcl_NewStringObj("tk::MenuDup", -1);
+ menuDupCommandArray[1] = Tcl_NewStringObj(Tk_PathName(menuPtr->tkwin), -1);
+ menuDupCommandArray[2] = newMenuNamePtr;
+ if (newMenuTypePtr == NULL) {
+ menuDupCommandArray[3] = Tcl_NewStringObj("normal", -1);
+ } else {
+ menuDupCommandArray[3] = newMenuTypePtr;
+ }
+ for (i = 0; i < 4; i++) {
+ Tcl_IncrRefCount(menuDupCommandArray[i]);
+ }
+ Tcl_Preserve(menuPtr);
+ returnResult = Tcl_EvalObjv(menuPtr->interp, 4, menuDupCommandArray, 0);
+ for (i = 0; i < 4; i++) {
+ Tcl_DecrRefCount(menuDupCommandArray[i]);
+ }
+
+ /*
+ * Make sure the tcl command actually created the clone.
+ */
+
+ if ((returnResult == TCL_OK) &&
+ ((menuRefPtr = TkFindMenuReferencesObj(menuPtr->interp,
+ newMenuNamePtr)) != NULL)
+ && (menuPtr->numEntries == menuRefPtr->menuPtr->numEntries)) {
+ TkMenu *newMenuPtr = menuRefPtr->menuPtr;
+ Tcl_Obj *newObjv[3];
+ int i, numElements;
+
+ /*
+ * Now put this newly created menu into the parent menu's instance
+ * chain.
+ */
+
+ if (menuPtr->nextInstancePtr == NULL) {
+ menuPtr->nextInstancePtr = newMenuPtr;
+ newMenuPtr->masterMenuPtr = menuPtr->masterMenuPtr;
+ } else {
+ TkMenu *masterMenuPtr;
+
+ masterMenuPtr = menuPtr->masterMenuPtr;
+ newMenuPtr->nextInstancePtr = masterMenuPtr->nextInstancePtr;
+ masterMenuPtr->nextInstancePtr = newMenuPtr;
+ newMenuPtr->masterMenuPtr = masterMenuPtr;
+ }
+
+ /*
+ * Add the master menu's window to the bind tags for this window after
+ * this window's tag. This is so the user can bind to either this
+ * clone (which may not be easy to do) or the entire menu clone
+ * structure.
+ */
+
+ newObjv[0] = Tcl_NewStringObj("bindtags", -1);
+ newObjv[1] = Tcl_NewStringObj(Tk_PathName(newMenuPtr->tkwin), -1);
+ Tcl_IncrRefCount(newObjv[0]);
+ Tcl_IncrRefCount(newObjv[1]);
+ if (Tk_BindtagsObjCmd(newMenuPtr->tkwin, newMenuPtr->interp, 2,
+ newObjv) == TCL_OK) {
+ const char *windowName;
+ Tcl_Obj *bindingsPtr =
+ Tcl_DuplicateObj(Tcl_GetObjResult(newMenuPtr->interp));
+ Tcl_Obj *elementPtr;
+
+ Tcl_IncrRefCount(bindingsPtr);
+ Tcl_ListObjLength(newMenuPtr->interp, bindingsPtr, &numElements);
+ for (i = 0; i < numElements; i++) {
+ Tcl_ListObjIndex(newMenuPtr->interp, bindingsPtr, i,
+ &elementPtr);
+ windowName = Tcl_GetString(elementPtr);
+ if (strcmp(windowName, Tk_PathName(newMenuPtr->tkwin))
+ == 0) {
+ Tcl_Obj *newElementPtr = Tcl_NewStringObj(
+ Tk_PathName(newMenuPtr->masterMenuPtr->tkwin), -1);
+
+ /*
+ * The newElementPtr will have its refCount incremented
+ * here, so we don't need to worry about it any more.
+ */
+
+ Tcl_ListObjReplace(menuPtr->interp, bindingsPtr,
+ i + 1, 0, 1, &newElementPtr);
+ newObjv[2] = bindingsPtr;
+ Tk_BindtagsObjCmd(newMenuPtr->tkwin, menuPtr->interp, 3,
+ newObjv);
+ break;
+ }
+ }
+ Tcl_DecrRefCount(bindingsPtr);
+ }
+ Tcl_DecrRefCount(newObjv[0]);
+ Tcl_DecrRefCount(newObjv[1]);
+ Tcl_ResetResult(menuPtr->interp);
+
+ /*
+ * Clone all of the cascade menus that this menu points to.
+ */
+
+ for (i = 0; i < menuPtr->numEntries; i++) {
+ TkMenuReferences *cascadeRefPtr;
+ TkMenu *oldCascadePtr;
+
+ if ((menuPtr->entries[i]->type == CASCADE_ENTRY)
+ && (menuPtr->entries[i]->namePtr != NULL)) {
+ cascadeRefPtr =
+ TkFindMenuReferencesObj(menuPtr->interp,
+ menuPtr->entries[i]->namePtr);
+ if ((cascadeRefPtr != NULL) && (cascadeRefPtr->menuPtr)) {
+ Tcl_Obj *windowNamePtr =
+ Tcl_NewStringObj(Tk_PathName(newMenuPtr->tkwin),
+ -1);
+ Tcl_Obj *newCascadePtr;
+
+ oldCascadePtr = cascadeRefPtr->menuPtr;
+
+ Tcl_IncrRefCount(windowNamePtr);
+ newCascadePtr = TkNewMenuName(menuPtr->interp,
+ windowNamePtr, oldCascadePtr);
+ Tcl_IncrRefCount(newCascadePtr);
+ CloneMenu(oldCascadePtr, newCascadePtr, NULL);
+
+ newObjv[0] = Tcl_NewStringObj("-menu", -1);
+ newObjv[1] = newCascadePtr;
+ Tcl_IncrRefCount(newObjv[0]);
+ ConfigureMenuEntry(newMenuPtr->entries[i], 2, newObjv);
+ Tcl_DecrRefCount(newObjv[0]);
+ Tcl_DecrRefCount(newCascadePtr);
+ Tcl_DecrRefCount(windowNamePtr);
+ }
+ }
+ }
+
+ returnResult = TCL_OK;
+ } else {
+ returnResult = TCL_ERROR;
+ }
+ Tcl_Release(menuPtr);
+ return returnResult;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * MenuDoXPosition --
+ *
+ * Given arguments from an option command line, returns the X position.
+ *
+ * Results:
+ * Returns TCL_OK or TCL_Error
+ *
+ * Side effects:
+ * xPosition is set to the X-position of the menu entry.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+MenuDoXPosition(
+ Tcl_Interp *interp,
+ TkMenu *menuPtr,
+ Tcl_Obj *objPtr)
+{
+ int index;
+
+ TkRecomputeMenu(menuPtr);
+ if (TkGetMenuIndex(interp, menuPtr, objPtr, 0, &index) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ Tcl_ResetResult(interp);
+ if (index < 0) {
+ Tcl_SetObjResult(interp, Tcl_NewIntObj(0));
+ } else {
+ Tcl_SetObjResult(interp, Tcl_NewIntObj(menuPtr->entries[index]->x));
+ }
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * MenuDoYPosition --
+ *
+ * Given arguments from an option command line, returns the Y position.
+ *
+ * Results:
+ * Returns TCL_OK or TCL_Error
+ *
+ * Side effects:
+ * yPosition is set to the Y-position of the menu entry.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+MenuDoYPosition(
+ Tcl_Interp *interp,
+ TkMenu *menuPtr,
+ Tcl_Obj *objPtr)
+{
+ int index;
+
+ TkRecomputeMenu(menuPtr);
+ if (TkGetMenuIndex(interp, menuPtr, objPtr, 0, &index) != TCL_OK) {
+ goto error;
+ }
+ Tcl_ResetResult(interp);
+ if (index < 0) {
+ Tcl_SetObjResult(interp, Tcl_NewIntObj(0));
+ } else {
+ Tcl_SetObjResult(interp, Tcl_NewIntObj(menuPtr->entries[index]->y));
+ }
+
+ return TCL_OK;
+
+ error:
+ return TCL_ERROR;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * GetIndexFromCoords --
+ *
+ * Given a string of the form "@integer", return the menu item
+ * corresponding to the provided y-coordinate in the menu window.
+ *
+ * Results:
+ * If int is a valid number, *indexPtr will be the number of the
+ * menuentry that is the correct height. If int is invalid, *indexPtr
+ * will be unchanged. Returns appropriate Tcl error number.
+ *
+ * Side effects:
+ * If int is invalid, interp's result will be set to NULL.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+GetIndexFromCoords(
+ Tcl_Interp *interp, /* Interpreter of menu. */
+ TkMenu *menuPtr, /* The menu we are searching. */
+ const char *string, /* The @string we are parsing. */
+ int *indexPtr) /* The index of the item that matches. */
+{
+ int x, y, i;
+ const char *p;
+ char *end;
+ int x2, borderwidth, max;
+
+ TkRecomputeMenu(menuPtr);
+ p = string + 1;
+ y = strtol(p, &end, 0);
+ if (end == p) {
+ goto error;
+ }
+ Tk_GetPixelsFromObj(interp, menuPtr->tkwin,
+ menuPtr->borderWidthPtr, &borderwidth);
+ if (*end == ',') {
+ x = y;
+ p = end + 1;
+ y = strtol(p, &end, 0);
+ if (end == p) {
+ goto error;
+ }
+ } else {
+ x = borderwidth;
+ }
+
+ *indexPtr = -1;
+
+ /* set the width of the final column to the remainder of the window
+ * being aware of windows that may not be mapped yet.
+ */
+ max = Tk_IsMapped(menuPtr->tkwin)
+ ? Tk_Width(menuPtr->tkwin) : Tk_ReqWidth(menuPtr->tkwin);
+ max -= borderwidth;
+
+ for (i = 0; i < menuPtr->numEntries; i++) {
+ if (menuPtr->entries[i]->entryFlags & ENTRY_LAST_COLUMN) {
+ x2 = max;
+ } else {
+ x2 = menuPtr->entries[i]->x + menuPtr->entries[i]->width;
+ }
+ if ((x >= menuPtr->entries[i]->x) && (y >= menuPtr->entries[i]->y)
+ && (x < x2)
+ && (y < (menuPtr->entries[i]->y
+ + menuPtr->entries[i]->height))) {
+ *indexPtr = i;
+ break;
+ }
+ }
+ return TCL_OK;
+
+ error:
+ Tcl_ResetResult(interp);
+ return TCL_ERROR;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * RecursivelyDeleteMenu --
+ *
+ * Deletes a menu and any cascades underneath it. Used for deleting
+ * instances when a menu is no longer being used as a menubar, for
+ * instance.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Destroys the menu and all cascade menus underneath it.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+RecursivelyDeleteMenu(
+ TkMenu *menuPtr) /* The menubar instance we are deleting. */
+{
+ int i;
+ TkMenuEntry *mePtr;
+
+ /*
+ * It is not 100% clear that this preserve/release pair is required, but
+ * we have added them for safety in this very complex code.
+ */
+
+ Tcl_Preserve(menuPtr);
+
+ for (i = 0; i < menuPtr->numEntries; i++) {
+ mePtr = menuPtr->entries[i];
+ if ((mePtr->type == CASCADE_ENTRY)
+ && (mePtr->childMenuRefPtr != NULL)
+ && (mePtr->childMenuRefPtr->menuPtr != NULL)) {
+ RecursivelyDeleteMenu(mePtr->childMenuRefPtr->menuPtr);
+ }
+ }
+ if (menuPtr->tkwin != NULL) {
+ Tk_DestroyWindow(menuPtr->tkwin);
+ }
+
+ Tcl_Release(menuPtr);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkNewMenuName --
+ *
+ * Makes a new unique name for a cloned menu. Will be a child of oldName.
+ *
+ * Results:
+ * Returns a char * which has been allocated; caller must free.
+ *
+ * Side effects:
+ * Memory is allocated.
+ *
+ *----------------------------------------------------------------------
+ */
+
+Tcl_Obj *
+TkNewMenuName(
+ Tcl_Interp *interp, /* The interp the new name has to live in.*/
+ Tcl_Obj *parentPtr, /* The prefix path of the new name. */
+ TkMenu *menuPtr) /* The menu we are cloning. */
+{
+ Tcl_Obj *resultPtr = NULL; /* Initialization needed only to prevent
+ * compiler warning. */
+ Tcl_Obj *childPtr;
+ char *destString;
+ int i;
+ int doDot;
+ Tcl_HashTable *nameTablePtr = NULL;
+ TkWindow *winPtr = (TkWindow *) menuPtr->tkwin;
+ const char *parentName = Tcl_GetString(parentPtr);
+
+ if (winPtr->mainPtr != NULL) {
+ nameTablePtr = &(winPtr->mainPtr->nameTable);
+ }
+
+ doDot = parentName[strlen(parentName) - 1] != '.';
+
+ childPtr = Tcl_NewStringObj(Tk_PathName(menuPtr->tkwin), -1);
+ for (destString = Tcl_GetString(childPtr);
+ *destString != '\0'; destString++) {
+ if (*destString == '.') {
+ *destString = '#';
+ }
+ }
+
+ for (i = 0; ; i++) {
+ if (i == 0) {
+ resultPtr = Tcl_DuplicateObj(parentPtr);
+ if (doDot) {
+ Tcl_AppendToObj(resultPtr, ".", -1);
+ }
+ Tcl_AppendObjToObj(resultPtr, childPtr);
+ } else {
+ Tcl_Obj *intPtr;
+
+ Tcl_DecrRefCount(resultPtr);
+ resultPtr = Tcl_DuplicateObj(parentPtr);
+ if (doDot) {
+ Tcl_AppendToObj(resultPtr, ".", -1);
+ }
+ Tcl_AppendObjToObj(resultPtr, childPtr);
+ intPtr = Tcl_NewIntObj(i);
+ Tcl_AppendObjToObj(resultPtr, intPtr);
+ Tcl_DecrRefCount(intPtr);
+ }
+ destString = Tcl_GetString(resultPtr);
+ if ((Tcl_FindCommand(interp, destString, NULL, 0) == NULL)
+ && ((nameTablePtr == NULL)
+ || (Tcl_FindHashEntry(nameTablePtr, destString) == NULL))) {
+ break;
+ }
+ }
+ Tcl_DecrRefCount(childPtr);
+ return resultPtr;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkSetWindowMenuBar --
+ *
+ * Associates a menu with a window. Called by ConfigureFrame in in
+ * response to a "-menu .foo" configuration option for a top level.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The old menu clones for the menubar are thrown away, and a handler is
+ * set up to allocate the new ones.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TkSetWindowMenuBar(
+ Tcl_Interp *interp, /* The interpreter the toplevel lives in. */
+ Tk_Window tkwin, /* The toplevel window. */
+ const char *oldMenuName, /* The name of the menubar previously set in
+ * this toplevel. NULL means no menu was set
+ * previously. */
+ const char *menuName) /* The name of the new menubar that the
+ * toplevel needs to be set to. NULL means
+ * that their is no menu now. */
+{
+ TkMenuTopLevelList *topLevelListPtr, *prevTopLevelPtr;
+ TkMenu *menuPtr;
+ TkMenuReferences *menuRefPtr;
+
+ /*
+ * Destroy the menubar instances of the old menu. Take this window out of
+ * the old menu's top level reference list.
+ */
+
+ if (oldMenuName != NULL) {
+ menuRefPtr = TkFindMenuReferences(interp, oldMenuName);
+ if (menuRefPtr != NULL) {
+ /*
+ * Find the menubar instance that is to be removed. Destroy it and
+ * all of the cascades underneath it.
+ */
+
+ if (menuRefPtr->menuPtr != NULL) {
+ TkMenu *instancePtr;
+
+ menuPtr = menuRefPtr->menuPtr;
+
+ for (instancePtr = menuPtr->masterMenuPtr;
+ instancePtr != NULL;
+ instancePtr = instancePtr->nextInstancePtr) {
+ if (instancePtr->menuType == MENUBAR
+ && instancePtr->parentTopLevelPtr == tkwin) {
+ RecursivelyDeleteMenu(instancePtr);
+ break;
+ }
+ }
+ }
+
+ /*
+ * Now we need to remove this toplevel from the list of toplevels
+ * that reference this menu.
+ */
+
+ topLevelListPtr = menuRefPtr->topLevelListPtr;
+ prevTopLevelPtr = NULL;
+
+ while ((topLevelListPtr != NULL)
+ && (topLevelListPtr->tkwin != tkwin)) {
+ prevTopLevelPtr = topLevelListPtr;
+ topLevelListPtr = topLevelListPtr->nextPtr;
+ }
+
+ /*
+ * Now we have found the toplevel reference that matches the
+ * tkwin; remove this reference from the list.
+ */
+
+ if (topLevelListPtr != NULL) {
+ if (prevTopLevelPtr == NULL) {
+ menuRefPtr->topLevelListPtr =
+ menuRefPtr->topLevelListPtr->nextPtr;
+ } else {
+ prevTopLevelPtr->nextPtr = topLevelListPtr->nextPtr;
+ }
+ ckfree(topLevelListPtr);
+ TkFreeMenuReferences(menuRefPtr);
+ }
+ }
+ }
+
+ /*
+ * Now, add the clone references for the new menu.
+ */
+
+ if (menuName != NULL && menuName[0] != 0) {
+ TkMenu *menuBarPtr = NULL;
+
+ menuRefPtr = TkCreateMenuReferences(interp, menuName);
+
+ menuPtr = menuRefPtr->menuPtr;
+ if (menuPtr != NULL) {
+ Tcl_Obj *cloneMenuPtr;
+ TkMenuReferences *cloneMenuRefPtr;
+ Tcl_Obj *newObjv[4];
+ Tcl_Obj *windowNamePtr = Tcl_NewStringObj(Tk_PathName(tkwin),
+ -1);
+ Tcl_Obj *menubarPtr = Tcl_NewStringObj("menubar", -1);
+
+ /*
+ * Clone the menu and all of the cascades underneath it.
+ */
+
+ Tcl_IncrRefCount(windowNamePtr);
+ cloneMenuPtr = TkNewMenuName(interp, windowNamePtr,
+ menuPtr);
+ Tcl_IncrRefCount(cloneMenuPtr);
+ Tcl_IncrRefCount(menubarPtr);
+ CloneMenu(menuPtr, cloneMenuPtr, menubarPtr);
+
+ cloneMenuRefPtr = TkFindMenuReferencesObj(interp, cloneMenuPtr);
+ if ((cloneMenuRefPtr != NULL)
+ && (cloneMenuRefPtr->menuPtr != NULL)) {
+ Tcl_Obj *cursorPtr = Tcl_NewStringObj("-cursor", -1);
+ Tcl_Obj *nullPtr = Tcl_NewObj();
+
+ cloneMenuRefPtr->menuPtr->parentTopLevelPtr = tkwin;
+ menuBarPtr = cloneMenuRefPtr->menuPtr;
+ newObjv[0] = cursorPtr;
+ newObjv[1] = nullPtr;
+ Tcl_IncrRefCount(cursorPtr);
+ Tcl_IncrRefCount(nullPtr);
+ ConfigureMenu(menuPtr->interp, cloneMenuRefPtr->menuPtr,
+ 2, newObjv);
+ Tcl_DecrRefCount(cursorPtr);
+ Tcl_DecrRefCount(nullPtr);
+ }
+
+ TkpSetWindowMenuBar(tkwin, menuBarPtr);
+ Tcl_DecrRefCount(cloneMenuPtr);
+ Tcl_DecrRefCount(menubarPtr);
+ Tcl_DecrRefCount(windowNamePtr);
+ } else {
+ TkpSetWindowMenuBar(tkwin, NULL);
+ }
+
+ /*
+ * Add this window to the menu's list of windows that refer to this
+ * menu.
+ */
+
+ topLevelListPtr = ckalloc(sizeof(TkMenuTopLevelList));
+ topLevelListPtr->tkwin = tkwin;
+ topLevelListPtr->nextPtr = menuRefPtr->topLevelListPtr;
+ menuRefPtr->topLevelListPtr = topLevelListPtr;
+ } else {
+ TkpSetWindowMenuBar(tkwin, NULL);
+ }
+ TkpSetMainMenubar(interp, tkwin, menuName);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * DestroyMenuHashTable --
+ *
+ * Called when an interp is deleted and a menu hash table has been set in
+ * it.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The hash table is destroyed.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+DestroyMenuHashTable(
+ ClientData clientData, /* The menu hash table we are destroying. */
+ Tcl_Interp *interp) /* The interpreter we are destroying. */
+{
+ Tcl_DeleteHashTable(clientData);
+ ckfree(clientData);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkGetMenuHashTable --
+ *
+ * For a given interp, give back the menu hash table that goes with it.
+ * If the hash table does not exist, it is created.
+ *
+ * Results:
+ * Returns a hash table pointer.
+ *
+ * Side effects:
+ * A new hash table is created if there were no table in the interp
+ * originally.
+ *
+ *----------------------------------------------------------------------
+ */
+
+Tcl_HashTable *
+TkGetMenuHashTable(
+ Tcl_Interp *interp) /* The interp we need the hash table in.*/
+{
+ Tcl_HashTable *menuTablePtr =
+ Tcl_GetAssocData(interp, MENU_HASH_KEY, NULL);
+
+ if (menuTablePtr == NULL) {
+ menuTablePtr = ckalloc(sizeof(Tcl_HashTable));
+ Tcl_InitHashTable(menuTablePtr, TCL_STRING_KEYS);
+ Tcl_SetAssocData(interp, MENU_HASH_KEY, DestroyMenuHashTable,
+ menuTablePtr);
+ }
+ return menuTablePtr;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkCreateMenuReferences --
+ *
+ * Given a pathname, gives back a pointer to a TkMenuReferences
+ * structure. If a reference is not already in the hash table, one is
+ * created.
+ *
+ * Results:
+ * Returns a pointer to a menu reference structure. Should not be freed
+ * by calller; when a field of the reference is cleared,
+ * TkFreeMenuReferences should be called.
+ *
+ * Side effects:
+ * A new hash table entry is created if there were no references to the
+ * menu originally.
+ *
+ *----------------------------------------------------------------------
+ */
+
+TkMenuReferences *
+TkCreateMenuReferences(
+ Tcl_Interp *interp,
+ const char *pathName) /* The path of the menu widget. */
+{
+ Tcl_HashEntry *hashEntryPtr;
+ TkMenuReferences *menuRefPtr;
+ int newEntry;
+ Tcl_HashTable *menuTablePtr = TkGetMenuHashTable(interp);
+
+ hashEntryPtr = Tcl_CreateHashEntry(menuTablePtr, pathName, &newEntry);
+ if (newEntry) {
+ menuRefPtr = ckalloc(sizeof(TkMenuReferences));
+ menuRefPtr->menuPtr = NULL;
+ menuRefPtr->topLevelListPtr = NULL;
+ menuRefPtr->parentEntryPtr = NULL;
+ menuRefPtr->hashEntryPtr = hashEntryPtr;
+ Tcl_SetHashValue(hashEntryPtr, menuRefPtr);
+ } else {
+ menuRefPtr = Tcl_GetHashValue(hashEntryPtr);
+ }
+ return menuRefPtr;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkFindMenuReferences --
+ *
+ * Given a pathname, gives back a pointer to the TkMenuReferences
+ * structure.
+ *
+ * Results:
+ * Returns a pointer to a menu reference structure. Should not be freed
+ * by calller; when a field of the reference is cleared,
+ * TkFreeMenuReferences should be called. Returns NULL if no reference
+ * with this pathname exists.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+TkMenuReferences *
+TkFindMenuReferences(
+ Tcl_Interp *interp, /* The interp the menu is living in. */
+ const char *pathName) /* The path of the menu widget. */
+{
+ Tcl_HashEntry *hashEntryPtr;
+ TkMenuReferences *menuRefPtr = NULL;
+ Tcl_HashTable *menuTablePtr;
+
+ menuTablePtr = TkGetMenuHashTable(interp);
+ hashEntryPtr = Tcl_FindHashEntry(menuTablePtr, pathName);
+ if (hashEntryPtr != NULL) {
+ menuRefPtr = Tcl_GetHashValue(hashEntryPtr);
+ }
+ return menuRefPtr;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkFindMenuReferencesObj --
+ *
+ * Given a pathname, gives back a pointer to the TkMenuReferences
+ * structure.
+ *
+ * Results:
+ * Returns a pointer to a menu reference structure. Should not be freed
+ * by calller; when a field of the reference is cleared,
+ * TkFreeMenuReferences should be called. Returns NULL if no reference
+ * with this pathname exists.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+TkMenuReferences *
+TkFindMenuReferencesObj(
+ Tcl_Interp *interp, /* The interp the menu is living in. */
+ Tcl_Obj *objPtr) /* The path of the menu widget. */
+{
+ const char *pathName = Tcl_GetString(objPtr);
+
+ return TkFindMenuReferences(interp, pathName);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkFreeMenuReferences --
+ *
+ * This is called after one of the fields in a menu reference is cleared.
+ * It cleans up the ref if it is now empty.
+ *
+ * Results:
+ * Returns 1 if the references structure was freed, and 0 otherwise.
+ *
+ * Side effects:
+ * If this is the last field to be cleared, the menu ref is taken out of
+ * the hash table.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TkFreeMenuReferences(
+ TkMenuReferences *menuRefPtr)
+ /* The menu reference to free. */
+{
+ if ((menuRefPtr->menuPtr == NULL)
+ && (menuRefPtr->parentEntryPtr == NULL)
+ && (menuRefPtr->topLevelListPtr == NULL)) {
+ Tcl_DeleteHashEntry(menuRefPtr->hashEntryPtr);
+ ckfree(menuRefPtr);
+ return 1;
+ }
+ return 0;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * DeleteMenuCloneEntries --
+ *
+ * For every clone in this clone chain, delete the menu entries given by
+ * the parameters.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The appropriate entries are deleted from all clones of this menu.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+DeleteMenuCloneEntries(
+ TkMenu *menuPtr, /* The menu the command was issued with. */
+ int first, /* The zero-based first entry in the set of
+ * entries to delete. */
+ int last) /* The zero-based last entry. */
+{
+ TkMenu *menuListPtr;
+ int numDeleted, i, j;
+
+ numDeleted = last + 1 - first;
+ for (menuListPtr = menuPtr->masterMenuPtr; menuListPtr != NULL;
+ menuListPtr = menuListPtr->nextInstancePtr) {
+ for (i = last; i >= first; i--) {
+ Tcl_EventuallyFree(menuListPtr->entries[i], (Tcl_FreeProc *) DestroyMenuEntry);
+ }
+ for (i = last + 1; i < menuListPtr->numEntries; i++) {
+ j = i - numDeleted;
+ menuListPtr->entries[j] = menuListPtr->entries[i];
+ menuListPtr->entries[j]->index = j;
+ }
+ menuListPtr->numEntries -= numDeleted;
+ if (menuListPtr->numEntries == 0) {
+ ckfree(menuListPtr->entries);
+ menuListPtr->entries = NULL;
+ }
+ if ((menuListPtr->active >= first)
+ && (menuListPtr->active <= last)) {
+ menuListPtr->active = -1;
+ } else if (menuListPtr->active > last) {
+ menuListPtr->active -= numDeleted;
+ }
+ TkEventuallyRecomputeMenu(menuListPtr);
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkMenuCleanup --
+ *
+ * Resets menusInitialized to allow Tk to be finalized and reused without
+ * the DLL being unloaded.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+TkMenuCleanup(
+ ClientData unused)
+{
+ menusInitialized = 0;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkMenuInit --
+ *
+ * Sets up the hash tables and the variables used by the menu package.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * lastMenuID gets initialized, and the parent hash and the command hash
+ * are allocated.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TkMenuInit(void)
+{
+ ThreadSpecificData *tsdPtr =
+ Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
+
+ if (!menusInitialized) {
+ Tcl_MutexLock(&menuMutex);
+ if (!menusInitialized) {
+ TkpMenuInit();
+ menusInitialized = 1;
+ }
+
+ /*
+ * Make sure we cleanup on finalize.
+ */
+
+ TkCreateExitHandler((Tcl_ExitProc *) TkMenuCleanup, NULL);
+ Tcl_MutexUnlock(&menuMutex);
+ }
+ if (!tsdPtr->menusInitialized) {
+ TkpMenuThreadInit();
+ tsdPtr->menuOptionTable =
+ Tk_CreateOptionTable(NULL, tkMenuConfigSpecs);
+ tsdPtr->entryOptionTables[TEAROFF_ENTRY] =
+ Tk_CreateOptionTable(NULL, specsArray[TEAROFF_ENTRY]);
+ tsdPtr->entryOptionTables[COMMAND_ENTRY] =
+ Tk_CreateOptionTable(NULL, specsArray[COMMAND_ENTRY]);
+ tsdPtr->entryOptionTables[CASCADE_ENTRY] =
+ Tk_CreateOptionTable(NULL, specsArray[CASCADE_ENTRY]);
+ tsdPtr->entryOptionTables[SEPARATOR_ENTRY] =
+ Tk_CreateOptionTable(NULL, specsArray[SEPARATOR_ENTRY]);
+ tsdPtr->entryOptionTables[RADIO_BUTTON_ENTRY] =
+ Tk_CreateOptionTable(NULL, specsArray[RADIO_BUTTON_ENTRY]);
+ tsdPtr->entryOptionTables[CHECK_BUTTON_ENTRY] =
+ Tk_CreateOptionTable(NULL, specsArray[CHECK_BUTTON_ENTRY]);
+ tsdPtr->menusInitialized = 1;
+ }
+}
+
+/*
+ * Local Variables:
+ * mode: c
+ * c-basic-offset: 4
+ * fill-column: 78
+ * End:
+ */
diff --git a/tk8.6/generic/tkMenu.h b/tk8.6/generic/tkMenu.h
new file mode 100644
index 0000000..bac51aa
--- /dev/null
+++ b/tk8.6/generic/tkMenu.h
@@ -0,0 +1,549 @@
+/*
+ * tkMenu.h --
+ *
+ * Declarations shared among all of the files that implement menu
+ * widgets.
+ *
+ * Copyright (c) 1996-1998 by Sun Microsystems, Inc.
+ *
+ * See the file "license.terms" for information on usage and redistribution of
+ * this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ */
+
+#ifndef _TKMENU
+#define _TKMENU
+
+#ifndef _TK
+#include "tk.h"
+#endif
+
+#ifndef _TKINT
+#include "tkInt.h"
+#endif
+
+#ifndef _DEFAULT
+#include "default.h"
+#endif
+
+/*
+ * Dummy types used by the platform menu code.
+ */
+
+typedef struct TkMenuPlatformData_ *TkMenuPlatformData;
+typedef struct TkMenuPlatformEntryData_ *TkMenuPlatformEntryData;
+
+/*
+ * Legal values for the "compound" field of TkMenuEntry and TkMenuButton
+ * records.
+ */
+
+enum compound {
+ COMPOUND_BOTTOM, COMPOUND_CENTER, COMPOUND_LEFT, COMPOUND_NONE,
+ COMPOUND_RIGHT, COMPOUND_TOP
+};
+
+/*
+ * Additional menu entry drawing parameters for Windows platform.
+ * DRAW_MENU_ENTRY_ARROW makes TkpDrawMenuEntry draw the arrow
+ * itself when cascade entry is disabled.
+ * DRAW_MENU_ENTRY_NOUNDERLINE forbids underline when ODS_NOACCEL
+ * is set, thus obeying the system-wide Windows UI setting.
+ */
+
+enum drawingParameters {
+ DRAW_MENU_ENTRY_ARROW = (1<<0),
+ DRAW_MENU_ENTRY_NOUNDERLINE = (1<<1)
+};
+
+/*
+ * One of the following data structures is kept for each entry of each menu
+ * managed by this file:
+ */
+
+typedef struct TkMenuEntry {
+ int type; /* Type of menu entry; see below for valid
+ * types. */
+ struct TkMenu *menuPtr; /* Menu with which this entry is
+ * associated. */
+ Tk_OptionTable optionTable; /* Option table for this menu entry. */
+ Tcl_Obj *labelPtr; /* Main text label displayed in entry (NULL if
+ * no label). */
+ int labelLength; /* Number of non-NULL characters in label. */
+ int state; /* State of button for display purposes:
+ * normal, active, or disabled. */
+ int underline; /* Value of -underline option: specifies index
+ * of character to underline (<0 means don't
+ * underline anything). */
+ Tcl_Obj *underlinePtr; /* Index of character to underline. */
+ Tcl_Obj *bitmapPtr; /* Bitmap to display in menu entry, or None.
+ * If not None then label is ignored. */
+ Tcl_Obj *imagePtr; /* Name of image to display, or NULL. If not
+ * NULL, bitmap, text, and textVarName are
+ * ignored. */
+ Tk_Image image; /* Image to display in menu entry, or NULL if
+ * none. */
+ Tcl_Obj *selectImagePtr; /* Name of image to display when selected, or
+ * NULL. */
+ Tk_Image selectImage; /* Image to display in entry when selected, or
+ * NULL if none. Ignored if image is NULL. */
+ Tcl_Obj *accelPtr; /* Accelerator string displayed at right of
+ * menu entry. NULL means no such accelerator.
+ * Malloc'ed. */
+ int accelLength; /* Number of non-NULL characters in
+ * accelerator. */
+ int indicatorOn; /* True means draw indicator, false means
+ * don't draw it. This field is ignored unless
+ * the entry is a radio or check button. */
+ /*
+ * Display attributes
+ */
+
+ Tcl_Obj *borderPtr; /* Structure used to draw background for
+ * entry. NULL means use overall border for
+ * menu. */
+ Tcl_Obj *fgPtr; /* Foreground color to use for entry. NULL
+ * means use foreground color from menu. */
+ Tcl_Obj *activeBorderPtr; /* Used to draw background and border when
+ * element is active. NULL means use
+ * activeBorder from menu. */
+ Tcl_Obj *activeFgPtr; /* Foreground color to use when entry is
+ * active. NULL means use active foreground
+ * from menu. */
+ Tcl_Obj *indicatorFgPtr; /* Color for indicators in radio and check
+ * button entries. NULL means use indicatorFg
+ * GC from menu. */
+ Tcl_Obj *fontPtr; /* Text font for menu entries. NULL means use
+ * overall font for menu. */
+ int columnBreak; /* If this is 0, this item appears below the
+ * item in front of it. If this is 1, this
+ * item starts a new column. This field is
+ * always 0 for tearoff and separator
+ * entries. */
+ int hideMargin; /* If this is 0, then the item has enough
+ * margin to accomodate a standard check mark
+ * and a default right margin. If this is 1,
+ * then the item has no such margins, and
+ * checkbuttons and radiobuttons with this set
+ * will have a rectangle drawn in the
+ * indicator around the item if the item is
+ * checked. This is useful for palette menus.
+ * This field is ignored for separators and
+ * tearoffs. */
+ int indicatorSpace; /* The width of the indicator space for this
+ * entry. */
+ int labelWidth; /* Number of pixels to allow for displaying
+ * labels in menu entries. */
+ int compound; /* Value of -compound option; specifies
+ * whether the entry should show both an image
+ * and text, and, if so, how. */
+
+ /*
+ * Information used to implement this entry's action:
+ */
+
+ Tcl_Obj *commandPtr; /* Command to invoke when entry is invoked.
+ * Malloc'ed. */
+ Tcl_Obj *namePtr; /* Name of variable (for check buttons and
+ * radio buttons) or menu (for cascade
+ * entries). Malloc'ed. */
+ Tcl_Obj *onValuePtr; /* Value to store in variable when selected
+ * (only for radio and check buttons).
+ * Malloc'ed. */
+ Tcl_Obj *offValuePtr; /* Value to store in variable when not
+ * selected (only for check buttons).
+ * Malloc'ed. */
+
+ /*
+ * Information used for drawing this menu entry.
+ */
+
+ int width; /* Number of pixels occupied by entry in
+ * horizontal dimension. Not used except in
+ * menubars. The width of norma menus is
+ * dependent on the rest of the menu. */
+ int x; /* X-coordinate of leftmost pixel in entry. */
+ int height; /* Number of pixels occupied by entry in
+ * vertical dimension, including raised border
+ * drawn around entry when active. */
+ int y; /* Y-coordinate of topmost pixel in entry. */
+ GC textGC; /* GC for drawing text in entry. NULL means
+ * use overall textGC for menu. */
+ GC activeGC; /* GC for drawing text in entry when active.
+ * NULL means use overall activeGC for
+ * menu. */
+ GC disabledGC; /* Used to produce disabled effect for entry.
+ * NULL means use overall disabledGC from menu
+ * structure. See comments for disabledFg in
+ * menu structure for more information. */
+ GC indicatorGC; /* For drawing indicators. None means use GC
+ * from menu. */
+
+ /*
+ * Miscellaneous fields.
+ */
+
+ int entryFlags; /* Various flags. See below for
+ * definitions. */
+ int index; /* Need to know which index we are. This is
+ * zero-based. This is the top-left entry of
+ * the menu. */
+
+ /*
+ * Bookeeping for master menus and cascade menus.
+ */
+
+ struct TkMenuReferences *childMenuRefPtr;
+ /* A pointer to the hash table entry for the
+ * child menu. Stored here when the menu entry
+ * is configured so that a hash lookup is not
+ * necessary later.*/
+ struct TkMenuEntry *nextCascadePtr;
+ /* The next cascade entry that is a parent of
+ * this entry's child cascade menu. NULL end
+ * of list, this is not a cascade entry, or
+ * the menu that this entry point to does not
+ * yet exist. */
+ TkMenuPlatformEntryData platformEntryData;
+ /* The data for the specific type of menu.
+ * Depends on platform and menu type what kind
+ * of options are in this structure. */
+} TkMenuEntry;
+
+/*
+ * Flag values defined for menu entries:
+ *
+ * ENTRY_SELECTED: Non-zero means this is a radio or check button
+ * and that it should be drawn in the "selected"
+ * state.
+ * ENTRY_NEEDS_REDISPLAY: Non-zero means the entry should be redisplayed.
+ * ENTRY_LAST_COLUMN: Used by the drawing code. If the entry is in
+ * the last column, the space to its right needs
+ * to be filled.
+ * ENTRY_PLATFORM_FLAG1 - 4 These flags are reserved for use by the
+ * platform-dependent implementation of menus
+ * and should not be used by anything else.
+ */
+
+#define ENTRY_SELECTED 1
+#define ENTRY_NEEDS_REDISPLAY 2
+#define ENTRY_LAST_COLUMN 4
+#define ENTRY_PLATFORM_FLAG1 (1 << 30)
+#define ENTRY_PLATFORM_FLAG2 (1 << 29)
+#define ENTRY_PLATFORM_FLAG3 (1 << 28)
+#define ENTRY_PLATFORM_FLAG4 (1 << 27)
+
+/*
+ * Types defined for MenuEntries:
+ */
+
+#define CASCADE_ENTRY 0
+#define CHECK_BUTTON_ENTRY 1
+#define COMMAND_ENTRY 2
+#define RADIO_BUTTON_ENTRY 3
+#define SEPARATOR_ENTRY 4
+#define TEAROFF_ENTRY 5
+
+/*
+ * Menu states
+ */
+
+#define ENTRY_ACTIVE 0
+#define ENTRY_NORMAL 1
+#define ENTRY_DISABLED 2
+
+/*
+ * A data structure of the following type is kept for each menu widget:
+ */
+
+typedef struct TkMenu {
+ Tk_Window tkwin; /* Window that embodies the pane. NULL means
+ * that the window has been destroyed but the
+ * data structures haven't yet been cleaned
+ * up. */
+ Display *display; /* Display containing widget. Needed, among
+ * other things, so that resources can be
+ * freed up even after tkwin has gone away. */
+ Tcl_Interp *interp; /* Interpreter associated with menu. */
+ Tcl_Command widgetCmd; /* Token for menu's widget command. */
+ TkMenuEntry **entries; /* Array of pointers to all the entries in the
+ * menu. NULL means no entries. */
+ int numEntries; /* Number of elements in entries. */
+ int active; /* Index of active entry. -1 means nothing
+ * active. */
+ int menuType; /* MASTER_MENU, TEAROFF_MENU, or MENUBAR. See
+ * below for definitions. */
+ Tcl_Obj *menuTypePtr; /* Used to control whether created tkwin is a
+ * toplevel or not. "normal", "menubar", or
+ * "toplevel" */
+
+ /*
+ * Information used when displaying widget:
+ */
+
+ Tcl_Obj *borderPtr; /* Structure used to draw 3-D border and
+ * background for menu. */
+ Tcl_Obj *borderWidthPtr; /* Width of border around whole menu. */
+ Tcl_Obj *activeBorderPtr; /* Used to draw background and border for
+ * active element (if any). */
+ Tcl_Obj *activeBorderWidthPtr;
+ /* Width of border around active element. */
+ Tcl_Obj *reliefPtr; /* 3-d effect: TK_RELIEF_RAISED, etc. */
+ Tcl_Obj *fontPtr; /* Text font for menu entries. */
+ Tcl_Obj *fgPtr; /* Foreground color for entries. */
+ Tcl_Obj *disabledFgPtr; /* Foreground color when disabled. NULL means
+ * use normalFg with a 50% stipple instead. */
+ Tcl_Obj *activeFgPtr; /* Foreground color for active entry. */
+ Tcl_Obj *indicatorFgPtr; /* Color for indicators in radio and check
+ * button entries. */
+ Pixmap gray; /* Bitmap for drawing disabled entries in a
+ * stippled fashion. None means not allocated
+ * yet. */
+ GC textGC; /* GC for drawing text and other features of
+ * menu entries. */
+ GC disabledGC; /* Used to produce disabled effect. If
+ * disabledFg isn't NULL, this GC is used to
+ * draw text and icons for disabled entries.
+ * Otherwise text and icons are drawn with
+ * normalGC and this GC is used to stipple
+ * background across them. */
+ GC activeGC; /* GC for drawing active entry. */
+ GC indicatorGC; /* For drawing indicators. */
+ GC disabledImageGC; /* Used for drawing disabled images. They have
+ * to be stippled. This is created when the
+ * image is about to be drawn the first
+ * time. */
+
+ /*
+ * Information about geometry of menu.
+ */
+
+ int totalWidth; /* Width of entire menu. */
+ int totalHeight; /* Height of entire menu. */
+
+ /*
+ * Miscellaneous information:
+ */
+
+ int tearoff; /* 1 means this menu can be torn off. On some
+ * platforms, the user can drag an outline of
+ * the menu by just dragging outside of the
+ * menu, and the tearoff is created where the
+ * mouse is released. On others, an indicator
+ * (such as a dashed stripe) is drawn, and
+ * when the menu is selected, the tearoff is
+ * created. */
+ Tcl_Obj *titlePtr; /* The title to use when this menu is torn
+ * off. If this is NULL, a default scheme will
+ * be used to generate a title for tearoff. */
+ Tcl_Obj *tearoffCommandPtr; /* If non-NULL, points to a command to run
+ * whenever the menu is torn-off. */
+ Tcl_Obj *takeFocusPtr; /* Value of -takefocus option; not used in the
+ * C code, but used by keyboard traversal
+ * scripts. Malloc'ed, but may be NULL. */
+ Tcl_Obj *cursorPtr; /* Current cursor for window, or None. */
+ Tcl_Obj *postCommandPtr; /* Used to detect cycles in cascade hierarchy
+ * trees when preprocessing postcommands on
+ * some platforms. See PostMenu for more
+ * details. */
+ int postCommandGeneration; /* Need to do pre-invocation post command
+ * traversal. */
+ int menuFlags; /* Flags for use by X; see below for
+ * definition. */
+ TkMenuEntry *postedCascade; /* Points to menu entry for cascaded submenu
+ * that is currently posted or NULL if no
+ * submenu posted. */
+ struct TkMenu *nextInstancePtr;
+ /* The next instance of this menu in the
+ * chain. */
+ struct TkMenu *masterMenuPtr;
+ /* A pointer to the original menu for this
+ * clone chain. Points back to this structure
+ * if this menu is a master menu. */
+ void *reserved1; /* not used any more. */
+ Tk_Window parentTopLevelPtr;/* If this menu is a menubar, this is the
+ * toplevel that owns the menu. Only
+ * applicable for menubar clones. */
+ struct TkMenuReferences *menuRefPtr;
+ /* Each menu is hashed into a table with the
+ * name of the menu's window as the key. The
+ * information in this hash table includes a
+ * pointer to the menu (so that cascades can
+ * find this menu), a pointer to the list of
+ * toplevel widgets that have this menu as its
+ * menubar, and a list of menu entries that
+ * have this menu specified as a cascade. */
+ TkMenuPlatformData platformData;
+ /* The data for the specific type of menu.
+ * Depends on platform and menu type what kind
+ * of options are in this structure. */
+ Tk_OptionSpec *extensionPtr;/* Needed by the configuration package for
+ * this widget to be extended. */
+ Tk_SavedOptions *errorStructPtr;
+ /* We actually have to allocate these because
+ * multiple menus get changed during one
+ * ConfigureMenu call. */
+} TkMenu;
+
+/*
+ * When the toplevel configure -menu command is executed, the menu may not
+ * exist yet. We need to keep a linked list of windows that reference a
+ * particular menu.
+ */
+
+typedef struct TkMenuTopLevelList {
+ struct TkMenuTopLevelList *nextPtr;
+ /* The next window in the list. */
+ Tk_Window tkwin; /* The window that has this menu as its
+ * menubar. */
+} TkMenuTopLevelList;
+
+/*
+ * The following structure is used to keep track of things which reference a
+ * menu. It is created when:
+ * - a menu is created.
+ * - a cascade entry is added to a menu with a non-null name
+ * - the "-menu" configuration option is used on a toplevel widget with a
+ * non-null parameter.
+ *
+ * One of these three fields must be non-NULL, but any of the fields may be
+ * NULL. This structure makes it easy to determine whether or not anything
+ * like recalculating platform data or geometry is necessary when one of the
+ * three actions above is performed.
+ */
+
+typedef struct TkMenuReferences {
+ struct TkMenu *menuPtr; /* The menu data structure. This is NULL if
+ * the menu does not exist. */
+ TkMenuTopLevelList *topLevelListPtr;
+ /* First in the list of all toplevels that
+ * have this menu as its menubar. NULL if no
+ * toplevel widgets have this menu as its
+ * menubar. */
+ TkMenuEntry *parentEntryPtr;/* First in the list of all cascade menu
+ * entries that have this menu as their child.
+ * NULL means no cascade entries. */
+ Tcl_HashEntry *hashEntryPtr;/* This is needed because the pathname of the
+ * window (which is what we hash on) may not
+ * be around when we are deleting. */
+} TkMenuReferences;
+
+/*
+ * Flag bits for menus:
+ *
+ * REDRAW_PENDING: Non-zero means a DoWhenIdle handler has
+ * already been queued to redraw this window.
+ * RESIZE_PENDING: Non-zero means a call to ComputeMenuGeometry
+ * has already been scheduled.
+ * MENU_DELETION_PENDING Non-zero means that we are currently
+ * destroying this menu's internal structures.
+ * This is useful when we are in the middle of
+ * cleaning this master menu's chain of menus up
+ * when TkDestroyMenu was called again on this
+ * menu (via a destroy binding or somesuch).
+ * MENU_WIN_DESTRUCTION_PENDING Non-zero means we are in the middle of
+ * destroying this menu's Tk_Window.
+ * MENU_PLATFORM_FLAG1... Reserved for use by the platform-specific menu
+ * code.
+ */
+
+#define REDRAW_PENDING 1
+#define RESIZE_PENDING 2
+#define MENU_DELETION_PENDING 4
+#define MENU_WIN_DESTRUCTION_PENDING 8
+#define MENU_PLATFORM_FLAG1 (1 << 30)
+#define MENU_PLATFORM_FLAG2 (1 << 29)
+#define MENU_PLATFORM_FLAG3 (1 << 28)
+
+/*
+ * Each menu created by the user is a MASTER_MENU. When a menu is torn off, a
+ * TEAROFF_MENU instance is created. When a menu is assigned to a toplevel as
+ * a menu bar, a MENUBAR instance is created. All instances have the same
+ * configuration information. If the master instance is deleted, all instances
+ * are deleted. If one of the other instances is deleted, only that instance
+ * is deleted.
+ */
+
+#define UNKNOWN_TYPE -1
+#define MASTER_MENU 0
+#define TEAROFF_MENU 1
+#define MENUBAR 2
+
+/*
+ * Various geometry definitions:
+ */
+
+#define CASCADE_ARROW_HEIGHT 10
+#define CASCADE_ARROW_WIDTH 8
+#define DECORATION_BORDER_WIDTH 2
+
+/*
+ * Menu-related functions that are shared among Tk modules but not exported to
+ * the outside world:
+ */
+
+MODULE_SCOPE int TkActivateMenuEntry(TkMenu *menuPtr, int index);
+MODULE_SCOPE void TkBindMenu(Tk_Window tkwin, TkMenu *menuPtr);
+MODULE_SCOPE TkMenuReferences*TkCreateMenuReferences(Tcl_Interp *interp,
+ const char *name);
+MODULE_SCOPE void TkDestroyMenu(TkMenu *menuPtr);
+MODULE_SCOPE void TkEventuallyRecomputeMenu(TkMenu *menuPtr);
+MODULE_SCOPE void TkEventuallyRedrawMenu(TkMenu *menuPtr,
+ TkMenuEntry *mePtr);
+MODULE_SCOPE TkMenuReferences*TkFindMenuReferences(Tcl_Interp *interp, const char *name);
+MODULE_SCOPE TkMenuReferences*TkFindMenuReferencesObj(Tcl_Interp *interp,
+ Tcl_Obj *namePtr);
+MODULE_SCOPE int TkFreeMenuReferences(TkMenuReferences *menuRefPtr);
+MODULE_SCOPE Tcl_HashTable *TkGetMenuHashTable(Tcl_Interp *interp);
+MODULE_SCOPE int TkGetMenuIndex(Tcl_Interp *interp, TkMenu *menuPtr,
+ Tcl_Obj *objPtr, int lastOK, int *indexPtr);
+MODULE_SCOPE void TkMenuInitializeDrawingFields(TkMenu *menuPtr);
+MODULE_SCOPE void TkMenuInitializeEntryDrawingFields(TkMenuEntry *mePtr);
+MODULE_SCOPE int TkInvokeMenu(Tcl_Interp *interp, TkMenu *menuPtr,
+ int index);
+MODULE_SCOPE void TkMenuConfigureDrawOptions(TkMenu *menuPtr);
+MODULE_SCOPE int TkMenuConfigureEntryDrawOptions(
+ TkMenuEntry *mePtr, int index);
+MODULE_SCOPE void TkMenuFreeDrawOptions(TkMenu *menuPtr);
+MODULE_SCOPE void TkMenuEntryFreeDrawOptions(TkMenuEntry *mePtr);
+MODULE_SCOPE void TkMenuEventProc(ClientData clientData,
+ XEvent *eventPtr);
+MODULE_SCOPE void TkMenuImageProc(ClientData clientData, int x, int y,
+ int width, int height, int imgWidth,
+ int imgHeight);
+MODULE_SCOPE void TkMenuInit(void);
+MODULE_SCOPE void TkMenuSelectImageProc(ClientData clientData, int x,
+ int y, int width, int height, int imgWidth,
+ int imgHeight);
+MODULE_SCOPE Tcl_Obj * TkNewMenuName(Tcl_Interp *interp,
+ Tcl_Obj *parentNamePtr, TkMenu *menuPtr);
+MODULE_SCOPE int TkPostCommand(TkMenu *menuPtr);
+MODULE_SCOPE int TkPostSubmenu(Tcl_Interp *interp, TkMenu *menuPtr,
+ TkMenuEntry *mePtr);
+MODULE_SCOPE int TkPostTearoffMenu(Tcl_Interp *interp, TkMenu *menuPtr,
+ int x, int y);
+MODULE_SCOPE int TkPreprocessMenu(TkMenu *menuPtr);
+MODULE_SCOPE void TkRecomputeMenu(TkMenu *menuPtr);
+
+/*
+ * These routines are the platform-dependent routines called by the common
+ * code.
+ */
+
+MODULE_SCOPE void TkpComputeMenubarGeometry(TkMenu *menuPtr);
+MODULE_SCOPE void TkpComputeStandardMenuGeometry(TkMenu *menuPtr);
+MODULE_SCOPE int TkpConfigureMenuEntry(TkMenuEntry *mePtr);
+MODULE_SCOPE void TkpDestroyMenu(TkMenu *menuPtr);
+MODULE_SCOPE void TkpDestroyMenuEntry(TkMenuEntry *mEntryPtr);
+MODULE_SCOPE void TkpDrawMenuEntry(TkMenuEntry *mePtr,
+ Drawable d, Tk_Font tkfont,
+ const Tk_FontMetrics *menuMetricsPtr, int x,
+ int y, int width, int height, int strictMotif,
+ int drawingParameters);
+MODULE_SCOPE void TkpMenuInit(void);
+MODULE_SCOPE int TkpMenuNewEntry(TkMenuEntry *mePtr);
+MODULE_SCOPE int TkpNewMenu(TkMenu *menuPtr);
+MODULE_SCOPE int TkpPostMenu(Tcl_Interp *interp, TkMenu *menuPtr,
+ int x, int y);
+MODULE_SCOPE void TkpSetWindowMenuBar(Tk_Window tkwin, TkMenu *menuPtr);
+
+#endif /* _TKMENU */
diff --git a/tk8.6/generic/tkMenuDraw.c b/tk8.6/generic/tkMenuDraw.c
new file mode 100644
index 0000000..1abe1c4
--- /dev/null
+++ b/tk8.6/generic/tkMenuDraw.c
@@ -0,0 +1,1051 @@
+/*
+ * tkMenuDraw.c --
+ *
+ * This module implements the platform-independent drawing and geometry
+ * calculations of menu widgets.
+ *
+ * Copyright (c) 1996-1997 by Sun Microsystems, Inc.
+ *
+ * See the file "license.terms" for information on usage and redistribution of
+ * this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ */
+
+#include "tkInt.h"
+#include "tkMenu.h"
+
+/*
+ * Forward declarations for functions defined later in this file:
+ */
+
+static void AdjustMenuCoords(TkMenu *menuPtr, TkMenuEntry *mePtr,
+ int *xPtr, int *yPtr);
+static void ComputeMenuGeometry(ClientData clientData);
+static void DisplayMenu(ClientData clientData);
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkMenuInitializeDrawingFields --
+ *
+ * Fills in drawing fields of a new menu. Called when new menu is created
+ * by MenuCmd.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * menuPtr fields are initialized.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TkMenuInitializeDrawingFields(
+ TkMenu *menuPtr) /* The menu we are initializing. */
+{
+ menuPtr->textGC = None;
+ menuPtr->gray = None;
+ menuPtr->disabledGC = None;
+ menuPtr->activeGC = None;
+ menuPtr->indicatorGC = None;
+ menuPtr->disabledImageGC = None;
+ menuPtr->totalWidth = menuPtr->totalHeight = 0;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkMenuInitializeEntryDrawingFields --
+ *
+ * Fills in drawing fields of a new menu entry. Called when an entry is
+ * created.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TkMenuInitializeEntryDrawingFields(
+ TkMenuEntry *mePtr) /* The menu we are initializing. */
+{
+ mePtr->width = 0;
+ mePtr->height = 0;
+ mePtr->x = 0;
+ mePtr->y = 0;
+ mePtr->indicatorSpace = 0;
+ mePtr->labelWidth = 0;
+ mePtr->textGC = None;
+ mePtr->activeGC = None;
+ mePtr->disabledGC = None;
+ mePtr->indicatorGC = None;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkMenuFreeDrawOptions --
+ *
+ * Frees up any structures allocated for the drawing of a menu. Called
+ * when menu is deleted.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Storage is released.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TkMenuFreeDrawOptions(
+ TkMenu *menuPtr)
+{
+ if (menuPtr->textGC != None) {
+ Tk_FreeGC(menuPtr->display, menuPtr->textGC);
+ }
+ if (menuPtr->disabledImageGC != None) {
+ Tk_FreeGC(menuPtr->display, menuPtr->disabledImageGC);
+ }
+ if (menuPtr->gray != None) {
+ Tk_FreeBitmap(menuPtr->display, menuPtr->gray);
+ }
+ if (menuPtr->disabledGC != None) {
+ Tk_FreeGC(menuPtr->display, menuPtr->disabledGC);
+ }
+ if (menuPtr->activeGC != None) {
+ Tk_FreeGC(menuPtr->display, menuPtr->activeGC);
+ }
+ if (menuPtr->indicatorGC != None) {
+ Tk_FreeGC(menuPtr->display, menuPtr->indicatorGC);
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkMenuEntryFreeDrawOptions --
+ *
+ * Frees up drawing structures for a menu entry. Called when menu entry
+ * is freed.
+ *
+ * RESULTS:
+ * None.
+ *
+ * Side effects:
+ * Storage is freed.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TkMenuEntryFreeDrawOptions(
+ TkMenuEntry *mePtr)
+{
+ if (mePtr->textGC != None) {
+ Tk_FreeGC(mePtr->menuPtr->display, mePtr->textGC);
+ }
+ if (mePtr->disabledGC != None) {
+ Tk_FreeGC(mePtr->menuPtr->display, mePtr->disabledGC);
+ }
+ if (mePtr->activeGC != None) {
+ Tk_FreeGC(mePtr->menuPtr->display, mePtr->activeGC);
+ }
+ if (mePtr->indicatorGC != None) {
+ Tk_FreeGC(mePtr->menuPtr->display, mePtr->indicatorGC);
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkMenuConfigureDrawOptions --
+ *
+ * Sets the menu's drawing attributes in preparation for drawing the
+ * menu.
+ *
+ * RESULTS:
+ * None.
+ *
+ * Side effects:
+ * Storage is allocated.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TkMenuConfigureDrawOptions(
+ TkMenu *menuPtr) /* The menu we are configuring. */
+{
+ XGCValues gcValues;
+ GC newGC;
+ unsigned long mask;
+ Tk_3DBorder border, activeBorder;
+ Tk_Font tkfont;
+ XColor *fg, *activeFg, *indicatorFg;
+
+ /*
+ * A few options need special processing, such as setting the background
+ * from a 3-D border, or filling in complicated defaults that couldn't be
+ * specified to Tk_ConfigureWidget.
+ */
+
+ border = Tk_Get3DBorderFromObj(menuPtr->tkwin, menuPtr->borderPtr);
+ Tk_SetBackgroundFromBorder(menuPtr->tkwin, border);
+
+ tkfont = Tk_GetFontFromObj(menuPtr->tkwin, menuPtr->fontPtr);
+ gcValues.font = Tk_FontId(tkfont);
+ fg = Tk_GetColorFromObj(menuPtr->tkwin, menuPtr->fgPtr);
+ gcValues.foreground = fg->pixel;
+ gcValues.background = Tk_3DBorderColor(border)->pixel;
+ newGC = Tk_GetGC(menuPtr->tkwin, GCForeground|GCBackground|GCFont,
+ &gcValues);
+ if (menuPtr->textGC != None) {
+ Tk_FreeGC(menuPtr->display, menuPtr->textGC);
+ }
+ menuPtr->textGC = newGC;
+
+ gcValues.font = Tk_FontId(tkfont);
+ gcValues.background = Tk_3DBorderColor(border)->pixel;
+ if (menuPtr->disabledFgPtr != NULL) {
+ XColor *disabledFg;
+
+ disabledFg = Tk_GetColorFromObj(menuPtr->tkwin,
+ menuPtr->disabledFgPtr);
+ gcValues.foreground = disabledFg->pixel;
+ mask = GCForeground|GCBackground|GCFont;
+ } else {
+ gcValues.foreground = gcValues.background;
+ mask = GCForeground;
+ if (menuPtr->gray == None) {
+ menuPtr->gray = Tk_GetBitmap(menuPtr->interp, menuPtr->tkwin,
+ "gray50");
+ }
+ if (menuPtr->gray != None) {
+ gcValues.fill_style = FillStippled;
+ gcValues.stipple = menuPtr->gray;
+ mask = GCForeground|GCFillStyle|GCStipple;
+ }
+ }
+ newGC = Tk_GetGC(menuPtr->tkwin, mask, &gcValues);
+ if (menuPtr->disabledGC != None) {
+ Tk_FreeGC(menuPtr->display, menuPtr->disabledGC);
+ }
+ menuPtr->disabledGC = newGC;
+
+ gcValues.foreground = Tk_3DBorderColor(border)->pixel;
+ if (menuPtr->gray == None) {
+ menuPtr->gray = Tk_GetBitmap(menuPtr->interp, menuPtr->tkwin,
+ "gray50");
+ }
+ if (menuPtr->gray != None) {
+ gcValues.fill_style = FillStippled;
+ gcValues.stipple = menuPtr->gray;
+ newGC = Tk_GetGC(menuPtr->tkwin,
+ GCForeground|GCFillStyle|GCStipple, &gcValues);
+ }
+ if (menuPtr->disabledImageGC != None) {
+ Tk_FreeGC(menuPtr->display, menuPtr->disabledImageGC);
+ }
+ menuPtr->disabledImageGC = newGC;
+
+ gcValues.font = Tk_FontId(tkfont);
+ activeFg = Tk_GetColorFromObj(menuPtr->tkwin, menuPtr->activeFgPtr);
+ gcValues.foreground = activeFg->pixel;
+ activeBorder = Tk_Get3DBorderFromObj(menuPtr->tkwin,
+ menuPtr->activeBorderPtr);
+ gcValues.background = Tk_3DBorderColor(activeBorder)->pixel;
+ newGC = Tk_GetGC(menuPtr->tkwin, GCForeground|GCBackground|GCFont,
+ &gcValues);
+ if (menuPtr->activeGC != None) {
+ Tk_FreeGC(menuPtr->display, menuPtr->activeGC);
+ }
+ menuPtr->activeGC = newGC;
+
+ indicatorFg = Tk_GetColorFromObj(menuPtr->tkwin,
+ menuPtr->indicatorFgPtr);
+ gcValues.foreground = indicatorFg->pixel;
+ gcValues.background = Tk_3DBorderColor(border)->pixel;
+ newGC = Tk_GetGC(menuPtr->tkwin, GCForeground|GCBackground|GCFont,
+ &gcValues);
+ if (menuPtr->indicatorGC != None) {
+ Tk_FreeGC(menuPtr->display, menuPtr->indicatorGC);
+ }
+ menuPtr->indicatorGC = newGC;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkMenuConfigureEntryDrawOptions --
+ *
+ * Calculates any entry-specific draw options for the given menu entry.
+ *
+ * Results:
+ * Returns a standard Tcl error.
+ *
+ * Side effects:
+ * Storage may be allocated.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TkMenuConfigureEntryDrawOptions(
+ TkMenuEntry *mePtr,
+ int index)
+{
+ XGCValues gcValues;
+ GC newGC, newActiveGC, newDisabledGC, newIndicatorGC;
+ unsigned long mask;
+ Tk_Font tkfont;
+ TkMenu *menuPtr = mePtr->menuPtr;
+
+ tkfont = Tk_GetFontFromObj(menuPtr->tkwin,
+ (mePtr->fontPtr != NULL) ? mePtr->fontPtr : menuPtr->fontPtr);
+
+ if (mePtr->state == ENTRY_ACTIVE) {
+ if (index != menuPtr->active) {
+ TkActivateMenuEntry(menuPtr, index);
+ }
+ } else {
+ if (index == menuPtr->active) {
+ TkActivateMenuEntry(menuPtr, -1);
+ }
+ }
+
+ if ((mePtr->fontPtr != NULL)
+ || (mePtr->borderPtr != NULL)
+ || (mePtr->fgPtr != NULL)
+ || (mePtr->activeBorderPtr != NULL)
+ || (mePtr->activeFgPtr != NULL)
+ || (mePtr->indicatorFgPtr != NULL)) {
+ XColor *fg, *indicatorFg, *activeFg;
+ Tk_3DBorder border, activeBorder;
+
+ fg = Tk_GetColorFromObj(menuPtr->tkwin, (mePtr->fgPtr != NULL)
+ ? mePtr->fgPtr : menuPtr->fgPtr);
+ gcValues.foreground = fg->pixel;
+ border = Tk_Get3DBorderFromObj(menuPtr->tkwin,
+ (mePtr->borderPtr != NULL) ? mePtr->borderPtr
+ : menuPtr->borderPtr);
+ gcValues.background = Tk_3DBorderColor(border)->pixel;
+
+ gcValues.font = Tk_FontId(tkfont);
+
+ /*
+ * Note: disable GraphicsExpose events; we know there won't be
+ * obscured areas when copying from an off-screen pixmap to the screen
+ * and this gets rid of unnecessary events.
+ */
+
+ gcValues.graphics_exposures = False;
+ newGC = Tk_GetGC(menuPtr->tkwin,
+ GCForeground|GCBackground|GCFont|GCGraphicsExposures,
+ &gcValues);
+
+ indicatorFg = Tk_GetColorFromObj(menuPtr->tkwin,
+ (mePtr->indicatorFgPtr != NULL) ? mePtr->indicatorFgPtr
+ : menuPtr->indicatorFgPtr);
+ gcValues.foreground = indicatorFg->pixel;
+ newIndicatorGC = Tk_GetGC(menuPtr->tkwin,
+ GCForeground|GCBackground|GCGraphicsExposures,
+ &gcValues);
+
+ if ((menuPtr->disabledFgPtr != NULL) || (mePtr->image != NULL)) {
+ XColor *disabledFg;
+
+ disabledFg = Tk_GetColorFromObj(menuPtr->tkwin,
+ menuPtr->disabledFgPtr);
+ gcValues.foreground = disabledFg->pixel;
+ mask = GCForeground|GCBackground|GCFont|GCGraphicsExposures;
+ } else {
+ gcValues.foreground = gcValues.background;
+ gcValues.fill_style = FillStippled;
+ gcValues.stipple = menuPtr->gray;
+ mask = GCForeground|GCFillStyle|GCStipple;
+ }
+ newDisabledGC = Tk_GetGC(menuPtr->tkwin, mask, &gcValues);
+
+ activeFg = Tk_GetColorFromObj(menuPtr->tkwin,
+ (mePtr->activeFgPtr != NULL) ? mePtr->activeFgPtr
+ : menuPtr->activeFgPtr);
+ activeBorder = Tk_Get3DBorderFromObj(menuPtr->tkwin,
+ (mePtr->activeBorderPtr != NULL) ? mePtr->activeBorderPtr
+ : menuPtr->activeBorderPtr);
+
+ gcValues.foreground = activeFg->pixel;
+ gcValues.background = Tk_3DBorderColor(activeBorder)->pixel;
+ newActiveGC = Tk_GetGC(menuPtr->tkwin,
+ GCForeground|GCBackground|GCFont|GCGraphicsExposures,
+ &gcValues);
+ } else {
+ newGC = None;
+ newActiveGC = None;
+ newDisabledGC = None;
+ newIndicatorGC = None;
+ }
+ if (mePtr->textGC != None) {
+ Tk_FreeGC(menuPtr->display, mePtr->textGC);
+ }
+ mePtr->textGC = newGC;
+ if (mePtr->activeGC != None) {
+ Tk_FreeGC(menuPtr->display, mePtr->activeGC);
+ }
+ mePtr->activeGC = newActiveGC;
+ if (mePtr->disabledGC != None) {
+ Tk_FreeGC(menuPtr->display, mePtr->disabledGC);
+ }
+ mePtr->disabledGC = newDisabledGC;
+ if (mePtr->indicatorGC != None) {
+ Tk_FreeGC(menuPtr->display, mePtr->indicatorGC);
+ }
+ mePtr->indicatorGC = newIndicatorGC;
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkEventuallyRecomputeMenu --
+ *
+ * Tells Tcl to redo the geometry because this menu has changed.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Menu geometry is recomputed at idle time, and the menu will be
+ * redisplayed.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TkEventuallyRecomputeMenu(
+ TkMenu *menuPtr)
+{
+ if (!(menuPtr->menuFlags & RESIZE_PENDING)) {
+ menuPtr->menuFlags |= RESIZE_PENDING;
+ Tcl_DoWhenIdle(ComputeMenuGeometry, menuPtr);
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkRecomputeMenu --
+ *
+ * Tells Tcl to redo the geometry because this menu has changed. Does it
+ * now; removes any ComputeMenuGeometries from the idler.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Menu geometry is immediately reconfigured.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TkRecomputeMenu(
+ TkMenu *menuPtr)
+{
+ if (menuPtr->menuFlags & RESIZE_PENDING) {
+ Tcl_CancelIdleCall(ComputeMenuGeometry, menuPtr);
+ ComputeMenuGeometry(menuPtr);
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkEventuallyRedrawMenu --
+ *
+ * Arrange for an entry of a menu, or the whole menu, to be redisplayed
+ * at some point in the future.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * A when-idle hander is scheduled to do the redisplay, if there isn't
+ * one already scheduled.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TkEventuallyRedrawMenu(
+ register TkMenu *menuPtr, /* Information about menu to redraw. */
+ register TkMenuEntry *mePtr)/* Entry to redraw. NULL means redraw all the
+ * entries in the menu. */
+{
+ int i;
+
+ if (menuPtr->tkwin == NULL) {
+ return;
+ }
+ if (mePtr != NULL) {
+ mePtr->entryFlags |= ENTRY_NEEDS_REDISPLAY;
+ } else {
+ for (i = 0; i < menuPtr->numEntries; i++) {
+ menuPtr->entries[i]->entryFlags |= ENTRY_NEEDS_REDISPLAY;
+ }
+ }
+ if (!Tk_IsMapped(menuPtr->tkwin)
+ || (menuPtr->menuFlags & REDRAW_PENDING)) {
+ return;
+ }
+ Tcl_DoWhenIdle(DisplayMenu, menuPtr);
+ menuPtr->menuFlags |= REDRAW_PENDING;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * ComputeMenuGeometry --
+ *
+ * This function is invoked to recompute the size and layout of a menu.
+ * It is called as a when-idle handler so that it only gets done once,
+ * even if a group of changes is made to the menu.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Fields of menu entries are changed to reflect their current positions,
+ * and the size of the menu window itself may be changed.
+ *
+ *--------------------------------------------------------------
+ */
+
+static void
+ComputeMenuGeometry(
+ ClientData clientData) /* Structure describing menu. */
+{
+ TkMenu *menuPtr = clientData;
+
+ if (menuPtr->tkwin == NULL) {
+ return;
+ }
+
+ if (menuPtr->menuType == MENUBAR) {
+ TkpComputeMenubarGeometry(menuPtr);
+ } else {
+ TkpComputeStandardMenuGeometry(menuPtr);
+ }
+
+ if ((menuPtr->totalWidth != Tk_ReqWidth(menuPtr->tkwin)) ||
+ (menuPtr->totalHeight != Tk_ReqHeight(menuPtr->tkwin))) {
+ Tk_GeometryRequest(menuPtr->tkwin, menuPtr->totalWidth,
+ menuPtr->totalHeight);
+ }
+
+ /*
+ * Must always force a redisplay here if the window is mapped (even if the
+ * size didn't change, something else might have changed in the menu, such
+ * as a label or accelerator). The resize will force a redisplay above.
+ */
+
+ TkEventuallyRedrawMenu(menuPtr, NULL);
+
+ menuPtr->menuFlags &= ~RESIZE_PENDING;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkMenuSelectImageProc --
+ *
+ * This function is invoked by the image code whenever the manager for an
+ * image does something that affects the size of contents of an image
+ * displayed in a menu entry when it is selected.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Arranges for the menu to get redisplayed.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TkMenuSelectImageProc(
+ ClientData clientData, /* Pointer to widget record. */
+ int x, int y, /* Upper left pixel (within image) that must
+ * be redisplayed. */
+ int width, int height, /* Dimensions of area to redisplay (may be
+ * <=0). */
+ int imgWidth, int imgHeight)/* New dimensions of image. */
+{
+ register TkMenuEntry *mePtr = clientData;
+
+ if ((mePtr->entryFlags & ENTRY_SELECTED)
+ && !(mePtr->menuPtr->menuFlags & REDRAW_PENDING)) {
+ mePtr->menuPtr->menuFlags |= REDRAW_PENDING;
+ Tcl_DoWhenIdle(DisplayMenu, mePtr->menuPtr);
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * DisplayMenu --
+ *
+ * This function is invoked to display a menu widget.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Commands are output to X to display the menu in its current mode.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+DisplayMenu(
+ ClientData clientData) /* Information about widget. */
+{
+ register TkMenu *menuPtr = clientData;
+ register TkMenuEntry *mePtr;
+ register Tk_Window tkwin = menuPtr->tkwin;
+ int index, strictMotif;
+ Tk_Font tkfont;
+ Tk_FontMetrics menuMetrics;
+ int width;
+ int borderWidth;
+ Tk_3DBorder border;
+ int activeBorderWidth;
+ int relief;
+
+
+ menuPtr->menuFlags &= ~REDRAW_PENDING;
+ if ((menuPtr->tkwin == NULL) || !Tk_IsMapped(tkwin)) {
+ return;
+ }
+
+ Tk_GetPixelsFromObj(NULL, menuPtr->tkwin, menuPtr->borderWidthPtr,
+ &borderWidth);
+ border = Tk_Get3DBorderFromObj(menuPtr->tkwin, menuPtr->borderPtr);
+ Tk_GetPixelsFromObj(NULL, menuPtr->tkwin,
+ menuPtr->activeBorderWidthPtr, &activeBorderWidth);
+
+ if (menuPtr->menuType == MENUBAR) {
+ Tk_Fill3DRectangle(tkwin, Tk_WindowId(tkwin), border, borderWidth,
+ borderWidth, Tk_Width(tkwin) - 2 * borderWidth,
+ Tk_Height(tkwin) - 2 * borderWidth, 0, TK_RELIEF_FLAT);
+ }
+
+ strictMotif = Tk_StrictMotif(menuPtr->tkwin);
+
+ /*
+ * See note in ComputeMenuGeometry. We don't want to be doing font metrics
+ * all of the time.
+ */
+
+ tkfont = Tk_GetFontFromObj(menuPtr->tkwin, menuPtr->fontPtr);
+ Tk_GetFontMetrics(tkfont, &menuMetrics);
+
+ /*
+ * Loop through all of the entries, drawing them one at a time.
+ */
+
+ for (index = 0; index < menuPtr->numEntries; index++) {
+ mePtr = menuPtr->entries[index];
+ if (menuPtr->menuType != MENUBAR) {
+ if (!(mePtr->entryFlags & ENTRY_NEEDS_REDISPLAY)) {
+ continue;
+ }
+ }
+ mePtr->entryFlags &= ~ENTRY_NEEDS_REDISPLAY;
+
+ if (menuPtr->menuType == MENUBAR) {
+ width = mePtr->width;
+ } else {
+ if (mePtr->entryFlags & ENTRY_LAST_COLUMN) {
+ width = Tk_Width(menuPtr->tkwin) - mePtr->x
+ - activeBorderWidth;
+ } else {
+ width = mePtr->width + borderWidth;
+ }
+ }
+ TkpDrawMenuEntry(mePtr, Tk_WindowId(menuPtr->tkwin), tkfont,
+ &menuMetrics, mePtr->x, mePtr->y, width,
+ mePtr->height, strictMotif, 1);
+ if ((index > 0) && (menuPtr->menuType != MENUBAR)
+ && mePtr->columnBreak) {
+ mePtr = menuPtr->entries[index - 1];
+ Tk_Fill3DRectangle(tkwin, Tk_WindowId(tkwin), border,
+ mePtr->x, mePtr->y + mePtr->height,
+ mePtr->width,
+ Tk_Height(tkwin) - mePtr->y - mePtr->height -
+ activeBorderWidth, 0,
+ TK_RELIEF_FLAT);
+ }
+ }
+
+ if (menuPtr->menuType != MENUBAR) {
+ int x, y, height;
+
+ if (menuPtr->numEntries == 0) {
+ x = y = borderWidth;
+ width = Tk_Width(tkwin) - 2 * activeBorderWidth;
+ height = Tk_Height(tkwin) - 2 * activeBorderWidth;
+ } else {
+ mePtr = menuPtr->entries[menuPtr->numEntries - 1];
+ Tk_Fill3DRectangle(tkwin, Tk_WindowId(tkwin),
+ border, mePtr->x, mePtr->y + mePtr->height, mePtr->width,
+ Tk_Height(tkwin) - mePtr->y - mePtr->height
+ - activeBorderWidth, 0,
+ TK_RELIEF_FLAT);
+ x = mePtr->x + mePtr->width;
+ y = mePtr->y + mePtr->height;
+ width = Tk_Width(tkwin) - x - activeBorderWidth;
+ height = Tk_Height(tkwin) - y - activeBorderWidth;
+ }
+ Tk_Fill3DRectangle(tkwin, Tk_WindowId(tkwin), border, x, y,
+ width, height, 0, TK_RELIEF_FLAT);
+ }
+
+ Tk_GetReliefFromObj(NULL, menuPtr->reliefPtr, &relief);
+ Tk_Draw3DRectangle(menuPtr->tkwin, Tk_WindowId(tkwin),
+ border, 0, 0, Tk_Width(tkwin), Tk_Height(tkwin), borderWidth,
+ relief);
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * TkMenuEventProc --
+ *
+ * This function is invoked by the Tk dispatcher for various events on
+ * menus.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * When the window gets deleted, internal structures get cleaned up. When
+ * it gets exposed, it is redisplayed.
+ *
+ *--------------------------------------------------------------
+ */
+
+void
+TkMenuEventProc(
+ ClientData clientData, /* Information about window. */
+ XEvent *eventPtr) /* Information about event. */
+{
+ TkMenu *menuPtr = clientData;
+
+ if ((eventPtr->type == Expose) && (eventPtr->xexpose.count == 0)) {
+ TkEventuallyRedrawMenu(menuPtr, NULL);
+ } else if (eventPtr->type == ConfigureNotify) {
+ TkEventuallyRecomputeMenu(menuPtr);
+ TkEventuallyRedrawMenu(menuPtr, NULL);
+ } else if (eventPtr->type == ActivateNotify) {
+ if (menuPtr->menuType == TEAROFF_MENU) {
+ TkpSetMainMenubar(menuPtr->interp, menuPtr->tkwin, NULL);
+ }
+ } else if (eventPtr->type == DestroyNotify) {
+ if (menuPtr->tkwin != NULL) {
+ if (!(menuPtr->menuFlags & MENU_DELETION_PENDING)) {
+ TkDestroyMenu(menuPtr);
+ }
+ menuPtr->tkwin = NULL;
+ }
+ if (menuPtr->menuFlags & MENU_WIN_DESTRUCTION_PENDING) {
+ return;
+ }
+ menuPtr->menuFlags |= MENU_WIN_DESTRUCTION_PENDING;
+ if (menuPtr->widgetCmd != NULL) {
+ Tcl_DeleteCommandFromToken(menuPtr->interp, menuPtr->widgetCmd);
+ menuPtr->widgetCmd = NULL;
+ }
+ if (menuPtr->menuFlags & REDRAW_PENDING) {
+ Tcl_CancelIdleCall(DisplayMenu, menuPtr);
+ menuPtr->menuFlags &= ~REDRAW_PENDING;
+ }
+ if (menuPtr->menuFlags & RESIZE_PENDING) {
+ Tcl_CancelIdleCall(ComputeMenuGeometry, menuPtr);
+ menuPtr->menuFlags &= ~RESIZE_PENDING;
+ }
+ Tcl_EventuallyFree(menuPtr, TCL_DYNAMIC);
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkMenuImageProc --
+ *
+ * This function is invoked by the image code whenever the manager for an
+ * image does something that affects the size of contents of an image
+ * displayed in a menu entry.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Arranges for the menu to get redisplayed.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TkMenuImageProc(
+ ClientData clientData, /* Pointer to widget record. */
+ int x, int y, /* Upper left pixel (within image) that must
+ * be redisplayed. */
+ int width, int height, /* Dimensions of area to redisplay (may be
+ * <=0). */
+ int imgWidth, int imgHeight)/* New dimensions of image. */
+{
+ register TkMenu *menuPtr = ((TkMenuEntry *) clientData)->menuPtr;
+
+ if ((menuPtr->tkwin != NULL) && !(menuPtr->menuFlags & RESIZE_PENDING)) {
+ menuPtr->menuFlags |= RESIZE_PENDING;
+ Tcl_DoWhenIdle(ComputeMenuGeometry, menuPtr);
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkPostTearoffMenu --
+ *
+ * Posts a menu on the screen. Used to post tearoff menus. On Unix, all
+ * menus are posted this way. Adjusts the menu's position so that it fits
+ * on the screen, and maps and raises the menu.
+ *
+ * Results:
+ * Returns a standard Tcl Error.
+ *
+ * Side effects:
+ * The menu is posted.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TkPostTearoffMenu(
+ Tcl_Interp *interp, /* The interpreter of the menu */
+ TkMenu *menuPtr, /* The menu we are posting */
+ int x, int y) /* The root X,Y coordinates where we are
+ * posting */
+{
+ int vRootX, vRootY, vRootWidth, vRootHeight;
+ int result;
+
+ TkActivateMenuEntry(menuPtr, -1);
+ TkRecomputeMenu(menuPtr);
+ result = TkPostCommand(menuPtr);
+ if (result != TCL_OK) {
+ return result;
+ }
+
+ /*
+ * The post commands could have deleted the menu, which means we are dead
+ * and should go away.
+ */
+
+ if (menuPtr->tkwin == NULL) {
+ return TCL_OK;
+ }
+
+ /*
+ * Adjust the position of the menu if necessary to keep it visible on the
+ * screen. There are two special tricks to make this work right:
+ *
+ * 1. If a virtual root window manager is being used then the coordinates
+ * are in the virtual root window of menuPtr's parent; since the menu
+ * uses override-redirect mode it will be in the *real* root window for
+ * the screen, so we have to map the coordinates from the virtual root
+ * (if any) to the real root. Can't get the virtual root from the menu
+ * itself (it will never be seen by the wm) so use its parent instead
+ * (it would be better to have an an option that names a window to use
+ * for this...).
+ * 2. The menu may not have been mapped yet, so its current size might be
+ * the default 1x1. To compute how much space it needs, use its
+ * requested size, not its actual size.
+ */
+
+ Tk_GetVRootGeometry(Tk_Parent(menuPtr->tkwin), &vRootX, &vRootY,
+ &vRootWidth, &vRootHeight);
+ vRootWidth -= Tk_ReqWidth(menuPtr->tkwin);
+ if (x > vRootX + vRootWidth) {
+ x = vRootX + vRootWidth;
+ }
+ if (x < vRootX) {
+ x = vRootX;
+ }
+ vRootHeight -= Tk_ReqHeight(menuPtr->tkwin);
+ if (y > vRootY + vRootHeight) {
+ y = vRootY + vRootHeight;
+ }
+ if (y < vRootY) {
+ y = vRootY;
+ }
+ Tk_MoveToplevelWindow(menuPtr->tkwin, x, y);
+ if (!Tk_IsMapped(menuPtr->tkwin)) {
+ Tk_MapWindow(menuPtr->tkwin);
+ }
+ TkWmRestackToplevel((TkWindow *) menuPtr->tkwin, Above, NULL);
+ return TCL_OK;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * TkPostSubmenu --
+ *
+ * This function arranges for a particular submenu (i.e. the menu
+ * corresponding to a given cascade entry) to be posted.
+ *
+ * Results:
+ * A standard Tcl return result. Errors may occur in the Tcl commands
+ * generated to post and unpost submenus.
+ *
+ * Side effects:
+ * If there is already a submenu posted, it is unposted. The new submenu
+ * is then posted.
+ *
+ *--------------------------------------------------------------
+ */
+
+int
+TkPostSubmenu(
+ Tcl_Interp *interp, /* Used for invoking sub-commands and
+ * reporting errors. */
+ register TkMenu *menuPtr, /* Information about menu as a whole. */
+ register TkMenuEntry *mePtr)/* Info about submenu that is to be posted.
+ * NULL means make sure that no submenu is
+ * posted. */
+{
+ int result, x, y;
+ Tcl_Obj *subary[4];
+
+ if (mePtr == menuPtr->postedCascade) {
+ return TCL_OK;
+ }
+
+ if (menuPtr->postedCascade != NULL) {
+ /*
+ * Note: when unposting a submenu, we have to redraw the entire parent
+ * menu. This is because of a combination of the following things:
+ * (a) the submenu partially overlaps the parent.
+ * (b) the submenu specifies "save under", which causes the X server
+ * to make a copy of the information under it when it is posted.
+ * When the submenu is unposted, the X server copies this data
+ * back and doesn't generate any Expose events for the parent.
+ * (c) the parent may have redisplayed itself after the submenu was
+ * posted, in which case the saved information is no longer
+ * correct.
+ * The simplest solution is just force a complete redisplay of the
+ * parent.
+ */
+
+ subary[0] = menuPtr->postedCascade->namePtr;
+ subary[1] = Tcl_NewStringObj("unpost", -1);
+ Tcl_IncrRefCount(subary[1]);
+ TkEventuallyRedrawMenu(menuPtr, NULL);
+ result = Tcl_EvalObjv(interp, 2, subary, 0);
+ Tcl_DecrRefCount(subary[1]);
+ menuPtr->postedCascade = NULL;
+ if (result != TCL_OK) {
+ return result;
+ }
+ }
+
+ if ((mePtr != NULL) && (mePtr->namePtr != NULL)
+ && Tk_IsMapped(menuPtr->tkwin)) {
+ /*
+ * Position the cascade with its upper left corner slightly below and
+ * to the left of the upper right corner of the menu entry (this is an
+ * attempt to match Motif behavior).
+ *
+ * The menu has to redrawn so that the entry can change relief.
+ *
+ * Set postedCascade early to ensure tear-off submenus work on
+ * Windows. [Bug 873613]
+ */
+
+ Tk_GetRootCoords(menuPtr->tkwin, &x, &y);
+ AdjustMenuCoords(menuPtr, mePtr, &x, &y);
+
+ menuPtr->postedCascade = mePtr;
+ subary[0] = mePtr->namePtr;
+ subary[1] = Tcl_NewStringObj("post", -1);
+ subary[2] = Tcl_NewIntObj(x);
+ subary[3] = Tcl_NewIntObj(y);
+ Tcl_IncrRefCount(subary[1]);
+ Tcl_IncrRefCount(subary[2]);
+ Tcl_IncrRefCount(subary[3]);
+ result = Tcl_EvalObjv(interp, 4, subary, 0);
+ Tcl_DecrRefCount(subary[1]);
+ Tcl_DecrRefCount(subary[2]);
+ Tcl_DecrRefCount(subary[3]);
+ if (result != TCL_OK) {
+ menuPtr->postedCascade = NULL;
+ return result;
+ }
+ TkEventuallyRedrawMenu(menuPtr, mePtr);
+ }
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * AdjustMenuCoords --
+ *
+ * Adjusts the given coordinates down and the left to give a Motif look.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The menu is eventually redrawn if necessary.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+AdjustMenuCoords(
+ TkMenu *menuPtr,
+ TkMenuEntry *mePtr,
+ int *xPtr,
+ int *yPtr)
+{
+ if (menuPtr->menuType == MENUBAR) {
+ *xPtr += mePtr->x;
+ *yPtr += mePtr->y + mePtr->height;
+ } else {
+ int borderWidth, activeBorderWidth;
+
+ Tk_GetPixelsFromObj(NULL, menuPtr->tkwin, menuPtr->borderWidthPtr,
+ &borderWidth);
+ Tk_GetPixelsFromObj(NULL, menuPtr->tkwin,
+ menuPtr->activeBorderWidthPtr, &activeBorderWidth);
+ *xPtr += Tk_Width(menuPtr->tkwin) - borderWidth - activeBorderWidth
+ - 2;
+ *yPtr += mePtr->y + activeBorderWidth + 2;
+ }
+}
+
+/*
+ * Local Variables:
+ * mode: c
+ * c-basic-offset: 4
+ * fill-column: 78
+ * End:
+ */
diff --git a/tk8.6/generic/tkMenubutton.c b/tk8.6/generic/tkMenubutton.c
new file mode 100644
index 0000000..1a4d5ae
--- /dev/null
+++ b/tk8.6/generic/tkMenubutton.c
@@ -0,0 +1,964 @@
+/*
+ * tkMenubutton.c --
+ *
+ * This module implements button-like widgets that are used to invoke
+ * pull-down menus.
+ *
+ * Copyright (c) 1990-1994 The Regents of the University of California.
+ * Copyright (c) 1994-1997 Sun Microsystems, Inc.
+ *
+ * See the file "license.terms" for information on usage and redistribution of
+ * this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ */
+
+#include "tkInt.h"
+#include "tkMenubutton.h"
+#include "default.h"
+
+/*
+ * The structure below defines menubutton class behavior by means of
+ * procedures that can be invoked from generic window code.
+ */
+
+static const Tk_ClassProcs menubuttonClass = {
+ sizeof(Tk_ClassProcs), /* size */
+ TkMenuButtonWorldChanged, /* worldChangedProc */
+ NULL, /* createProc */
+ NULL /* modalProc */
+};
+
+/*
+ * The following table defines the legal values for the -direction option. It
+ * is used together with the "enum direction" declaration in tkMenubutton.h.
+ */
+
+static const char *const directionStrings[] = {
+ "above", "below", "flush", "left", "right", 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 const char *const stateStrings[] = {
+ "active", "disabled", "normal", NULL
+};
+
+/*
+ * The following table defines the legal values for the -compound option. It
+ * is used with the "enum compound" declaration in tkMenuButton.h
+ */
+
+static const char *const compoundStrings[] = {
+ "bottom", "center", "left", "none", "right", "top", NULL
+};
+
+/*
+ * Information used for parsing configuration specs:
+ */
+
+static const 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, 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, DEF_MENUBUTTON_BG_MONO, 0},
+ {TK_OPTION_SYNONYM, "-bd", NULL, NULL, NULL, 0, -1, 0,
+ (ClientData) "-borderwidth", 0},
+ {TK_OPTION_SYNONYM, "-bg", NULL, NULL, 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, directionStrings, 0},
+ {TK_OPTION_COLOR, "-disabledforeground", "disabledForeground",
+ "DisabledForeground", DEF_MENUBUTTON_DISABLED_FG_COLOR,
+ -1, Tk_Offset(TkMenuButton, disabledFg), TK_OPTION_NULL_OK,
+ (ClientData) DEF_MENUBUTTON_DISABLED_FG_MONO, 0},
+ {TK_OPTION_SYNONYM, "-fg", "foreground", NULL, NULL, 0, -1, 0,
+ (ClientData) "-foreground", 0},
+ {TK_OPTION_FONT, "-font", "font", "Font",
+ DEF_MENUBUTTON_FONT, -1, Tk_Offset(TkMenuButton, tkfont), 0, 0, 0},
+ {TK_OPTION_COLOR, "-foreground", "foreground", "Foreground",
+ DEF_MENUBUTTON_FG, -1, Tk_Offset(TkMenuButton, normalFg), 0, 0, 0},
+ {TK_OPTION_STRING, "-height", "height", "Height",
+ DEF_MENUBUTTON_HEIGHT, -1, Tk_Offset(TkMenuButton, heightString),
+ 0, 0, 0},
+ {TK_OPTION_COLOR, "-highlightbackground", "highlightBackground",
+ "HighlightBackground", DEF_MENUBUTTON_HIGHLIGHT_BG_COLOR,
+ -1, Tk_Offset(TkMenuButton, highlightBgColorPtr), 0, 0, 0},
+ {TK_OPTION_COLOR, "-highlightcolor", "highlightColor", "HighlightColor",
+ DEF_MENUBUTTON_HIGHLIGHT, -1,
+ Tk_Offset(TkMenuButton, highlightColorPtr), 0, 0, 0},
+ {TK_OPTION_PIXELS, "-highlightthickness", "highlightThickness",
+ "HighlightThickness", DEF_MENUBUTTON_HIGHLIGHT_WIDTH,
+ -1, Tk_Offset(TkMenuButton, highlightWidth), 0, 0, 0},
+ {TK_OPTION_STRING, "-image", "image", "Image",
+ DEF_MENUBUTTON_IMAGE, -1, Tk_Offset(TkMenuButton, imageString),
+ TK_OPTION_NULL_OK, 0, 0},
+ {TK_OPTION_BOOLEAN, "-indicatoron", "indicatorOn", "IndicatorOn",
+ DEF_MENUBUTTON_INDICATOR, -1, Tk_Offset(TkMenuButton, indicatorOn),
+ 0, 0, 0},
+ {TK_OPTION_JUSTIFY, "-justify", "justify", "Justify",
+ DEF_MENUBUTTON_JUSTIFY, -1, Tk_Offset(TkMenuButton, justify), 0, 0, 0},
+ {TK_OPTION_STRING, "-menu", "menu", "Menu",
+ DEF_MENUBUTTON_MENU, -1, Tk_Offset(TkMenuButton, menuName),
+ TK_OPTION_NULL_OK, 0, 0},
+ {TK_OPTION_PIXELS, "-padx", "padX", "Pad",
+ DEF_MENUBUTTON_PADX, -1, Tk_Offset(TkMenuButton, padX),
+ 0, 0, 0},
+ {TK_OPTION_PIXELS, "-pady", "padY", "Pad",
+ DEF_MENUBUTTON_PADY, -1, Tk_Offset(TkMenuButton, padY),
+ 0, 0, 0},
+ {TK_OPTION_RELIEF, "-relief", "relief", "Relief",
+ DEF_MENUBUTTON_RELIEF, -1, Tk_Offset(TkMenuButton, relief),
+ 0, 0, 0},
+ {TK_OPTION_STRING_TABLE, "-compound", "compound", "Compound",
+ DEF_BUTTON_COMPOUND, -1, Tk_Offset(TkMenuButton, compound), 0,
+ compoundStrings, 0},
+ {TK_OPTION_STRING_TABLE, "-state", "state", "State",
+ DEF_MENUBUTTON_STATE, -1, Tk_Offset(TkMenuButton, state),
+ 0, 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, NULL, NULL, NULL, NULL, 0, 0, 0, NULL, 0}
+};
+
+/*
+ * The following tables define the menubutton widget commands and map the
+ * indexes into the string tables into a single enumerated type used to
+ * dispatch the scale widget command.
+ */
+
+static const char *const commandNames[] = {
+ "cget", "configure", NULL
+};
+
+enum command {
+ COMMAND_CGET, COMMAND_CONFIGURE
+};
+
+/*
+ * Forward declarations for functions defined later in this file:
+ */
+
+static void MenuButtonCmdDeletedProc(ClientData clientData);
+static void MenuButtonEventProc(ClientData clientData,
+ XEvent *eventPtr);
+static void MenuButtonImageProc(ClientData clientData,
+ int x, int y, int width, int height, int imgWidth,
+ int imgHeight);
+static char * MenuButtonTextVarProc(ClientData clientData,
+ Tcl_Interp *interp, const char *name1,
+ const char *name2, int flags);
+static int MenuButtonWidgetObjCmd(ClientData clientData,
+ Tcl_Interp *interp, int objc,
+ Tcl_Obj *const objv[]);
+static int ConfigureMenuButton(Tcl_Interp *interp,
+ TkMenuButton *mbPtr, int objc,
+ Tcl_Obj *const objv[]);
+static void DestroyMenuButton(char *memPtr);
+
+/*
+ *--------------------------------------------------------------
+ *
+ * Tk_MenubuttonObjCmd --
+ *
+ * This function is invoked to process the "button", "label",
+ * "radiobutton", and "checkbutton" Tcl commands. See the user
+ * documentation for details on what it does.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * See the user documentation.
+ *
+ *--------------------------------------------------------------
+ */
+
+int
+Tk_MenubuttonObjCmd(
+ ClientData clientData, /* NULL. */
+ Tcl_Interp *interp, /* Current interpreter. */
+ int objc, /* Number of arguments. */
+ Tcl_Obj *const objv[]) /* Argument objects. */
+{
+ register TkMenuButton *mbPtr;
+ Tk_OptionTable optionTable;
+ Tk_Window tkwin;
+
+ if (objc < 2) {
+ Tcl_WrongNumArgs(interp, 1, objv, "pathName ?-option value ...?");
+ return TCL_ERROR;
+ }
+
+ /*
+ * Create the new window.
+ */
+
+ tkwin = Tk_CreateWindowFromPath(interp, Tk_MainWindow(interp),
+ Tcl_GetString(objv[1]), NULL);
+ if (tkwin == NULL) {
+ return TCL_ERROR;
+ }
+
+ /*
+ * Create the option table for this widget class. If it has already been
+ * created, the cached pointer will be returned.
+ */
+
+ optionTable = Tk_CreateOptionTable(interp, optionSpecs);
+
+ Tk_SetClass(tkwin, "Menubutton");
+ mbPtr = TkpCreateMenuButton(tkwin);
+
+ Tk_SetClassProcs(tkwin, &menubuttonClass, mbPtr);
+
+ /*
+ * Initialize the data structure for the button.
+ */
+
+ mbPtr->tkwin = tkwin;
+ mbPtr->display = Tk_Display(tkwin);
+ mbPtr->interp = interp;
+ mbPtr->widgetCmd = Tcl_CreateObjCommand(interp,
+ Tk_PathName(mbPtr->tkwin), MenuButtonWidgetObjCmd, mbPtr,
+ MenuButtonCmdDeletedProc);
+ mbPtr->optionTable = optionTable;
+ mbPtr->menuName = NULL;
+ mbPtr->text = NULL;
+ mbPtr->underline = -1;
+ mbPtr->textVarName = NULL;
+ mbPtr->bitmap = None;
+ mbPtr->imageString = NULL;
+ mbPtr->image = NULL;
+ mbPtr->state = STATE_NORMAL;
+ mbPtr->normalBorder = NULL;
+ mbPtr->activeBorder = NULL;
+ mbPtr->borderWidth = 0;
+ mbPtr->relief = TK_RELIEF_FLAT;
+ mbPtr->highlightWidth = 0;
+ mbPtr->highlightBgColorPtr = NULL;
+ mbPtr->highlightColorPtr = NULL;
+ mbPtr->inset = 0;
+ mbPtr->tkfont = NULL;
+ mbPtr->normalFg = NULL;
+ mbPtr->activeFg = NULL;
+ mbPtr->disabledFg = NULL;
+ mbPtr->normalTextGC = None;
+ mbPtr->activeTextGC = None;
+ mbPtr->gray = None;
+ mbPtr->disabledGC = None;
+ mbPtr->stippleGC = None;
+ mbPtr->leftBearing = 0;
+ mbPtr->rightBearing = 0;
+ mbPtr->widthString = NULL;
+ mbPtr->heightString = NULL;
+ mbPtr->width = 0;
+ mbPtr->width = 0;
+ mbPtr->wrapLength = 0;
+ mbPtr->padX = 0;
+ mbPtr->padY = 0;
+ mbPtr->anchor = TK_ANCHOR_CENTER;
+ mbPtr->justify = TK_JUSTIFY_CENTER;
+ mbPtr->textLayout = NULL;
+ mbPtr->indicatorOn = 0;
+ mbPtr->indicatorWidth = 0;
+ mbPtr->indicatorHeight = 0;
+ mbPtr->direction = DIRECTION_FLUSH;
+ mbPtr->cursor = None;
+ mbPtr->takeFocus = NULL;
+ mbPtr->flags = 0;
+
+ Tk_CreateEventHandler(mbPtr->tkwin,
+ ExposureMask|StructureNotifyMask|FocusChangeMask,
+ MenuButtonEventProc, mbPtr);
+
+ if (Tk_InitOptions(interp, (char *) mbPtr, optionTable, tkwin) != TCL_OK) {
+ Tk_DestroyWindow(mbPtr->tkwin);
+ return TCL_ERROR;
+ }
+
+ if (ConfigureMenuButton(interp, mbPtr, objc-2, objv+2) != TCL_OK) {
+ Tk_DestroyWindow(mbPtr->tkwin);
+ return TCL_ERROR;
+ }
+
+ Tcl_SetObjResult(interp, TkNewWindowObj(mbPtr->tkwin));
+ return TCL_OK;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * MenuButtonWidgetObjCmd --
+ *
+ * This function is invoked to process the Tcl command that corresponds
+ * to a widget managed by this module. See the user documentation for
+ * details on what it does.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * See the user documentation.
+ *
+ *--------------------------------------------------------------
+ */
+
+static int
+MenuButtonWidgetObjCmd(
+ ClientData clientData, /* Information about button widget. */
+ Tcl_Interp *interp, /* Current interpreter. */
+ int objc, /* Number of arguments. */
+ Tcl_Obj *const objv[]) /* Argument objects. */
+{
+ register TkMenuButton *mbPtr = clientData;
+ int result, index;
+ Tcl_Obj *objPtr;
+
+ if (objc < 2) {
+ Tcl_WrongNumArgs(interp, 1, objv, "option ?arg ...?");
+ return TCL_ERROR;
+ }
+ result = Tcl_GetIndexFromObjStruct(interp, objv[1], commandNames,
+ sizeof(char *), "option", 0, &index);
+ if (result != TCL_OK) {
+ return result;
+ }
+ Tcl_Preserve(mbPtr);
+
+ switch (index) {
+ case COMMAND_CGET:
+ if (objc != 3) {
+ Tcl_WrongNumArgs(interp, 1, objv, "cget option");
+ goto error;
+ }
+
+ objPtr = Tk_GetOptionValue(interp, (char *) mbPtr,
+ mbPtr->optionTable, objv[2], mbPtr->tkwin);
+ if (objPtr == NULL) {
+ goto error;
+ }
+ Tcl_SetObjResult(interp, objPtr);
+ break;
+
+ case COMMAND_CONFIGURE:
+ if (objc <= 3) {
+ objPtr = Tk_GetOptionInfo(interp, (char *) mbPtr,
+ mbPtr->optionTable, (objc == 3) ? objv[2] : NULL,
+ mbPtr->tkwin);
+ if (objPtr == NULL) {
+ goto error;
+ }
+ Tcl_SetObjResult(interp, objPtr);
+ } else {
+ result = ConfigureMenuButton(interp, mbPtr, objc-2, objv+2);
+ }
+ break;
+ }
+ Tcl_Release(mbPtr);
+ return result;
+
+ error:
+ Tcl_Release(mbPtr);
+ return TCL_ERROR;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * DestroyMenuButton --
+ *
+ * This function is invoked to recycle all of the resources associated
+ * with a menubutton widget. It is invoked as a when-idle handler in
+ * order to make sure that there is no other use of the menubutton
+ * pending at the time of the deletion.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Everything associated with the widget is freed up.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+DestroyMenuButton(
+ char *memPtr) /* Info about button widget. */
+{
+ register TkMenuButton *mbPtr = (TkMenuButton *) memPtr;
+ TkpDestroyMenuButton(mbPtr);
+
+ if (mbPtr->flags & REDRAW_PENDING) {
+ Tcl_CancelIdleCall(TkpDisplayMenuButton, mbPtr);
+ }
+
+ /*
+ * Free up all the stuff that requires special handling, then let
+ * Tk_FreeOptions handle all the standard option-related stuff.
+ */
+
+ Tcl_DeleteCommandFromToken(mbPtr->interp, mbPtr->widgetCmd);
+ if (mbPtr->textVarName != NULL) {
+ Tcl_UntraceVar2(mbPtr->interp, mbPtr->textVarName, NULL,
+ TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS,
+ MenuButtonTextVarProc, mbPtr);
+ }
+ if (mbPtr->image != NULL) {
+ Tk_FreeImage(mbPtr->image);
+ }
+ if (mbPtr->normalTextGC != None) {
+ Tk_FreeGC(mbPtr->display, mbPtr->normalTextGC);
+ }
+ if (mbPtr->activeTextGC != None) {
+ Tk_FreeGC(mbPtr->display, mbPtr->activeTextGC);
+ }
+ if (mbPtr->disabledGC != None) {
+ Tk_FreeGC(mbPtr->display, mbPtr->disabledGC);
+ }
+ if (mbPtr->stippleGC != None) {
+ Tk_FreeGC(mbPtr->display, mbPtr->stippleGC);
+ }
+ if (mbPtr->gray != None) {
+ Tk_FreeBitmap(mbPtr->display, mbPtr->gray);
+ }
+ if (mbPtr->textLayout != NULL) {
+ Tk_FreeTextLayout(mbPtr->textLayout);
+ }
+ Tk_FreeConfigOptions((char *) mbPtr, mbPtr->optionTable, mbPtr->tkwin);
+ mbPtr->tkwin = NULL;
+ Tcl_EventuallyFree(mbPtr, TCL_DYNAMIC);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ConfigureMenuButton --
+ *
+ * This function is called to process an argv/argc list, plus the Tk
+ * option database, in order to configure (or reconfigure) a menubutton
+ * widget.
+ *
+ * Results:
+ * The return value is a standard Tcl result. If TCL_ERROR is returned,
+ * then the interp's result contains an error message.
+ *
+ * Side effects:
+ * Configuration information, such as text string, colors, font, etc. get
+ * set for mbPtr; old resources get freed, if there were any. The
+ * menubutton is redisplayed.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+ConfigureMenuButton(
+ Tcl_Interp *interp, /* Used for error reporting. */
+ register TkMenuButton *mbPtr,
+ /* Information about widget; may or may not
+ * already have values for some fields. */
+ int objc, /* Number of valid entries in objv. */
+ Tcl_Obj *const objv[]) /* Arguments. */
+{
+ Tk_SavedOptions savedOptions;
+ Tcl_Obj *errorResult = NULL;
+ int error;
+ Tk_Image image;
+
+ /*
+ * Eliminate any existing trace on variables monitored by the menubutton.
+ */
+
+ if (mbPtr->textVarName != NULL) {
+ Tcl_UntraceVar2(interp, mbPtr->textVarName, NULL,
+ TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS,
+ MenuButtonTextVarProc, mbPtr);
+ }
+
+ /*
+ * The following loop is potentially executed twice. During the first pass
+ * configuration options get set to their new values. If there is an error
+ * in this pass, we execute a second pass to restore all the options to
+ * their previous values.
+ */
+
+ for (error = 0; error <= 1; error++) {
+ if (!error) {
+ /*
+ * First pass: set options to new values.
+ */
+
+ if (Tk_SetOptions(interp, (char *) mbPtr,
+ mbPtr->optionTable, objc, objv,
+ mbPtr->tkwin, &savedOptions, NULL) != TCL_OK) {
+ continue;
+ }
+ } else {
+ /*
+ * Second pass: restore options to old values.
+ */
+
+ errorResult = Tcl_GetObjResult(interp);
+ Tcl_IncrRefCount(errorResult);
+ Tk_RestoreSavedOptions(&savedOptions);
+ }
+
+ /*
+ * A few options need special processing, such as setting the
+ * background from a 3-D border, or filling in complicated defaults
+ * that couldn't be specified to Tk_SetOptions.
+ */
+
+ if ((mbPtr->state == STATE_ACTIVE)
+ && !Tk_StrictMotif(mbPtr->tkwin)) {
+ Tk_SetBackgroundFromBorder(mbPtr->tkwin, mbPtr->activeBorder);
+ } else {
+ Tk_SetBackgroundFromBorder(mbPtr->tkwin, mbPtr->normalBorder);
+ }
+
+ if (mbPtr->highlightWidth < 0) {
+ mbPtr->highlightWidth = 0;
+ }
+
+ if (mbPtr->padX < 0) {
+ mbPtr->padX = 0;
+ }
+ if (mbPtr->padY < 0) {
+ mbPtr->padY = 0;
+ }
+
+ /*
+ * Get the image for the widget, if there is one. Allocate the new
+ * image before freeing the old one, so that the reference count
+ * doesn't go to zero and cause image data to be discarded.
+ */
+
+ if (mbPtr->imageString != NULL) {
+ image = Tk_GetImage(mbPtr->interp, mbPtr->tkwin,
+ mbPtr->imageString, MenuButtonImageProc, mbPtr);
+ if (image == NULL) {
+ return TCL_ERROR;
+ }
+ } else {
+ image = NULL;
+ }
+ if (mbPtr->image != NULL) {
+ Tk_FreeImage(mbPtr->image);
+ }
+ mbPtr->image = image;
+
+ /*
+ * Recompute the geometry for the button.
+ */
+
+ if ((mbPtr->bitmap != None) || (mbPtr->image != NULL)) {
+ if (Tk_GetPixels(interp, mbPtr->tkwin, mbPtr->widthString,
+ &mbPtr->width) != TCL_OK) {
+ widthError:
+ Tcl_AddErrorInfo(interp, "\n (processing -width option)");
+ continue;
+ }
+ if (Tk_GetPixels(interp, mbPtr->tkwin, mbPtr->heightString,
+ &mbPtr->height) != TCL_OK) {
+ heightError:
+ Tcl_AddErrorInfo(interp, "\n (processing -height option)");
+ continue;
+ }
+ } else {
+ if (Tcl_GetInt(interp, mbPtr->widthString, &mbPtr->width)
+ != TCL_OK) {
+ goto widthError;
+ }
+ if (Tcl_GetInt(interp, mbPtr->heightString, &mbPtr->height)
+ != TCL_OK) {
+ goto heightError;
+ }
+ }
+ break;
+ }
+
+ if (!error) {
+ Tk_FreeSavedOptions(&savedOptions);
+ }
+
+ if (mbPtr->textVarName != NULL) {
+ /*
+ * If no image or -compound is used, display the value of a variable.
+ * Set up a trace to watch for any changes in it, create the variable
+ * if it doesn't exist, and fetch its current value.
+ */
+ const char *value;
+
+ value = Tcl_GetVar2(interp, mbPtr->textVarName, NULL, TCL_GLOBAL_ONLY);
+ if (value == NULL) {
+ Tcl_SetVar2(interp, mbPtr->textVarName, NULL, mbPtr->text,
+ TCL_GLOBAL_ONLY);
+ } else {
+ if (mbPtr->text != NULL) {
+ ckfree(mbPtr->text);
+ }
+ mbPtr->text = ckalloc(strlen(value) + 1);
+ strcpy(mbPtr->text, value);
+ }
+ Tcl_TraceVar2(interp, mbPtr->textVarName, NULL,
+ TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS,
+ MenuButtonTextVarProc, mbPtr);
+ }
+
+ TkMenuButtonWorldChanged(mbPtr);
+ if (error) {
+ Tcl_SetObjResult(interp, errorResult);
+ Tcl_DecrRefCount(errorResult);
+ return TCL_ERROR;
+ }
+ return TCL_OK;
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * TkMenuButtonWorldChanged --
+ *
+ * This function is called when the world has changed in some way and the
+ * widget needs to recompute all its graphics contexts and determine its
+ * new geometry.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * TkMenuButton will be relayed out and redisplayed.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+void
+TkMenuButtonWorldChanged(
+ ClientData instanceData) /* Information about widget. */
+{
+ XGCValues gcValues;
+ GC gc;
+ unsigned long mask;
+ TkMenuButton *mbPtr = instanceData;
+
+ gcValues.font = Tk_FontId(mbPtr->tkfont);
+ gcValues.foreground = mbPtr->normalFg->pixel;
+ gcValues.background = Tk_3DBorderColor(mbPtr->normalBorder)->pixel;
+
+ /*
+ * Note: GraphicsExpose events are disabled in GC's because they're used
+ * to copy stuff from an off-screen pixmap onto the screen (we know that
+ * there's no problem with obscured areas).
+ */
+
+ gcValues.graphics_exposures = False;
+ mask = GCForeground | GCBackground | GCFont | GCGraphicsExposures;
+ gc = Tk_GetGC(mbPtr->tkwin, mask, &gcValues);
+ if (mbPtr->normalTextGC != None) {
+ Tk_FreeGC(mbPtr->display, mbPtr->normalTextGC);
+ }
+ mbPtr->normalTextGC = gc;
+
+ gcValues.foreground = mbPtr->activeFg->pixel;
+ gcValues.background = Tk_3DBorderColor(mbPtr->activeBorder)->pixel;
+ mask = GCForeground | GCBackground | GCFont;
+ gc = Tk_GetGC(mbPtr->tkwin, mask, &gcValues);
+ if (mbPtr->activeTextGC != None) {
+ Tk_FreeGC(mbPtr->display, mbPtr->activeTextGC);
+ }
+ mbPtr->activeTextGC = gc;
+
+ gcValues.background = Tk_3DBorderColor(mbPtr->normalBorder)->pixel;
+
+ /*
+ * Create the GC that can be used for stippling
+ */
+
+ if (mbPtr->stippleGC == None) {
+ gcValues.foreground = gcValues.background;
+ mask = GCForeground;
+ if (mbPtr->gray == None) {
+ mbPtr->gray = Tk_GetBitmap(NULL, mbPtr->tkwin, "gray50");
+ }
+ if (mbPtr->gray != None) {
+ gcValues.fill_style = FillStippled;
+ gcValues.stipple = mbPtr->gray;
+ mask |= GCFillStyle | GCStipple;
+ }
+ mbPtr->stippleGC = Tk_GetGC(mbPtr->tkwin, mask, &gcValues);
+ }
+
+ /*
+ * Allocate the disabled graphics context, for drawing text in its
+ * disabled state.
+ */
+
+ mask = GCForeground | GCBackground | GCFont;
+ if (mbPtr->disabledFg != NULL) {
+ gcValues.foreground = mbPtr->disabledFg->pixel;
+ } else {
+ gcValues.foreground = gcValues.background;
+ }
+ gc = Tk_GetGC(mbPtr->tkwin, mask, &gcValues);
+ if (mbPtr->disabledGC != None) {
+ Tk_FreeGC(mbPtr->display, mbPtr->disabledGC);
+ }
+ mbPtr->disabledGC = gc;
+
+ TkpComputeMenuButtonGeometry(mbPtr);
+
+ /*
+ * Lastly, arrange for the button to be redisplayed.
+ */
+
+ if (Tk_IsMapped(mbPtr->tkwin) && !(mbPtr->flags & REDRAW_PENDING)) {
+ Tcl_DoWhenIdle(TkpDisplayMenuButton, mbPtr);
+ mbPtr->flags |= REDRAW_PENDING;
+ }
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * MenuButtonEventProc --
+ *
+ * This function is invoked by the Tk dispatcher for various events on
+ * buttons.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * When the window gets deleted, internal structures get cleaned up.
+ * When it gets exposed, it is redisplayed.
+ *
+ *--------------------------------------------------------------
+ */
+
+static void
+MenuButtonEventProc(
+ ClientData clientData, /* Information about window. */
+ XEvent *eventPtr) /* Information about event. */
+{
+ TkMenuButton *mbPtr = clientData;
+
+ if ((eventPtr->type == Expose) && (eventPtr->xexpose.count == 0)) {
+ goto redraw;
+ } else if (eventPtr->type == ConfigureNotify) {
+ /*
+ * Must redraw after size changes, since layout could have changed and
+ * borders will need to be redrawn.
+ */
+
+ goto redraw;
+ } else if (eventPtr->type == DestroyNotify) {
+ DestroyMenuButton((char *) mbPtr);
+ } else if (eventPtr->type == FocusIn) {
+ if (eventPtr->xfocus.detail != NotifyInferior) {
+ mbPtr->flags |= GOT_FOCUS;
+ if (mbPtr->highlightWidth > 0) {
+ goto redraw;
+ }
+ }
+ } else if (eventPtr->type == FocusOut) {
+ if (eventPtr->xfocus.detail != NotifyInferior) {
+ mbPtr->flags &= ~GOT_FOCUS;
+ if (mbPtr->highlightWidth > 0) {
+ goto redraw;
+ }
+ }
+ }
+ return;
+
+ redraw:
+ if ((mbPtr->tkwin != NULL) && !(mbPtr->flags & REDRAW_PENDING)) {
+ Tcl_DoWhenIdle(TkpDisplayMenuButton, mbPtr);
+ mbPtr->flags |= REDRAW_PENDING;
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * MenuButtonCmdDeletedProc --
+ *
+ * This function is invoked when a widget command is deleted. If the
+ * widget isn't already in the process of being destroyed, this command
+ * destroys it.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The widget is destroyed.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+MenuButtonCmdDeletedProc(
+ ClientData clientData) /* Pointer to widget record for widget. */
+{
+ TkMenuButton *mbPtr = clientData;
+ Tk_Window tkwin = mbPtr->tkwin;
+
+ /*
+ * This function 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 function destroys the
+ * widget.
+ */
+
+ if (tkwin != NULL) {
+ Tk_DestroyWindow(tkwin);
+ }
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * MenuButtonTextVarProc --
+ *
+ * This function is invoked when someone changes the variable whose
+ * contents are to be displayed in a menu button.
+ *
+ * Results:
+ * NULL is always returned.
+ *
+ * Side effects:
+ * The text displayed in the menu button will change to match the
+ * variable.
+ *
+ *--------------------------------------------------------------
+ */
+
+ /* ARGSUSED */
+static char *
+MenuButtonTextVarProc(
+ ClientData clientData, /* Information about button. */
+ Tcl_Interp *interp, /* Interpreter containing variable. */
+ const char *name1, /* Name of variable. */
+ const char *name2, /* Second part of variable name. */
+ int flags) /* Information about what happened. */
+{
+ register TkMenuButton *mbPtr = clientData;
+ const char *value;
+ unsigned len;
+
+ /*
+ * If the variable is unset, then immediately recreate it unless the whole
+ * interpreter is going away.
+ */
+
+ if (flags & TCL_TRACE_UNSETS) {
+ if ((flags & TCL_TRACE_DESTROYED) && !(flags & TCL_INTERP_DESTROYED)) {
+ Tcl_SetVar2(interp, mbPtr->textVarName, NULL, mbPtr->text,
+ TCL_GLOBAL_ONLY);
+ Tcl_TraceVar2(interp, mbPtr->textVarName, NULL,
+ TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS,
+ MenuButtonTextVarProc, clientData);
+ }
+ return NULL;
+ }
+
+ value = Tcl_GetVar2(interp, mbPtr->textVarName, NULL, TCL_GLOBAL_ONLY);
+ if (value == NULL) {
+ value = "";
+ }
+ if (mbPtr->text != NULL) {
+ ckfree(mbPtr->text);
+ }
+ len = 1 + (unsigned) strlen(value);
+ mbPtr->text = ckalloc(len);
+ memcpy(mbPtr->text, value, len);
+ TkpComputeMenuButtonGeometry(mbPtr);
+
+ if ((mbPtr->tkwin != NULL) && Tk_IsMapped(mbPtr->tkwin)
+ && !(mbPtr->flags & REDRAW_PENDING)) {
+ Tcl_DoWhenIdle(TkpDisplayMenuButton, mbPtr);
+ mbPtr->flags |= REDRAW_PENDING;
+ }
+ return NULL;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * MenuButtonImageProc --
+ *
+ * This function is invoked by the image code whenever the manager for an
+ * image does something that affects the size of contents of an image
+ * displayed in a button.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Arranges for the button to get redisplayed.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+MenuButtonImageProc(
+ ClientData clientData, /* Pointer to widget record. */
+ int x, int y, /* Upper left pixel (within image) that must
+ * be redisplayed. */
+ int width, int height, /* Dimensions of area to redisplay (may be <=
+ * 0). */
+ int imgWidth, int imgHeight)/* New dimensions of image. */
+{
+ register TkMenuButton *mbPtr = clientData;
+
+ if (mbPtr->tkwin != NULL) {
+ TkpComputeMenuButtonGeometry(mbPtr);
+ if (Tk_IsMapped(mbPtr->tkwin) && !(mbPtr->flags & REDRAW_PENDING)) {
+ Tcl_DoWhenIdle(TkpDisplayMenuButton, mbPtr);
+ mbPtr->flags |= REDRAW_PENDING;
+ }
+ }
+}
+
+/*
+ * Local Variables:
+ * mode: c
+ * c-basic-offset: 4
+ * fill-column: 78
+ * End:
+ */
diff --git a/tk8.6/generic/tkMenubutton.h b/tk8.6/generic/tkMenubutton.h
new file mode 100644
index 0000000..e8dc12f
--- /dev/null
+++ b/tk8.6/generic/tkMenubutton.h
@@ -0,0 +1,216 @@
+/*
+ * tkMenubutton.h --
+ *
+ * Declarations of types and functions used to implement the menubutton
+ * widget.
+ *
+ * Copyright (c) 1996-1997 by Sun Microsystems, Inc.
+ *
+ * See the file "license.terms" for information on usage and redistribution of
+ * this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ */
+
+#ifndef _TKMENUBUTTON
+#define _TKMENUBUTTON
+
+#ifndef _TKINT
+#include "tkInt.h"
+#endif
+
+#ifndef _TKMENU
+#include "tkMenu.h"
+#endif
+
+/*
+ * Legal values for the "orient" field of TkMenubutton records.
+ */
+
+enum direction {
+ DIRECTION_ABOVE, DIRECTION_BELOW, DIRECTION_FLUSH,
+ DIRECTION_LEFT, DIRECTION_RIGHT
+};
+
+/*
+ * Legal values for the "state" field of TkMenubutton records.
+ */
+
+enum state {
+ STATE_ACTIVE, STATE_DISABLED, STATE_NORMAL
+};
+
+/*
+ * A data structure of the following type is kept for each widget managed by
+ * this file:
+ */
+
+typedef struct {
+ Tk_Window tkwin; /* Window that embodies the widget. NULL means
+ * that the window has been destroyed but the
+ * data structures haven't yet been cleaned
+ * up. */
+ Display *display; /* Display containing widget. Needed, among
+ * other things, so that resources can bee
+ * freed up even after tkwin has gone away. */
+ Tcl_Interp *interp; /* Interpreter associated with menubutton. */
+ Tcl_Command widgetCmd; /* Token for menubutton's widget command. */
+ Tk_OptionTable optionTable; /* Table that defines configuration options
+ * available for this widget. */
+ char *menuName; /* Name of menu associated with widget.
+ * Malloc-ed. */
+
+ /*
+ * Information about what's displayed in the menu button:
+ */
+
+ char *text; /* Text to display in button (malloc'ed) or
+ * NULL. */
+ int underline; /* Index of character to underline. */
+ char *textVarName; /* Name of variable (malloc'ed) or NULL. If
+ * non-NULL, button displays the contents of
+ * this variable. */
+ Pixmap bitmap; /* Bitmap to display or None. If not None then
+ * text and textVar and underline are
+ * ignored. */
+ char *imageString; /* Name of image to display (malloc'ed), or
+ * NULL. If non-NULL, bitmap, text, and
+ * textVarName are ignored. */
+ Tk_Image image; /* Image to display in window, or NULL if
+ * none. */
+
+ /*
+ * Information used when displaying widget:
+ */
+
+ enum state state; /* State of button for display purposes:
+ * normal, active, or disabled. */
+ Tk_3DBorder normalBorder; /* Structure used to draw 3-D border and
+ * background when window isn't active. NULL
+ * means no such border exists. */
+ Tk_3DBorder activeBorder; /* Structure used to draw 3-D border and
+ * background when window is active. NULL
+ * means no such border exists. */
+ int borderWidth; /* Width of border. */
+ int relief; /* 3-d effect: TK_RELIEF_RAISED, etc. */
+ int highlightWidth; /* Width in pixels of highlight to draw around
+ * widget when it has the focus. <= 0 means
+ * don't draw a highlight. */
+ XColor *highlightBgColorPtr;/* Color for drawing traversal highlight area
+ * when highlight is off. */
+ XColor *highlightColorPtr; /* Color for drawing traversal highlight. */
+ int inset; /* Total width of all borders, including
+ * traversal highlight and 3-D border.
+ * Indicates how much interior stuff must be
+ * offset from outside edges to leave room for
+ * borders. */
+ Tk_Font tkfont; /* Information about text font, or NULL. */
+ XColor *normalFg; /* Foreground color in normal mode. */
+ XColor *activeFg; /* Foreground color in active mode. NULL means
+ * use normalFg instead. */
+ XColor *disabledFg; /* Foreground color when disabled. NULL means
+ * use normalFg with a 50% stipple instead. */
+ GC normalTextGC; /* GC for drawing text in normal mode. */
+ GC activeTextGC; /* GC for drawing text in active mode (NULL
+ * means use normalTextGC). */
+ Pixmap gray; /* Pixmap for displaying disabled text/icon if
+ * disabledFg is NULL. */
+ GC disabledGC; /* Used to produce disabled effect for
+ * text. */
+ GC stippleGC; /* Used to produce disabled stipple effect for
+ * images when disabled. */
+ int leftBearing; /* Distance from text origin to leftmost drawn
+ * pixel (positive means to right). */
+ int rightBearing; /* Amount text sticks right from its
+ * origin. */
+ char *widthString; /* Value of -width option. Malloc'ed. */
+ char *heightString; /* Value of -height option. Malloc'ed. */
+ int width, height; /* If > 0, these specify dimensions to request
+ * for window, in characters for text and in
+ * pixels for bitmaps. In this case the actual
+ * size of the text string or bitmap is
+ * ignored in computing desired window
+ * size. */
+ int wrapLength; /* Line length (in pixels) at which to wrap
+ * onto next line. <= 0 means don't wrap
+ * except at newlines. */
+ int padX, padY; /* Extra space around text or bitmap (pixels
+ * on each side). */
+ Tk_Anchor anchor; /* Where text/bitmap should be displayed
+ * inside window region. */
+ Tk_Justify justify; /* Justification to use for multi-line
+ * text. */
+ int textWidth; /* Width needed to display text as requested,
+ * in pixels. */
+ int textHeight; /* Height needed to display text as requested,
+ * in pixels. */
+ Tk_TextLayout textLayout; /* Saved text layout information. */
+ int indicatorOn; /* Non-zero means display indicator; 0 means
+ * don't display. */
+ int indicatorHeight; /* Height of indicator in pixels. This same
+ * amount of extra space is also left on each
+ * side of the indicator. 0 if no
+ * indicator. */
+ int indicatorWidth; /* Width of indicator in pixels, including
+ * indicatorHeight in padding on each side. 0
+ * if no indicator. */
+
+ /*
+ * Miscellaneous information:
+ */
+
+ int compound; /* Value of -compound option; specifies
+ * whether the menubutton should show both an
+ * image and text, and, if so, how. */
+ enum direction direction; /* Direction for where to pop the menu. Valid
+ * directions are "above", "below", "left",
+ * "right", and "flush". "flush" means that
+ * the upper left corner of the menubutton is
+ * where the menu pops up. "above" and "below"
+ * will attempt to pop the menu compleletly
+ * above or below the menu respectively.
+ * "left" and "right" will pop the menu left
+ * or right, and the active item will be next
+ * to the button. */
+ Tk_Cursor cursor; /* Current cursor for window, or None. */
+ char *takeFocus; /* Value of -takefocus option; not used in the
+ * C code, but used by keyboard traversal
+ * scripts. Malloc'ed, but may be NULL. */
+ int flags; /* Various flags; see below for
+ * definitions. */
+} TkMenuButton;
+
+/*
+ * Flag bits for buttons:
+ *
+ * REDRAW_PENDING: Non-zero means a DoWhenIdle handler has
+ * already been queued to redraw this window.
+ * POSTED: Non-zero means that the menu associated with
+ * this button has been posted (typically because
+ * of an active button press).
+ * GOT_FOCUS: Non-zero means this button currently has the
+ * input focus.
+ */
+
+#define REDRAW_PENDING 1
+#define POSTED 2
+#define GOT_FOCUS 4
+
+/*
+ * The following constants define the dimensions of the cascade indicator,
+ * which is displayed if the "-indicatoron" option is true. The units for
+ * these options are 1/10 millimeters.
+ */
+
+#define INDICATOR_WIDTH 40
+#define INDICATOR_HEIGHT 17
+
+/*
+ * Declaration of procedures used in the implementation of the button widget.
+ */
+
+MODULE_SCOPE void TkpComputeMenuButtonGeometry(TkMenuButton *mbPtr);
+MODULE_SCOPE TkMenuButton *TkpCreateMenuButton(Tk_Window tkwin);
+MODULE_SCOPE void TkpDisplayMenuButton(ClientData clientData);
+MODULE_SCOPE void TkpDestroyMenuButton(TkMenuButton *mbPtr);
+MODULE_SCOPE void TkMenuButtonWorldChanged(ClientData instanceData);
+
+#endif /* _TKMENUBUTTON */
diff --git a/tk8.6/generic/tkMessage.c b/tk8.6/generic/tkMessage.c
new file mode 100644
index 0000000..2b71998
--- /dev/null
+++ b/tk8.6/generic/tkMessage.c
@@ -0,0 +1,883 @@
+/*
+ * tkMessage.c --
+ *
+ * This module implements a message widgets for the Tk toolkit. A message
+ * widget displays a multi-line string in a window according to a
+ * particular aspect ratio.
+ *
+ * Copyright (c) 1990-1994 The Regents of the University of California.
+ * Copyright (c) 1994-1997 Sun Microsystems, Inc.
+ * Copyright (c) 1998-2000 by Ajuba Solutions.
+ *
+ * See the file "license.terms" for information on usage and redistribution of
+ * this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ */
+
+#include "default.h"
+#include "tkInt.h"
+
+/*
+ * A data structure of the following type is kept for each message widget
+ * managed by this file:
+ */
+
+typedef struct {
+ Tk_Window tkwin; /* Window that embodies the message. NULL
+ * means that the window has been destroyed
+ * but the data structures haven't yet been
+ * cleaned up.*/
+ Tk_OptionTable optionTable; /* Table that defines options available for
+ * this widget. */
+ Display *display; /* Display containing widget. Used, among
+ * other things, so that resources can be
+ * freed even after tkwin has gone away. */
+ Tcl_Interp *interp; /* Interpreter associated with message. */
+ Tcl_Command widgetCmd; /* Token for message's widget command. */
+
+ /*
+ * Information used when displaying widget:
+ */
+
+ char *string; /* String displayed in message. */
+ int numChars; /* Number of characters in string, not
+ * including terminating NULL. */
+ char *textVarName; /* Name of variable (malloc'ed) or NULL.
+ * If non-NULL, message displays the contents
+ * of this variable. */
+ Tk_3DBorder border; /* Structure used to draw 3-D border and
+ * background. NULL means a border hasn't been
+ * created yet. */
+ int borderWidth; /* Width of border. */
+ int relief; /* 3-D effect: TK_RELIEF_RAISED, etc. */
+ int highlightWidth; /* Width in pixels of highlight to draw
+ * around widget when it has the focus.
+ * <= 0 means don't draw a highlight. */
+ XColor *highlightBgColorPtr;
+ /* Color for drawing traversal highlight
+ * area when highlight is off. */
+ XColor *highlightColorPtr; /* Color for drawing traversal highlight. */
+ Tk_Font tkfont; /* Information about text font, or NULL. */
+ XColor *fgColorPtr; /* Foreground color in normal mode. */
+ Tcl_Obj *padXPtr, *padYPtr; /* Tcl_Obj rep's of padX, padY values. */
+ int padX, padY; /* User-requested extra space around text. */
+ int width; /* User-requested width, in pixels. 0 means
+ * compute width using aspect ratio below. */
+ int aspect; /* Desired aspect ratio for window
+ * (100*width/height). */
+ int msgWidth; /* Width in pixels needed to display
+ * message. */
+ int msgHeight; /* Height in pixels needed to display
+ * message. */
+ Tk_Anchor anchor; /* Where to position text within window region
+ * if window is larger or smaller than
+ * needed. */
+ Tk_Justify justify; /* Justification for text. */
+
+ GC textGC; /* GC for drawing text in normal mode. */
+ Tk_TextLayout textLayout; /* Saved layout information. */
+
+ /*
+ * Miscellaneous information:
+ */
+
+ Tk_Cursor cursor; /* Current cursor for window, or None. */
+ char *takeFocus; /* Value of -takefocus option; not used in the
+ * C code, but used by keyboard traversal
+ * scripts. Malloc'ed, but may be NULL. */
+ int flags; /* Various flags; see below for
+ * definitions. */
+} Message;
+
+/*
+ * Flag bits for messages:
+ *
+ * REDRAW_PENDING: Non-zero means a DoWhenIdle handler
+ * has already been queued to redraw
+ * this window.
+ * GOT_FOCUS: Non-zero means this button currently
+ * has the input focus.
+ * MESSAGE_DELETED: The message has been effectively deleted.
+ */
+
+#define REDRAW_PENDING 1
+#define GOT_FOCUS 4
+#define MESSAGE_DELETED 8
+
+/*
+ * Information used for argv parsing.
+ */
+
+static const Tk_OptionSpec optionSpecs[] = {
+ {TK_OPTION_ANCHOR, "-anchor", "anchor", "Anchor", DEF_MESSAGE_ANCHOR,
+ -1, Tk_Offset(Message, anchor), 0, 0, 0},
+ {TK_OPTION_INT, "-aspect", "aspect", "Aspect", DEF_MESSAGE_ASPECT,
+ -1, Tk_Offset(Message, aspect), 0, 0, 0},
+ {TK_OPTION_BORDER, "-background", "background", "Background",
+ DEF_MESSAGE_BG_COLOR, -1, Tk_Offset(Message, border), 0,
+ DEF_MESSAGE_BG_MONO, 0},
+ {TK_OPTION_SYNONYM, "-bd", NULL, NULL, NULL,
+ 0, -1, 0, "-borderwidth", 0},
+ {TK_OPTION_SYNONYM, "-bg", NULL, NULL, NULL,
+ 0, -1, 0, "-background", 0},
+ {TK_OPTION_PIXELS, "-borderwidth", "borderWidth", "BorderWidth",
+ DEF_MESSAGE_BORDER_WIDTH, -1,
+ Tk_Offset(Message, borderWidth), 0, 0, 0},
+ {TK_OPTION_CURSOR, "-cursor", "cursor", "Cursor",
+ DEF_MESSAGE_CURSOR, -1, Tk_Offset(Message, cursor),
+ TK_OPTION_NULL_OK, 0, 0},
+ {TK_OPTION_SYNONYM, "-fg", NULL, NULL, NULL,
+ 0, -1, 0, "-foreground", 0},
+ {TK_OPTION_FONT, "-font", "font", "Font",
+ DEF_MESSAGE_FONT, -1, Tk_Offset(Message, tkfont), 0, 0, 0},
+ {TK_OPTION_COLOR, "-foreground", "foreground", "Foreground",
+ DEF_MESSAGE_FG, -1, Tk_Offset(Message, fgColorPtr), 0, 0, 0},
+ {TK_OPTION_COLOR, "-highlightbackground", "highlightBackground",
+ "HighlightBackground", DEF_MESSAGE_HIGHLIGHT_BG, -1,
+ Tk_Offset(Message, highlightBgColorPtr), 0, 0, 0},
+ {TK_OPTION_COLOR, "-highlightcolor", "highlightColor", "HighlightColor",
+ DEF_MESSAGE_HIGHLIGHT, -1, Tk_Offset(Message, highlightColorPtr),
+ 0, 0, 0},
+ {TK_OPTION_PIXELS, "-highlightthickness", "highlightThickness",
+ "HighlightThickness", DEF_MESSAGE_HIGHLIGHT_WIDTH, -1,
+ Tk_Offset(Message, highlightWidth), 0, 0, 0},
+ {TK_OPTION_JUSTIFY, "-justify", "justify", "Justify",
+ DEF_MESSAGE_JUSTIFY, -1, Tk_Offset(Message, justify), 0, 0, 0},
+ {TK_OPTION_PIXELS, "-padx", "padX", "Pad",
+ DEF_MESSAGE_PADX, Tk_Offset(Message, padXPtr),
+ Tk_Offset(Message, padX), 0, 0, 0},
+ {TK_OPTION_PIXELS, "-pady", "padY", "Pad",
+ DEF_MESSAGE_PADY, Tk_Offset(Message, padYPtr),
+ Tk_Offset(Message, padY), 0, 0, 0},
+ {TK_OPTION_RELIEF, "-relief", "relief", "Relief",
+ DEF_MESSAGE_RELIEF, -1, Tk_Offset(Message, relief), 0, 0, 0},
+ {TK_OPTION_STRING, "-takefocus", "takeFocus", "TakeFocus",
+ DEF_MESSAGE_TAKE_FOCUS, -1, Tk_Offset(Message, takeFocus),
+ TK_OPTION_NULL_OK, 0, 0},
+ {TK_OPTION_STRING, "-text", "text", "Text",
+ DEF_MESSAGE_TEXT, -1, Tk_Offset(Message, string), 0, 0, 0},
+ {TK_OPTION_STRING, "-textvariable", "textVariable", "Variable",
+ DEF_MESSAGE_TEXT_VARIABLE, -1, Tk_Offset(Message, textVarName),
+ TK_OPTION_NULL_OK, 0, 0},
+ {TK_OPTION_PIXELS, "-width", "width", "Width",
+ DEF_MESSAGE_WIDTH, -1, Tk_Offset(Message, width), 0, 0 ,0},
+ {TK_OPTION_END, NULL, NULL, NULL, NULL, 0, 0, 0, 0, 0}
+};
+
+/*
+ * Forward declarations for functions defined later in this file:
+ */
+
+static void MessageCmdDeletedProc(ClientData clientData);
+static void MessageEventProc(ClientData clientData,
+ XEvent *eventPtr);
+static char * MessageTextVarProc(ClientData clientData,
+ Tcl_Interp *interp, const char *name1,
+ const char *name2, int flags);
+static int MessageWidgetObjCmd(ClientData clientData,
+ Tcl_Interp *interp, int objc,
+ Tcl_Obj *const objv[]);
+static void MessageWorldChanged(ClientData instanceData);
+static void ComputeMessageGeometry(Message *msgPtr);
+static int ConfigureMessage(Tcl_Interp *interp, Message *msgPtr,
+ int objc, Tcl_Obj *const objv[], int flags);
+static void DestroyMessage(char *memPtr);
+static void DisplayMessage(ClientData clientData);
+
+/*
+ * The structure below defines message class behavior by means of functions
+ * that can be invoked from generic window code.
+ */
+
+static const Tk_ClassProcs messageClass = {
+ sizeof(Tk_ClassProcs), /* size */
+ MessageWorldChanged, /* worldChangedProc */
+ NULL, /* createProc */
+ NULL /* modalProc */
+};
+
+/*
+ *--------------------------------------------------------------
+ *
+ * Tk_MessageObjCmd --
+ *
+ * This function is invoked to process the "message" Tcl command. See the
+ * user documentation for details on what it does.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * See the user documentation.
+ *
+ *--------------------------------------------------------------
+ */
+
+int
+Tk_MessageObjCmd(
+ ClientData clientData, /* NULL. */
+ Tcl_Interp *interp, /* Current interpreter. */
+ int objc, /* Number of arguments. */
+ Tcl_Obj *const objv[]) /* Argument strings. */
+{
+ register Message *msgPtr;
+ Tk_OptionTable optionTable;
+ Tk_Window tkwin;
+
+ if (objc < 2) {
+ Tcl_WrongNumArgs(interp, 1, objv, "pathName ?-option value ...?");
+ return TCL_ERROR;
+ }
+
+ tkwin = Tk_CreateWindowFromPath(interp, Tk_MainWindow(interp),
+ Tcl_GetString(objv[1]), NULL);
+ if (tkwin == NULL) {
+ return TCL_ERROR;
+ }
+
+ /*
+ * Create the option table for this widget class. If it has already been
+ * created, the cached pointer will be returned.
+ */
+
+ optionTable = Tk_CreateOptionTable(interp, optionSpecs);
+
+ msgPtr = ckalloc(sizeof(Message));
+ memset(msgPtr, 0, (size_t) sizeof(Message));
+
+ /*
+ * Set values for those fields that don't take a 0 or NULL value.
+ */
+
+ msgPtr->tkwin = tkwin;
+ msgPtr->display = Tk_Display(tkwin);
+ msgPtr->interp = interp;
+ msgPtr->widgetCmd = Tcl_CreateObjCommand(interp,
+ Tk_PathName(msgPtr->tkwin), MessageWidgetObjCmd, msgPtr,
+ MessageCmdDeletedProc);
+ msgPtr->optionTable = optionTable;
+ msgPtr->relief = TK_RELIEF_FLAT;
+ msgPtr->textGC = None;
+ msgPtr->anchor = TK_ANCHOR_CENTER;
+ msgPtr->aspect = 150;
+ msgPtr->justify = TK_JUSTIFY_LEFT;
+ msgPtr->cursor = None;
+
+ Tk_SetClass(msgPtr->tkwin, "Message");
+ Tk_SetClassProcs(msgPtr->tkwin, &messageClass, msgPtr);
+ Tk_CreateEventHandler(msgPtr->tkwin,
+ ExposureMask|StructureNotifyMask|FocusChangeMask,
+ MessageEventProc, msgPtr);
+ if (Tk_InitOptions(interp, (char *)msgPtr, optionTable, tkwin) != TCL_OK) {
+ Tk_DestroyWindow(msgPtr->tkwin);
+ return TCL_ERROR;
+ }
+
+ if (ConfigureMessage(interp, msgPtr, objc-2, objv+2, 0) != TCL_OK) {
+ Tk_DestroyWindow(msgPtr->tkwin);
+ return TCL_ERROR;
+ }
+
+ Tcl_SetObjResult(interp, TkNewWindowObj(msgPtr->tkwin));
+ return TCL_OK;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * MessageWidgetObjCmd --
+ *
+ * This function is invoked to process the Tcl command that corresponds
+ * to a widget managed by this module. See the user documentation for
+ * details on what it does.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * See the user documentation.
+ *
+ *--------------------------------------------------------------
+ */
+
+static int
+MessageWidgetObjCmd(
+ ClientData clientData, /* Information about message widget. */
+ Tcl_Interp *interp, /* Current interpreter. */
+ int objc, /* Number of arguments. */
+ Tcl_Obj *const objv[]) /* Argument strings. */
+{
+ register Message *msgPtr = clientData;
+ static const char *const optionStrings[] = { "cget", "configure", NULL };
+ enum options { MESSAGE_CGET, MESSAGE_CONFIGURE };
+ int index;
+ int result = TCL_OK;
+ Tcl_Obj *objPtr;
+
+ if (objc < 2) {
+ Tcl_WrongNumArgs(interp, 1, objv, "option ?arg ...?");
+ return TCL_ERROR;
+ }
+
+ if (Tcl_GetIndexFromObjStruct(interp, objv[1], optionStrings,
+ sizeof(char *), "option", 0, &index) != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ Tcl_Preserve(msgPtr);
+
+ switch ((enum options) index) {
+ case MESSAGE_CGET:
+ if (objc != 3) {
+ Tcl_WrongNumArgs(interp, 2, objv, "option");
+ result = TCL_ERROR;
+ } else {
+ objPtr = Tk_GetOptionValue(interp, (char *) msgPtr,
+ msgPtr->optionTable, objv[2], msgPtr->tkwin);
+ if (objPtr == NULL) {
+ result = TCL_ERROR;
+ } else {
+ Tcl_SetObjResult(interp, objPtr);
+ result = TCL_OK;
+ }
+ }
+ break;
+ case MESSAGE_CONFIGURE:
+ if (objc <= 3) {
+ objPtr = Tk_GetOptionInfo(interp, (char *) msgPtr,
+ msgPtr->optionTable, (objc == 3) ? objv[2] : NULL,
+ msgPtr->tkwin);
+ if (objPtr == NULL) {
+ result = TCL_ERROR;
+ } else {
+ Tcl_SetObjResult(interp, objPtr);
+ result = TCL_OK;
+ }
+ } else {
+ result = ConfigureMessage(interp, msgPtr, objc-2, objv+2, 0);
+ }
+ break;
+ }
+
+ Tcl_Release(msgPtr);
+ return result;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * DestroyMessage --
+ *
+ * This function is invoked by Tcl_EventuallyFree or Tcl_Release to clean
+ * up the internal structure of a message at a safe time (when no-one is
+ * using it anymore).
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Everything associated with the message is freed up.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+DestroyMessage(
+ char *memPtr) /* Info about message widget. */
+{
+ register Message *msgPtr = (Message *) memPtr;
+
+ msgPtr->flags |= MESSAGE_DELETED;
+
+ Tcl_DeleteCommandFromToken(msgPtr->interp, msgPtr->widgetCmd);
+ if (msgPtr->flags & REDRAW_PENDING) {
+ Tcl_CancelIdleCall(DisplayMessage, msgPtr);
+ }
+
+ /*
+ * Free up all the stuff that requires special handling, then let
+ * Tk_FreeConfigOptions handle all the standard option-related stuff.
+ */
+
+ if (msgPtr->textGC != None) {
+ Tk_FreeGC(msgPtr->display, msgPtr->textGC);
+ }
+ if (msgPtr->textLayout != NULL) {
+ Tk_FreeTextLayout(msgPtr->textLayout);
+ }
+ if (msgPtr->textVarName != NULL) {
+ Tcl_UntraceVar2(msgPtr->interp, msgPtr->textVarName, NULL,
+ TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS,
+ MessageTextVarProc, msgPtr);
+ }
+ Tk_FreeConfigOptions((char *) msgPtr, msgPtr->optionTable, msgPtr->tkwin);
+ msgPtr->tkwin = NULL;
+ ckfree(msgPtr);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ConfigureMessage --
+ *
+ * This function is called to process an argv/argc list, plus the Tk
+ * option database, in order to configure (or reconfigure) a message
+ * widget.
+ *
+ * Results:
+ * The return value is a standard Tcl result. If TCL_ERROR is returned,
+ * then the interp's result contains an error message.
+ *
+ * Side effects:
+ * Configuration information, such as text string, colors, font, etc. get
+ * set for msgPtr; old resources get freed, if there were any.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+ConfigureMessage(
+ Tcl_Interp *interp, /* Used for error reporting. */
+ register Message *msgPtr, /* Information about widget; may or may not
+ * already have values for some fields. */
+ int objc, /* Number of valid entries in argv. */
+ Tcl_Obj *const objv[], /* Arguments. */
+ int flags) /* Flags to pass to Tk_ConfigureWidget. */
+{
+ Tk_SavedOptions savedOptions;
+
+ /*
+ * Eliminate any existing trace on a variable monitored by the message.
+ */
+
+ if (msgPtr->textVarName != NULL) {
+ Tcl_UntraceVar2(interp, msgPtr->textVarName, NULL,
+ TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS,
+ MessageTextVarProc, msgPtr);
+ }
+
+ if (Tk_SetOptions(interp, (char *) msgPtr, msgPtr->optionTable, objc, objv,
+ msgPtr->tkwin, &savedOptions, NULL) != TCL_OK) {
+ Tk_RestoreSavedOptions(&savedOptions);
+ return TCL_ERROR;
+ }
+
+ /*
+ * If the message is to display the value of a variable, then set up a
+ * trace on the variable's value, create the variable if it doesn't exist,
+ * and fetch its current value.
+ */
+
+ if (msgPtr->textVarName != NULL) {
+ const char *value;
+
+ value = Tcl_GetVar2(interp, msgPtr->textVarName, NULL, TCL_GLOBAL_ONLY);
+ if (value == NULL) {
+ Tcl_SetVar2(interp, msgPtr->textVarName, NULL, msgPtr->string,
+ TCL_GLOBAL_ONLY);
+ } else {
+ if (msgPtr->string != NULL) {
+ ckfree(msgPtr->string);
+ }
+ msgPtr->string = strcpy(ckalloc(strlen(value) + 1), value);
+ }
+ Tcl_TraceVar2(interp, msgPtr->textVarName, NULL,
+ TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS,
+ MessageTextVarProc, msgPtr);
+ }
+
+ /*
+ * A few other options need special processing, such as setting the
+ * background from a 3-D border or handling special defaults that couldn't
+ * be specified to Tk_ConfigureWidget.
+ */
+
+ msgPtr->numChars = Tcl_NumUtfChars(msgPtr->string, -1);
+
+ if (msgPtr->highlightWidth < 0) {
+ msgPtr->highlightWidth = 0;
+ }
+
+ Tk_FreeSavedOptions(&savedOptions);
+ MessageWorldChanged(msgPtr);
+ return TCL_OK;
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * MessageWorldChanged --
+ *
+ * This function is called when the world has changed in some way and the
+ * widget needs to recompute all its graphics contexts and determine its
+ * new geometry.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Message will be relayed out and redisplayed.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+static void
+MessageWorldChanged(
+ ClientData instanceData) /* Information about widget. */
+{
+ XGCValues gcValues;
+ GC gc = None;
+ Tk_FontMetrics fm;
+ Message *msgPtr = instanceData;
+
+ if (msgPtr->border != NULL) {
+ Tk_SetBackgroundFromBorder(msgPtr->tkwin, msgPtr->border);
+ }
+
+ gcValues.font = Tk_FontId(msgPtr->tkfont);
+ gcValues.foreground = msgPtr->fgColorPtr->pixel;
+ gc = Tk_GetGC(msgPtr->tkwin, GCForeground | GCFont, &gcValues);
+ if (msgPtr->textGC != None) {
+ Tk_FreeGC(msgPtr->display, msgPtr->textGC);
+ }
+ msgPtr->textGC = gc;
+
+ Tk_GetFontMetrics(msgPtr->tkfont, &fm);
+ if (msgPtr->padX < 0) {
+ msgPtr->padX = fm.ascent / 2;
+ }
+ if (msgPtr->padY == -1) {
+ msgPtr->padY = fm.ascent / 4;
+ }
+
+ /*
+ * Recompute the desired geometry for the window, and arrange for the
+ * window to be redisplayed.
+ */
+
+ ComputeMessageGeometry(msgPtr);
+ if ((msgPtr->tkwin != NULL) && Tk_IsMapped(msgPtr->tkwin)
+ && !(msgPtr->flags & REDRAW_PENDING)) {
+ Tcl_DoWhenIdle(DisplayMessage, msgPtr);
+ msgPtr->flags |= REDRAW_PENDING;
+ }
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * ComputeMessageGeometry --
+ *
+ * Compute the desired geometry for a message window, taking into account
+ * the desired aspect ratio for the window.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Tk_GeometryRequest is called to inform the geometry manager of the
+ * desired geometry for this window.
+ *
+ *--------------------------------------------------------------
+ */
+
+static void
+ComputeMessageGeometry(
+ register Message *msgPtr) /* Information about window. */
+{
+ int width, inc, height;
+ int thisWidth, thisHeight, maxWidth;
+ int aspect, lowerBound, upperBound, inset;
+
+ Tk_FreeTextLayout(msgPtr->textLayout);
+
+ inset = msgPtr->borderWidth + msgPtr->highlightWidth;
+
+ /*
+ * Compute acceptable bounds for the final aspect ratio.
+ */
+
+ aspect = msgPtr->aspect/10;
+ if (aspect < 5) {
+ aspect = 5;
+ }
+ lowerBound = msgPtr->aspect - aspect;
+ upperBound = msgPtr->aspect + aspect;
+
+ /*
+ * Do the computation in multiple passes: start off with a very wide
+ * window, and compute its height. Then change the width and try again.
+ * Reduce the size of the change and iterate until dimensions are found
+ * that approximate the desired aspect ratio. Or, if the user gave an
+ * explicit width then just use that.
+ */
+
+ if (msgPtr->width > 0) {
+ width = msgPtr->width;
+ inc = 0;
+ } else {
+ width = WidthOfScreen(Tk_Screen(msgPtr->tkwin))/2;
+ inc = width/2;
+ }
+
+ for ( ; ; inc /= 2) {
+ msgPtr->textLayout = Tk_ComputeTextLayout(msgPtr->tkfont,
+ msgPtr->string, msgPtr->numChars, width, msgPtr->justify,
+ 0, &thisWidth, &thisHeight);
+ maxWidth = thisWidth + 2 * (inset + msgPtr->padX);
+ height = thisHeight + 2 * (inset + msgPtr->padY);
+
+ if (inc <= 2) {
+ break;
+ }
+ aspect = (100 * maxWidth) / height;
+
+ if (aspect < lowerBound) {
+ width += inc;
+ } else if (aspect > upperBound) {
+ width -= inc;
+ } else {
+ break;
+ }
+ Tk_FreeTextLayout(msgPtr->textLayout);
+ }
+ msgPtr->msgWidth = thisWidth;
+ msgPtr->msgHeight = thisHeight;
+ Tk_GeometryRequest(msgPtr->tkwin, maxWidth, height);
+ Tk_SetInternalBorder(msgPtr->tkwin, inset);
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * DisplayMessage --
+ *
+ * This function redraws the contents of a message window.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Information appears on the screen.
+ *
+ *--------------------------------------------------------------
+ */
+
+static void
+DisplayMessage(
+ ClientData clientData) /* Information about window. */
+{
+ register Message *msgPtr = clientData;
+ register Tk_Window tkwin = msgPtr->tkwin;
+ int x, y;
+ int borderWidth = msgPtr->highlightWidth;
+
+ msgPtr->flags &= ~REDRAW_PENDING;
+ if ((msgPtr->tkwin == NULL) || !Tk_IsMapped(tkwin)) {
+ return;
+ }
+ if (msgPtr->border != NULL) {
+ borderWidth += msgPtr->borderWidth;
+ }
+ if (msgPtr->relief == TK_RELIEF_FLAT) {
+ borderWidth = msgPtr->highlightWidth;
+ }
+ Tk_Fill3DRectangle(tkwin, Tk_WindowId(tkwin), msgPtr->border,
+ borderWidth, borderWidth,
+ Tk_Width(tkwin) - 2 * borderWidth,
+ Tk_Height(tkwin) - 2 * borderWidth,
+ 0, TK_RELIEF_FLAT);
+
+ /*
+ * Compute starting y-location for message based on message size and
+ * anchor option.
+ */
+
+ TkComputeAnchor(msgPtr->anchor, tkwin, msgPtr->padX, msgPtr->padY,
+ msgPtr->msgWidth, msgPtr->msgHeight, &x, &y);
+ Tk_DrawTextLayout(Tk_Display(tkwin), Tk_WindowId(tkwin), msgPtr->textGC,
+ msgPtr->textLayout, x, y, 0, -1);
+
+ if (borderWidth > msgPtr->highlightWidth) {
+ Tk_Draw3DRectangle(tkwin, Tk_WindowId(tkwin), msgPtr->border,
+ msgPtr->highlightWidth, msgPtr->highlightWidth,
+ Tk_Width(tkwin) - 2*msgPtr->highlightWidth,
+ Tk_Height(tkwin) - 2*msgPtr->highlightWidth,
+ msgPtr->borderWidth, msgPtr->relief);
+ }
+ if (msgPtr->highlightWidth != 0) {
+ GC fgGC, bgGC;
+
+ bgGC = Tk_GCForColor(msgPtr->highlightBgColorPtr, Tk_WindowId(tkwin));
+ if (msgPtr->flags & GOT_FOCUS) {
+ fgGC = Tk_GCForColor(msgPtr->highlightColorPtr,Tk_WindowId(tkwin));
+ TkpDrawHighlightBorder(tkwin, fgGC, bgGC, msgPtr->highlightWidth,
+ Tk_WindowId(tkwin));
+ } else {
+ TkpDrawHighlightBorder(tkwin, bgGC, bgGC, msgPtr->highlightWidth,
+ Tk_WindowId(tkwin));
+ }
+ }
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * MessageEventProc --
+ *
+ * This function is invoked by the Tk dispatcher for various events on
+ * messages.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * When the window gets deleted, internal structures get cleaned up.
+ * When it gets exposed, it is redisplayed.
+ *
+ *--------------------------------------------------------------
+ */
+
+static void
+MessageEventProc(
+ ClientData clientData, /* Information about window. */
+ XEvent *eventPtr) /* Information about event. */
+{
+ Message *msgPtr = clientData;
+
+ if (((eventPtr->type == Expose) && (eventPtr->xexpose.count == 0))
+ || (eventPtr->type == ConfigureNotify)) {
+ goto redraw;
+ } else if (eventPtr->type == DestroyNotify) {
+ DestroyMessage(clientData);
+ } else if (eventPtr->type == FocusIn) {
+ if (eventPtr->xfocus.detail != NotifyInferior) {
+ msgPtr->flags |= GOT_FOCUS;
+ if (msgPtr->highlightWidth > 0) {
+ goto redraw;
+ }
+ }
+ } else if (eventPtr->type == FocusOut) {
+ if (eventPtr->xfocus.detail != NotifyInferior) {
+ msgPtr->flags &= ~GOT_FOCUS;
+ if (msgPtr->highlightWidth > 0) {
+ goto redraw;
+ }
+ }
+ }
+ return;
+
+ redraw:
+ if ((msgPtr->tkwin != NULL) && !(msgPtr->flags & REDRAW_PENDING)) {
+ Tcl_DoWhenIdle(DisplayMessage, msgPtr);
+ msgPtr->flags |= REDRAW_PENDING;
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * MessageCmdDeletedProc --
+ *
+ * This function is invoked when a widget command is deleted. If the
+ * widget isn't already in the process of being destroyed, this command
+ * destroys it.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The widget is destroyed.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+MessageCmdDeletedProc(
+ ClientData clientData) /* Pointer to widget record for widget. */
+{
+ Message *msgPtr = clientData;
+
+ /*
+ * This function 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 function destroys the
+ * widget.
+ */
+
+ if (!(msgPtr->flags & MESSAGE_DELETED)) {
+ Tk_DestroyWindow(msgPtr->tkwin);
+ }
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * MessageTextVarProc --
+ *
+ * This function is invoked when someone changes the variable whose
+ * contents are to be displayed in a message.
+ *
+ * Results:
+ * NULL is always returned.
+ *
+ * Side effects:
+ * The text displayed in the message will change to match the variable.
+ *
+ *--------------------------------------------------------------
+ */
+
+ /* ARGSUSED */
+static char *
+MessageTextVarProc(
+ ClientData clientData, /* Information about message. */
+ Tcl_Interp *interp, /* Interpreter containing variable. */
+ const char *name1, /* Name of variable. */
+ const char *name2, /* Second part of variable name. */
+ int flags) /* Information about what happened. */
+{
+ register Message *msgPtr = clientData;
+ const char *value;
+
+ /*
+ * If the variable is unset, then immediately recreate it unless the whole
+ * interpreter is going away.
+ */
+
+ if (flags & TCL_TRACE_UNSETS) {
+ if ((flags & TCL_TRACE_DESTROYED) && !(flags & TCL_INTERP_DESTROYED)) {
+ Tcl_SetVar2(interp, msgPtr->textVarName, NULL, msgPtr->string,
+ TCL_GLOBAL_ONLY);
+ Tcl_TraceVar2(interp, msgPtr->textVarName, NULL,
+ TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS,
+ MessageTextVarProc, clientData);
+ }
+ return NULL;
+ }
+
+ value = Tcl_GetVar2(interp, msgPtr->textVarName, NULL, TCL_GLOBAL_ONLY);
+ if (value == NULL) {
+ value = "";
+ }
+ if (msgPtr->string != NULL) {
+ ckfree(msgPtr->string);
+ }
+ msgPtr->numChars = Tcl_NumUtfChars(value, -1);
+ msgPtr->string = ckalloc(strlen(value) + 1);
+ strcpy(msgPtr->string, value);
+ ComputeMessageGeometry(msgPtr);
+
+ if ((msgPtr->tkwin != NULL) && Tk_IsMapped(msgPtr->tkwin)
+ && !(msgPtr->flags & REDRAW_PENDING)) {
+ Tcl_DoWhenIdle(DisplayMessage, msgPtr);
+ msgPtr->flags |= REDRAW_PENDING;
+ }
+ return NULL;
+}
+
+/*
+ * Local Variables:
+ * mode: c
+ * c-basic-offset: 4
+ * fill-column: 78
+ * End:
+ */
diff --git a/tk8.6/generic/tkObj.c b/tk8.6/generic/tkObj.c
new file mode 100644
index 0000000..7c09656
--- /dev/null
+++ b/tk8.6/generic/tkObj.c
@@ -0,0 +1,1142 @@
+/*
+ * tkObj.c --
+ *
+ * This file contains functions 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.
+ */
+
+#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 = INT2PTR(intval); \
+ (objPtr)->internalRep.twoPtrValue.ptr2 = 0
+
+#define GET_SIMPLEPIXEL(objPtr) \
+ (PTR2INT((objPtr)->internalRep.twoPtrValue.ptr1))
+
+#define SET_COMPLEXPIXEL(objPtr, repPtr) \
+ (objPtr)->internalRep.twoPtrValue.ptr1 = NULL; \
+ (objPtr)->internalRep.twoPtrValue.ptr2 = repPtr
+
+#define GET_COMPLEXPIXEL(objPtr) \
+ ((PixelRep *) (objPtr)->internalRep.twoPtrValue.ptr2)
+
+/*
+ * One of these structures is created per thread to store thread-specific
+ * data. In this case, it is used to contain references to selected
+ * Tcl_ObjTypes that we can use as screen distances without conversion. The
+ * "dataKey" below is used to locate the ThreadSpecificData for the current
+ * thread.
+ */
+
+typedef struct ThreadSpecificData {
+ const Tcl_ObjType *doubleTypePtr;
+ const Tcl_ObjType *intTypePtr;
+} ThreadSpecificData;
+static Tcl_ThreadDataKey dataKey;
+
+/*
+ * The following structure is the internal representation for mm objects.
+ */
+
+typedef struct MMRep {
+ double value;
+ int units;
+ Tk_Window tkwin;
+ double returnValue;
+} MMRep;
+
+/*
+ * The following structure is the internal representation for window objects.
+ * A WindowRep caches name-to-window lookups. The cache is invalid if tkwin is
+ * NULL or if mainPtr->deletionEpoch does not match epoch.
+ */
+
+typedef struct WindowRep {
+ Tk_Window tkwin; /* Cached window; NULL if not found. */
+ TkMainInfo *mainPtr; /* MainWindow associated with tkwin. */
+ long epoch; /* Value of mainPtr->deletionEpoch at last
+ * successful lookup. */
+} WindowRep;
+
+/*
+ * Prototypes for functions defined later in this file:
+ */
+
+static void DupMMInternalRep(Tcl_Obj *srcPtr, Tcl_Obj *copyPtr);
+static void DupPixelInternalRep(Tcl_Obj *srcPtr, Tcl_Obj*copyPtr);
+static void DupWindowInternalRep(Tcl_Obj *srcPtr,Tcl_Obj*copyPtr);
+static void FreeMMInternalRep(Tcl_Obj *objPtr);
+static void FreePixelInternalRep(Tcl_Obj *objPtr);
+static void FreeWindowInternalRep(Tcl_Obj *objPtr);
+static ThreadSpecificData *GetTypeCache(void);
+static void UpdateStringOfMM(Tcl_Obj *objPtr);
+static int SetMMFromAny(Tcl_Interp *interp, Tcl_Obj *objPtr);
+static int SetPixelFromAny(Tcl_Interp *interp, Tcl_Obj *objPtr);
+static int SetWindowFromAny(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 const 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 const Tcl_ObjType mmObjType = {
+ "mm", /* name */
+ FreeMMInternalRep, /* freeIntRepProc */
+ DupMMInternalRep, /* dupIntRepProc */
+ UpdateStringOfMM, /* updateStringProc */
+ SetMMFromAny /* setFromAnyProc */
+};
+
+/*
+ * The following structure defines the implementation of the "window"
+ * Tcl object.
+ */
+
+static const Tcl_ObjType windowObjType = {
+ "window", /* name */
+ FreeWindowInternalRep, /* freeIntRepProc */
+ DupWindowInternalRep, /* dupIntRepProc */
+ NULL, /* updateStringProc */
+ SetWindowFromAny /* setFromAnyProc */
+};
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * GetTypeCache --
+ *
+ * Get (and build if necessary) the cache of useful Tcl object types for
+ * comparisons in the conversion functions. This allows optimized checks
+ * for standard cases.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static ThreadSpecificData *
+GetTypeCache(void)
+{
+ ThreadSpecificData *tsdPtr =
+ Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
+
+ if (tsdPtr->doubleTypePtr == NULL) {
+ tsdPtr->doubleTypePtr = Tcl_GetObjType("double");
+ tsdPtr->intTypePtr = Tcl_GetObjType("int");
+ }
+ return tsdPtr;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * GetPixelsFromObjEx --
+ *
+ * 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.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static
+int
+GetPixelsFromObjEx(
+ 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,
+ double *dblPtr) /* Places to store resulting pixels. */
+{
+ int result, fresh;
+ double d;
+ PixelRep *pixelPtr;
+ static const double bias[] = {
+ 1.0, 10.0, 25.4, 0.35278 /*25.4 / 72.0*/
+ };
+
+ /*
+ * Special hacks where the type of the object is known to be something
+ * that is just numeric and cannot require distance conversion. This pokes
+ * holes in Tcl's abstractions, but they are just for optimization, not
+ * semantics.
+ */
+
+ if (objPtr->typePtr != &pixelObjType) {
+ ThreadSpecificData *typeCache = GetTypeCache();
+
+ if (objPtr->typePtr == typeCache->doubleTypePtr) {
+ (void) Tcl_GetDoubleFromObj(interp, objPtr, &d);
+ if (dblPtr != NULL) {
+ *dblPtr = d;
+ }
+ *intPtr = (int) (d<0 ? d-0.5 : d+0.5);
+ return TCL_OK;
+ } else if (objPtr->typePtr == typeCache->intTypePtr) {
+ (void) Tcl_GetIntFromObj(interp, objPtr, intPtr);
+ if (dblPtr) {
+ *dblPtr = (double) (*intPtr);
+ }
+ return TCL_OK;
+ }
+ }
+
+ retry:
+ fresh = (objPtr->typePtr != &pixelObjType);
+ if (fresh) {
+ result = SetPixelFromAny(interp, objPtr);
+ if (result != TCL_OK) {
+ return result;
+ }
+ }
+
+ if (SIMPLE_PIXELREP(objPtr)) {
+ *intPtr = GET_SIMPLEPIXEL(objPtr);
+ if (dblPtr) {
+ *dblPtr = (double) (*intPtr);
+ }
+ } else {
+ pixelPtr = GET_COMPLEXPIXEL(objPtr);
+ if ((!fresh) && (pixelPtr->tkwin != tkwin)) {
+ /*
+ * In the case of exo-screen conversions of non-pixels, we force a
+ * recomputation from the string.
+ */
+
+ FreePixelInternalRep(objPtr);
+ goto retry;
+ }
+ if ((pixelPtr->tkwin != tkwin) || dblPtr) {
+ d = pixelPtr->value;
+ if (pixelPtr->units >= 0) {
+ d *= bias[pixelPtr->units] * WidthOfScreen(Tk_Screen(tkwin));
+ d /= WidthMMOfScreen(Tk_Screen(tkwin));
+ }
+ pixelPtr->returnValue = (int) (d<0 ? d-0.5 : d+0.5);
+ pixelPtr->tkwin = tkwin;
+ if (dblPtr) {
+ *dblPtr = d;
+ }
+ }
+ *intPtr = pixelPtr->returnValue;
+ }
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * 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(
+ 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. */
+{
+ return GetPixelsFromObjEx(interp, tkwin, objPtr, intPtr, NULL);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_GetDoublePixelsFromObj --
+ *
+ * Attempt to return a double 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, the internal unit being pixels.
+ *
+ * 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_GetDoublePixelsFromObj(
+ Tcl_Interp *interp, /* Used for error reporting if not NULL. */
+ Tk_Window tkwin,
+ Tcl_Obj *objPtr, /* The object from which to get pixels. */
+ double *doublePtr) /* Place to store resulting pixels. */
+{
+ double d;
+ int result, val;
+
+ result = GetPixelsFromObjEx(interp, tkwin, objPtr, &val, &d);
+ if (result != TCL_OK) {
+ return result;
+ }
+ if (objPtr->typePtr == &pixelObjType && !SIMPLE_PIXELREP(objPtr)) {
+ PixelRep *pixelPtr = GET_COMPLEXPIXEL(objPtr);
+
+ if (pixelPtr->units >= 0) {
+ /*
+ * Internally "shimmer" to pixel units.
+ */
+
+ pixelPtr->units = -1;
+ pixelPtr->value = d;
+ }
+ }
+ *doublePtr = d;
+ 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(
+ Tcl_Obj *objPtr) /* Pixel object with internal rep to free. */
+{
+ if (!SIMPLE_PIXELREP(objPtr)) {
+ PixelRep *pixelPtr = GET_COMPLEXPIXEL(objPtr);
+
+ ckfree(pixelPtr);
+ }
+ SET_SIMPLEPIXEL(objPtr, 0);
+ objPtr->typePtr = NULL;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * 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(
+ register Tcl_Obj *srcPtr, /* Object with internal rep to copy. */
+ register Tcl_Obj *copyPtr) /* Object with internal rep to set. */
+{
+ copyPtr->typePtr = srcPtr->typePtr;
+
+ if (SIMPLE_PIXELREP(srcPtr)) {
+ SET_SIMPLEPIXEL(copyPtr, GET_SIMPLEPIXEL(srcPtr));
+ } else {
+ PixelRep *oldPtr, *newPtr;
+
+ oldPtr = GET_COMPLEXPIXEL(srcPtr);
+ newPtr = 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(
+ Tcl_Interp *interp, /* Used for error reporting if not NULL. */
+ Tcl_Obj *objPtr) /* The object to convert. */
+{
+ const Tcl_ObjType *typePtr;
+ const char *string;
+ char *rest;
+ double d;
+ int i, units;
+
+ string = Tcl_GetString(objPtr);
+
+ d = strtod(string, &rest);
+ if (rest == string) {
+ goto 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 {
+ PixelRep *pixelPtr = ckalloc(sizeof(PixelRep));
+
+ pixelPtr->value = d;
+ pixelPtr->units = units;
+ pixelPtr->tkwin = NULL;
+ pixelPtr->returnValue = i;
+ SET_COMPLEXPIXEL(objPtr, pixelPtr);
+ }
+ return TCL_OK;
+
+ error:
+ if (interp != NULL) {
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "bad screen distance \"%.50s\"", string));
+ Tcl_SetErrorCode(interp, "TK", "VALUE", "PIXELS", NULL);
+ }
+ return TCL_ERROR;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * 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(
+ 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 const double bias[] = {
+ 10.0, 25.4, 1.0, 0.35278 /*25.4 / 72.0*/
+ };
+
+ if (objPtr->typePtr != &mmObjType) {
+ result = SetMMFromAny(interp, objPtr);
+ if (result != TCL_OK) {
+ return result;
+ }
+ }
+
+ mmPtr = objPtr->internalRep.twoPtrValue.ptr1;
+ 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(
+ Tcl_Obj *objPtr) /* MM object with internal rep to free. */
+{
+ ckfree(objPtr->internalRep.twoPtrValue.ptr1);
+ objPtr->internalRep.twoPtrValue.ptr1 = NULL;
+ objPtr->typePtr = 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(
+ 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 = srcPtr->internalRep.twoPtrValue.ptr1;
+ newPtr = ckalloc(sizeof(MMRep));
+ newPtr->value = oldPtr->value;
+ newPtr->units = oldPtr->units;
+ newPtr->tkwin = oldPtr->tkwin;
+ newPtr->returnValue = oldPtr->returnValue;
+ copyPtr->internalRep.twoPtrValue.ptr1 = newPtr;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * UpdateStringOfMM --
+ *
+ * Update the string representation for a pixel Tcl_Obj this function is
+ * only called, if the pixel Tcl_Obj has no unit, because with units the
+ * string representation is created by SetMMFromAny
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The object's string is set to a valid string that results from the
+ * double-to-string conversion.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+UpdateStringOfMM(
+ register Tcl_Obj *objPtr) /* pixel obj with string rep to update. */
+{
+ MMRep *mmPtr;
+ char buffer[TCL_DOUBLE_SPACE];
+ register int len;
+
+ mmPtr = objPtr->internalRep.twoPtrValue.ptr1;
+ /* assert( mmPtr->units == -1 && objPtr->bytes == NULL ); */
+ if ((mmPtr->units != -1) || (objPtr->bytes != NULL)) {
+ Tcl_Panic("UpdateStringOfMM: false precondition");
+ }
+
+ Tcl_PrintDouble(NULL, mmPtr->value, buffer);
+ len = (int)strlen(buffer);
+
+ objPtr->bytes = ckalloc(len + 1);
+ strcpy(objPtr->bytes, buffer);
+ objPtr->length = len;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * SetMMFromAny --
+ *
+ * Attempt to generate a mm internal form for the Tcl object "objPtr".
+ *
+ * Results:
+ * The return value is a standard Tcl result. If an error occurs during
+ * conversion, an error message is left in the interpreter's result
+ * unless "interp" is NULL.
+ *
+ * Side effects:
+ * If no error occurs, a mm representation of the object is stored
+ * internally and the type of "objPtr" is set to mm.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+SetMMFromAny(
+ Tcl_Interp *interp, /* Used for error reporting if not NULL. */
+ Tcl_Obj *objPtr) /* The object to convert. */
+{
+ ThreadSpecificData *typeCache = GetTypeCache();
+ const Tcl_ObjType *typePtr;
+ const char *string;
+ char *rest;
+ double d;
+ int units;
+ MMRep *mmPtr;
+
+ if (objPtr->typePtr == typeCache->doubleTypePtr) {
+ Tcl_GetDoubleFromObj(interp, objPtr, &d);
+ units = -1;
+ } else if (objPtr->typePtr == typeCache->intTypePtr) {
+ Tcl_GetIntFromObj(interp, objPtr, &units);
+ d = (double) units;
+ units = -1;
+
+ /*
+ * In the case of ints, we need to ensure that a valid string exists
+ * in order for int-but-not-string objects to be converted back to
+ * ints again from mm obj types.
+ */
+
+ (void) Tcl_GetString(objPtr);
+ } else {
+ /*
+ * It wasn't a known int or double, so parse it.
+ */
+
+ string = Tcl_GetString(objPtr);
+
+ 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_SetObjResult(interp, Tcl_ObjPrintf(
+ "bad screen distance \"%s\"", string));
+ Tcl_SetErrorCode(interp, "TK", "VALUE", "DISTANCE", 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 = ckalloc(sizeof(MMRep));
+ mmPtr->value = d;
+ mmPtr->units = units;
+ mmPtr->tkwin = NULL;
+ mmPtr->returnValue = d;
+
+ objPtr->internalRep.twoPtrValue.ptr1 = 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(
+ Tcl_Interp *interp, /* Used for error reporting if not NULL. */
+ Tk_Window tkwin, /* A token to get the main window from. */
+ Tcl_Obj *objPtr, /* The object from which to get window. */
+ Tk_Window *windowPtr) /* Place to store resulting window. */
+{
+ TkMainInfo *mainPtr = ((TkWindow *) tkwin)->mainPtr;
+ register WindowRep *winPtr;
+
+ if (objPtr->typePtr != &windowObjType) {
+ int result = SetWindowFromAny(interp, objPtr);
+ if (result != TCL_OK) {
+ return result;
+ }
+ }
+
+ winPtr = objPtr->internalRep.twoPtrValue.ptr1;
+ if (winPtr->tkwin == NULL
+ || winPtr->mainPtr == NULL
+ || winPtr->mainPtr != mainPtr
+ || winPtr->epoch != mainPtr->deletionEpoch) {
+ /*
+ * Cache is invalid.
+ */
+
+ winPtr->tkwin = Tk_NameToWindow(interp,
+ Tcl_GetString(objPtr), tkwin);
+ if (winPtr->tkwin == NULL) {
+ /* ASSERT: Tk_NameToWindow has left error message in interp */
+ return TCL_ERROR;
+ }
+
+ winPtr->mainPtr = mainPtr;
+ winPtr->epoch = mainPtr ? mainPtr->deletionEpoch : 0;
+ }
+
+ *windowPtr = winPtr->tkwin;
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * SetWindowFromAny --
+ *
+ * Generate a windowObj internal form for the Tcl object "objPtr".
+ *
+ * Results:
+ * Always returns TCL_OK.
+ *
+ * Side effects:
+ * Sets objPtr's internal representation to an uninitialized windowObj.
+ * Frees the old internal representation, if any.
+ *
+ * See also:
+ * TkGetWindowFromObj, which initializes the WindowRep cache.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+SetWindowFromAny(
+ Tcl_Interp *interp, /* Used for error reporting if not NULL. */
+ register Tcl_Obj *objPtr) /* The object to convert. */
+{
+ const Tcl_ObjType *typePtr;
+ WindowRep *winPtr;
+
+ /*
+ * Free the old internalRep before setting the new one.
+ */
+
+ (void)Tcl_GetString(objPtr);
+ typePtr = objPtr->typePtr;
+ if ((typePtr != NULL) && (typePtr->freeIntRepProc != NULL)) {
+ typePtr->freeIntRepProc(objPtr);
+ }
+
+ winPtr = ckalloc(sizeof(WindowRep));
+ winPtr->tkwin = NULL;
+ winPtr->mainPtr = NULL;
+ winPtr->epoch = 0;
+
+ objPtr->internalRep.twoPtrValue.ptr1 = winPtr;
+ objPtr->typePtr = &windowObjType;
+
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * DupWindowInternalRep --
+ *
+ * Initialize the internal representation of a window Tcl_Obj to a copy
+ * of the internal representation of an existing window object.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * copyPtr's internal rep is set to refer to the same window as srcPtr's
+ * internal rep.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+DupWindowInternalRep(
+ register Tcl_Obj *srcPtr,
+ register Tcl_Obj *copyPtr)
+{
+ register WindowRep *oldPtr, *newPtr;
+
+ oldPtr = srcPtr->internalRep.twoPtrValue.ptr1;
+ newPtr = ckalloc(sizeof(WindowRep));
+ newPtr->tkwin = oldPtr->tkwin;
+ newPtr->mainPtr = oldPtr->mainPtr;
+ newPtr->epoch = oldPtr->epoch;
+ copyPtr->internalRep.twoPtrValue.ptr1 = newPtr;
+ copyPtr->typePtr = srcPtr->typePtr;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * FreeWindowInternalRep --
+ *
+ * Deallocate the storage associated with a window object's internal
+ * representation.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Frees objPtr's internal representation and sets objPtr's internalRep
+ * to NULL.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+FreeWindowInternalRep(
+ Tcl_Obj *objPtr) /* Window object with internal rep to free. */
+{
+ ckfree(objPtr->internalRep.twoPtrValue.ptr1);
+ objPtr->internalRep.twoPtrValue.ptr1 = NULL;
+ objPtr->typePtr = NULL;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkNewWindowObj --
+ *
+ * This function allocates a new Tcl_Obj that refers to a particular to a
+ * particular Tk window.
+ *
+ * Results:
+ * A standard Tcl object reference, with refcount 0.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+Tcl_Obj *
+TkNewWindowObj(
+ Tk_Window tkwin)
+{
+ Tcl_Obj *objPtr = Tcl_NewStringObj(Tk_PathName(tkwin), -1);
+ TkMainInfo *mainPtr = ((TkWindow *) tkwin)->mainPtr;
+ register WindowRep *winPtr;
+
+ SetWindowFromAny(NULL, objPtr);
+
+ winPtr = objPtr->internalRep.twoPtrValue.ptr1;
+ winPtr->tkwin = tkwin;
+ winPtr->mainPtr = mainPtr;
+ winPtr->epoch = mainPtr->deletionEpoch;
+ return objPtr;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkParsePadAmount --
+ *
+ * This function parses a padding specification and returns the
+ * appropriate padding values. A padding specification can be either a
+ * single pixel width, or a list of two pixel widths. If a single pixel
+ * width, the amount specified is used for padding on both sides. If two
+ * amounts are specified, then they specify the left/right or top/bottom
+ * padding.
+ *
+ * Results:
+ * A standard Tcl return value.
+ *
+ * Side effects:
+ * An error message is written to the interpreter if something is not
+ * right.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TkParsePadAmount(
+ Tcl_Interp *interp, /* Interpreter for error reporting. */
+ Tk_Window tkwin, /* A window. Needed by Tk_GetPixels() */
+ Tcl_Obj *specObj, /* The argument to "-padx", "-pady", "-ipadx",
+ * or "-ipady". The thing to be parsed. */
+ int *halfPtr, /* Write the left/top part of padding here */
+ int *allPtr) /* Write the total padding here */
+{
+ int firstInt, secondInt; /* The two components of the padding */
+ int objc; /* The length of the list (should be 1 or 2) */
+ Tcl_Obj **objv; /* The objects in the list */
+
+ /*
+ * Check for a common case where a single object would otherwise be
+ * shimmered between a list and a pixel spec.
+ */
+
+ if (specObj->typePtr == &pixelObjType) {
+ if (Tk_GetPixelsFromObj(interp, tkwin, specObj, &firstInt) != TCL_OK){
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "bad pad value \"%s\": must be positive screen distance",
+ Tcl_GetString(specObj)));
+ Tcl_SetErrorCode(interp, "TK", "VALUE", "PADDING", "DIST", NULL);
+ return TCL_ERROR;
+ }
+ secondInt = firstInt;
+ goto done;
+ }
+
+ /*
+ * Pad specifications are a list of one or two elements, each of which is
+ * a pixel specification.
+ */
+
+ if (Tcl_ListObjGetElements(interp, specObj, &objc, &objv) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (objc != 1 && objc != 2) {
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "wrong number of parts to pad specification", -1));
+ Tcl_SetErrorCode(interp, "TK", "VALUE", "PADDING", "PARTS", NULL);
+ return TCL_ERROR;
+ }
+
+ /*
+ * Parse the first part.
+ */
+
+ if (Tk_GetPixelsFromObj(interp, tkwin, objv[0], &firstInt) != TCL_OK ||
+ (firstInt < 0)) {
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "bad pad value \"%s\": must be positive screen distance",
+ Tcl_GetString(objv[0])));
+ Tcl_SetErrorCode(interp, "TK", "VALUE", "PADDING", "DIST", NULL);
+ return TCL_ERROR;
+ }
+
+ /*
+ * Parse the second part if it exists, otherwise it is as if it was the
+ * same as the first part.
+ */
+
+ if (objc == 1) {
+ secondInt = firstInt;
+ } else if (Tk_GetPixelsFromObj(interp, tkwin, objv[1],
+ &secondInt) != TCL_OK || (secondInt < 0)) {
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "bad 2nd pad value \"%s\": must be positive screen distance",
+ Tcl_GetString(objv[1])));
+ Tcl_SetErrorCode(interp, "TK", "VALUE", "PADDING", "DIST", NULL);
+ return TCL_ERROR;
+ }
+
+ /*
+ * Write the parsed bits back into the receiving variables.
+ */
+
+ done:
+ if (halfPtr != 0) {
+ *halfPtr = firstInt;
+ }
+ *allPtr = firstInt + secondInt;
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkRegisterObjTypes --
+ *
+ * Registers Tk's Tcl_ObjType structures with the Tcl run-time.
+ *
+ * Results:
+ * None
+ *
+ * Side effects:
+ * All instances of Tcl_ObjType structues used in Tk are registered with
+ * Tcl.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TkRegisterObjTypes(void)
+{
+ Tcl_RegisterObjType(&tkBorderObjType);
+ Tcl_RegisterObjType(&tkBitmapObjType);
+ Tcl_RegisterObjType(&tkColorObjType);
+ Tcl_RegisterObjType(&tkCursorObjType);
+ Tcl_RegisterObjType(&tkFontObjType);
+ Tcl_RegisterObjType(&mmObjType);
+ Tcl_RegisterObjType(&pixelObjType);
+ Tcl_RegisterObjType(&tkStateKeyObjType);
+ Tcl_RegisterObjType(&windowObjType);
+ Tcl_RegisterObjType(&tkTextIndexType);
+}
+
+/*
+ * Local Variables:
+ * mode: c
+ * c-basic-offset: 4
+ * fill-column: 78
+ * End:
+ */
diff --git a/tk8.6/generic/tkOldConfig.c b/tk8.6/generic/tkOldConfig.c
new file mode 100644
index 0000000..920d93e
--- /dev/null
+++ b/tk8.6/generic/tkOldConfig.c
@@ -0,0 +1,1184 @@
+/*
+ * tkOldConfig.c --
+ *
+ * This file contains the Tk_ConfigureWidget function. 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.
+ */
+
+#include "tkInt.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 functions defined later in this file:
+ */
+
+static int DoConfig(Tcl_Interp *interp, Tk_Window tkwin,
+ Tk_ConfigSpec *specPtr, Tk_Uid value,
+ int valueIsUid, char *widgRec);
+static Tk_ConfigSpec * FindConfigSpec(Tcl_Interp *interp,
+ Tk_ConfigSpec *specs, const char *argvName,
+ int needFlags, int hateFlags);
+static char * FormatConfigInfo(Tcl_Interp *interp, Tk_Window tkwin,
+ const Tk_ConfigSpec *specPtr, char *widgRec);
+static const char * FormatConfigValue(Tcl_Interp *interp, Tk_Window tkwin,
+ const Tk_ConfigSpec *specPtr, char *widgRec,
+ char *buffer, Tcl_FreeProc **freeProcPtr);
+static Tk_ConfigSpec * GetCachedSpecs(Tcl_Interp *interp,
+ const Tk_ConfigSpec *staticSpecs);
+static void DeleteSpecCacheTable(ClientData clientData,
+ Tcl_Interp *interp);
+
+/*
+ *--------------------------------------------------------------
+ *
+ * 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. A copy of the spec-table is taken with (some of) the char*
+ * fields converted into Tk_Uid fields; this copy will be released when
+ * the interpreter terminates.
+ *
+ *--------------------------------------------------------------
+ */
+
+int
+Tk_ConfigureWidget(
+ Tcl_Interp *interp, /* Interpreter for error reporting. */
+ Tk_Window tkwin, /* Window containing widget (needed to set up
+ * X resources). */
+ const Tk_ConfigSpec *specs, /* Describes legal options. */
+ int argc, /* Number of elements in argv. */
+ const char **argv, /* Command-line options. */
+ char *widgRec, /* Record whose fields are to be modified.
+ * Values must be properly initialized. */
+ int flags) /* Used to specify additional flags that must
+ * be present in config specs for them to be
+ * considered. Also, may have
+ * TK_CONFIG_ARGV_ONLY set. */
+{
+ register Tk_ConfigSpec *specPtr, *staticSpecs;
+ 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_SetObjResult(interp, Tcl_NewStringObj("NULL main window", -1));
+ Tcl_SetErrorCode(interp, "TK", "NO_MAIN_WINDOW", 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;
+ }
+
+ /*
+ * Get the build of the config for this interpreter.
+ */
+
+ staticSpecs = GetCachedSpecs(interp, specs);
+
+ for (specPtr = staticSpecs; specPtr->type != TK_CONFIG_END; specPtr++) {
+ specPtr->specFlags &= ~TK_CONFIG_OPTION_SPECIFIED;
+ }
+
+ /*
+ * Pass one: scan through all of the arguments, processing those that
+ * match entries in the specs.
+ */
+
+ for ( ; argc > 0; argc -= 2, argv += 2) {
+ const char *arg;
+
+ if (flags & TK_CONFIG_OBJS) {
+ arg = Tcl_GetString((Tcl_Obj *) *argv);
+ } else {
+ arg = *argv;
+ }
+ specPtr = FindConfigSpec(interp, staticSpecs, arg, needFlags, hateFlags);
+ if (specPtr == NULL) {
+ return TCL_ERROR;
+ }
+
+ /*
+ * Process the entry.
+ */
+
+ if (argc < 2) {
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "value for \"%s\" missing", arg));
+ Tcl_SetErrorCode(interp, "TK", "VALUE_MISSING", 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) {
+ Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf(
+ "\n (processing \"%.40s\" option)",specPtr->argvName));
+ return TCL_ERROR;
+ }
+ if (!(flags & TK_CONFIG_ARGV_ONLY)) {
+ specPtr->specFlags |= TK_CONFIG_OPTION_SPECIFIED;
+ }
+ }
+
+ /*
+ * Pass two: 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 = staticSpecs; 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) {
+ Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf(
+ "\n (%s \"%.50s\" in widget \"%.50s\")",
+ "database entry for", specPtr->dbName,
+ Tk_PathName(tkwin)));
+ 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) {
+ Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf(
+ "\n (%s \"%.50s\" in widget \"%.50s\")",
+ "default value for", specPtr->dbName,
+ Tk_PathName(tkwin)));
+ 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(
+ Tcl_Interp *interp, /* Used for reporting errors. */
+ Tk_ConfigSpec *specs, /* Pointer to table of configuration
+ * specifications for a widget. */
+ const char *argvName, /* Name (suitable for use in a "config"
+ * command) identifying particular option. */
+ int needFlags, /* Flags that must be present in matching
+ * entry. */
+ int hateFlags) /* Flags that must NOT be present in matching
+ * entry. */
+{
+ register Tk_ConfigSpec *specPtr;
+ register char c; /* First character of current argument. */
+ Tk_ConfigSpec *matchPtr; /* Matching spec, or NULL. */
+ size_t length;
+
+ c = argvName[1];
+ length = strlen(argvName);
+ matchPtr = NULL;
+ for (specPtr = specs; specPtr->type != TK_CONFIG_END; specPtr++) {
+ if (specPtr->argvName == NULL) {
+ continue;
+ }
+ if ((specPtr->argvName[1] != c)
+ || (strncmp(specPtr->argvName, argvName, length) != 0)) {
+ continue;
+ }
+ if (((specPtr->specFlags & needFlags) != needFlags)
+ || (specPtr->specFlags & hateFlags)) {
+ continue;
+ }
+ if (specPtr->argvName[length] == 0) {
+ matchPtr = specPtr;
+ goto gotMatch;
+ }
+ if (matchPtr != NULL) {
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "ambiguous option \"%s\"", argvName));
+ Tcl_SetErrorCode(interp, "TK", "LOOKUP", "OPTION", argvName,NULL);
+ return NULL;
+ }
+ matchPtr = specPtr;
+ }
+
+ if (matchPtr == NULL) {
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "unknown option \"%s\"", argvName));
+ Tcl_SetErrorCode(interp, "TK", "LOOKUP", "OPTION", argvName, NULL);
+ return 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_SetObjResult(interp, Tcl_ObjPrintf(
+ "couldn't find synonym for option \"%s\"",
+ argvName));
+ Tcl_SetErrorCode(interp, "TK", "LOOKUP", "OPTION", argvName,
+ NULL);
+ return NULL;
+ }
+ if ((specPtr->dbName == matchPtr->dbName)
+ && (specPtr->type != TK_CONFIG_SYNONYM)
+ && ((specPtr->specFlags & needFlags) == needFlags)
+ && !(specPtr->specFlags & hateFlags)) {
+ break;
+ }
+ }
+ }
+ return specPtr;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * DoConfig --
+ *
+ * This function 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(
+ Tcl_Interp *interp, /* Interpreter for error reporting. */
+ Tk_Window tkwin, /* Window containing widget (needed to set up
+ * X resources). */
+ Tk_ConfigSpec *specPtr, /* Specifier to apply. */
+ Tk_Uid value, /* Value to use to fill in widgRec. */
+ int valueIsUid, /* Non-zero means value is a Tk_Uid; zero
+ * means it's an ordinary string. */
+ char *widgRec) /* Record whose fields are to be modified.
+ * Values must be properly initialized. */
+{
+ char *ptr;
+ Tk_Uid uid;
+ int nullValue;
+
+ nullValue = 0;
+ if ((*value == 0) && (specPtr->specFlags & TK_CONFIG_NULL_OK)) {
+ nullValue = 1;
+ }
+
+ do {
+ ptr = widgRec + specPtr->offset;
+ switch (specPtr->type) {
+ case TK_CONFIG_BOOLEAN:
+ if (Tcl_GetBoolean(interp, value, (int *) ptr) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ break;
+ case TK_CONFIG_INT:
+ if (Tcl_GetInt(interp, value, (int *) ptr) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ break;
+ case TK_CONFIG_DOUBLE:
+ if (Tcl_GetDouble(interp, value, (double *) ptr) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ break;
+ case TK_CONFIG_STRING: {
+ char *oldStr, *newStr;
+
+ if (nullValue) {
+ newStr = NULL;
+ } else {
+ newStr = ckalloc(strlen(value) + 1);
+ strcpy(newStr, value);
+ }
+ oldStr = *((char **) ptr);
+ if (oldStr != NULL) {
+ ckfree(oldStr);
+ }
+ *((char **) ptr) = newStr;
+ 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 newFont;
+
+ if (nullValue) {
+ newFont = NULL;
+ } else {
+ newFont = Tk_GetFont(interp, tkwin, value);
+ if (newFont == NULL) {
+ return TCL_ERROR;
+ }
+ }
+ Tk_FreeFont(*((Tk_Font *) ptr));
+ *((Tk_Font *) ptr) = newFont;
+ break;
+ }
+ case TK_CONFIG_BITMAP: {
+ Pixmap newBmp, oldBmp;
+
+ if (nullValue) {
+ newBmp = None;
+ } else {
+ uid = valueIsUid ? (Tk_Uid) value : Tk_GetUid(value);
+ newBmp = Tk_GetBitmap(interp, tkwin, uid);
+ if (newBmp == None) {
+ return TCL_ERROR;
+ }
+ }
+ oldBmp = *((Pixmap *) ptr);
+ if (oldBmp != None) {
+ Tk_FreeBitmap(Tk_Display(tkwin), oldBmp);
+ }
+ *((Pixmap *) ptr) = newBmp;
+ break;
+ }
+ case TK_CONFIG_BORDER: {
+ Tk_3DBorder newBorder, oldBorder;
+
+ if (nullValue) {
+ newBorder = NULL;
+ } else {
+ uid = valueIsUid ? (Tk_Uid) value : Tk_GetUid(value);
+ newBorder = Tk_Get3DBorder(interp, tkwin, uid);
+ if (newBorder == NULL) {
+ return TCL_ERROR;
+ }
+ }
+ oldBorder = *((Tk_3DBorder *) ptr);
+ if (oldBorder != NULL) {
+ Tk_Free3DBorder(oldBorder);
+ }
+ *((Tk_3DBorder *) ptr) = newBorder;
+ 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 newCursor, oldCursor;
+
+ if (nullValue) {
+ newCursor = None;
+ } else {
+ uid = valueIsUid ? (Tk_Uid) value : Tk_GetUid(value);
+ newCursor = Tk_GetCursor(interp, tkwin, uid);
+ if (newCursor == None) {
+ return TCL_ERROR;
+ }
+ }
+ oldCursor = *((Tk_Cursor *) ptr);
+ if (oldCursor != None) {
+ Tk_FreeCursor(Tk_Display(tkwin), oldCursor);
+ }
+ *((Tk_Cursor *) ptr) = newCursor;
+ if (specPtr->type == TK_CONFIG_ACTIVE_CURSOR) {
+ Tk_DefineCursor(tkwin, newCursor);
+ }
+ 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:
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "bad config table: unknown type %d", specPtr->type));
+ Tcl_SetErrorCode(interp, "TK", "BAD_CONFIG", NULL);
+ 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(
+ Tcl_Interp *interp, /* Interpreter for error reporting. */
+ Tk_Window tkwin, /* Window corresponding to widgRec. */
+ const Tk_ConfigSpec *specs, /* Describes legal options. */
+ char *widgRec, /* Record whose fields contain current values
+ * for options. */
+ const char *argvName, /* If non-NULL, indicates a single option
+ * whose info is to be returned. Otherwise
+ * info is returned for all options. */
+ int flags) /* Used to specify additional flags that must
+ * be present in config specs for them to be
+ * considered. */
+{
+ register Tk_ConfigSpec *specPtr, *staticSpecs;
+ int needFlags, hateFlags;
+ char *list;
+ const 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;
+ }
+
+ /*
+ * Get the build of the config for this interpreter.
+ */
+
+ staticSpecs = GetCachedSpecs(interp, specs);
+
+ /*
+ * If information is only wanted for a single configuration spec, then
+ * handle that one spec specially.
+ */
+
+ Tcl_ResetResult(interp);
+ if (argvName != NULL) {
+ specPtr = FindConfigSpec(interp, staticSpecs, argvName, needFlags,
+ hateFlags);
+ if (specPtr == NULL) {
+ return TCL_ERROR;
+ }
+ list = FormatConfigInfo(interp, tkwin, specPtr, widgRec);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(list, -1));
+ ckfree(list);
+ return TCL_OK;
+ }
+
+ /*
+ * Loop through all the specs, creating a big list with all their
+ * information.
+ */
+
+ for (specPtr = staticSpecs; 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, "}", 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(
+ Tcl_Interp *interp, /* Interpreter to use for things like
+ * floating-point precision. */
+ Tk_Window tkwin, /* Window corresponding to widget. */
+ register const Tk_ConfigSpec *specPtr,
+ /* Pointer to information describing
+ * option. */
+ char *widgRec) /* Pointer to record holding current values of
+ * info for widget. */
+{
+ const char *argv[6];
+ char *result;
+ char buffer[200];
+ Tcl_FreeProc *freeProc = NULL;
+
+ argv[0] = specPtr->argvName;
+ argv[1] = specPtr->dbName;
+ argv[2] = specPtr->dbClass;
+ argv[3] = specPtr->defValue;
+ if (specPtr->type == TK_CONFIG_SYNONYM) {
+ return Tcl_Merge(2, argv);
+ }
+ argv[4] = FormatConfigValue(interp, tkwin, specPtr, widgRec, buffer,
+ &freeProc);
+ if (argv[1] == NULL) {
+ argv[1] = "";
+ }
+ if (argv[2] == NULL) {
+ argv[2] = "";
+ }
+ if (argv[3] == NULL) {
+ argv[3] = "";
+ }
+ if (argv[4] == NULL) {
+ argv[4] = "";
+ }
+ result = Tcl_Merge(5, argv);
+ if (freeProc != NULL) {
+ if ((freeProc == TCL_DYNAMIC) || (freeProc == (Tcl_FreeProc *) free)) {
+ ckfree((char *) argv[4]);
+ } else {
+ freeProc((char *) argv[4]);
+ }
+ }
+ return result;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * FormatConfigValue --
+ *
+ * This function 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 function to free the result, and the caller must
+ * invoke this function when it is finished with the result.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static const char *
+FormatConfigValue(
+ Tcl_Interp *interp, /* Interpreter for use in real conversions. */
+ Tk_Window tkwin, /* Window corresponding to widget. */
+ const 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
+ * function to free the result, or NULL if
+ * result is static. */
+{
+ const char *ptr, *result;
+
+ *freeProcPtr = NULL;
+ ptr = widgRec + specPtr->offset;
+ result = "";
+ switch (specPtr->type) {
+ case TK_CONFIG_BOOLEAN:
+ if (*((int *) ptr) == 0) {
+ result = "0";
+ } else {
+ result = "1";
+ }
+ break;
+ case TK_CONFIG_INT:
+ sprintf(buffer, "%d", *((int *) ptr));
+ result = buffer;
+ break;
+ case TK_CONFIG_DOUBLE:
+ Tcl_PrintDouble(interp, *((double *) ptr), buffer);
+ result = buffer;
+ break;
+ case TK_CONFIG_STRING:
+ result = (*(char **) ptr);
+ if (result == NULL) {
+ result = "";
+ }
+ break;
+ case TK_CONFIG_UID: {
+ Tk_Uid uid = *((Tk_Uid *) ptr);
+
+ if (uid != NULL) {
+ result = uid;
+ }
+ break;
+ }
+ case TK_CONFIG_COLOR: {
+ XColor *colorPtr = *((XColor **) ptr);
+
+ if (colorPtr != NULL) {
+ result = Tk_NameOfColor(colorPtr);
+ }
+ break;
+ }
+ case TK_CONFIG_FONT: {
+ Tk_Font tkfont = *((Tk_Font *) ptr);
+
+ if (tkfont != NULL) {
+ result = Tk_NameOfFont(tkfont);
+ }
+ break;
+ }
+ case TK_CONFIG_BITMAP: {
+ Pixmap pixmap = *((Pixmap *) ptr);
+
+ if (pixmap != None) {
+ result = Tk_NameOfBitmap(Tk_Display(tkwin), pixmap);
+ }
+ break;
+ }
+ case TK_CONFIG_BORDER: {
+ Tk_3DBorder border = *((Tk_3DBorder *) ptr);
+
+ if (border != NULL) {
+ result = Tk_NameOf3DBorder(border);
+ }
+ break;
+ }
+ case TK_CONFIG_RELIEF:
+ result = Tk_NameOfRelief(*((int *) ptr));
+ break;
+ case TK_CONFIG_CURSOR:
+ case TK_CONFIG_ACTIVE_CURSOR: {
+ Tk_Cursor cursor = *((Tk_Cursor *) ptr);
+
+ if (cursor != None) {
+ result = Tk_NameOfCursor(Tk_Display(tkwin), cursor);
+ }
+ break;
+ }
+ case TK_CONFIG_JUSTIFY:
+ result = Tk_NameOfJustify(*((Tk_Justify *) ptr));
+ break;
+ case TK_CONFIG_ANCHOR:
+ result = Tk_NameOfAnchor(*((Tk_Anchor *) ptr));
+ break;
+ case TK_CONFIG_CAP_STYLE:
+ result = Tk_NameOfCapStyle(*((int *) ptr));
+ break;
+ case TK_CONFIG_JOIN_STYLE:
+ result = Tk_NameOfJoinStyle(*((int *) ptr));
+ break;
+ case TK_CONFIG_PIXELS:
+ sprintf(buffer, "%d", *((int *) ptr));
+ result = buffer;
+ break;
+ case TK_CONFIG_MM:
+ Tcl_PrintDouble(interp, *((double *) ptr), buffer);
+ result = buffer;
+ break;
+ case TK_CONFIG_WINDOW: {
+ Tk_Window tkwin;
+
+ tkwin = *((Tk_Window *) ptr);
+ if (tkwin != NULL) {
+ result = Tk_PathName(tkwin);
+ }
+ break;
+ }
+ case TK_CONFIG_CUSTOM:
+ result = specPtr->customPtr->printProc(specPtr->customPtr->clientData,
+ tkwin, widgRec, specPtr->offset, freeProcPtr);
+ break;
+ default:
+ result = "?? unknown type ??";
+ }
+ return result;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_ConfigureValue --
+ *
+ * This function 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(
+ Tcl_Interp *interp, /* Interpreter for error reporting. */
+ Tk_Window tkwin, /* Window corresponding to widgRec. */
+ const Tk_ConfigSpec *specs, /* Describes legal options. */
+ char *widgRec, /* Record whose fields contain current values
+ * for options. */
+ const char *argvName, /* Gives the command-line name for the option
+ * whose value is to be returned. */
+ int flags) /* Used to specify additional flags that must
+ * be present in config specs for them to be
+ * considered. */
+{
+ Tk_ConfigSpec *specPtr;
+ int needFlags, hateFlags;
+ Tcl_FreeProc *freeProc;
+ const char *result;
+ char buffer[200];
+
+ needFlags = flags & ~(TK_CONFIG_USER_BIT - 1);
+ if (Tk_Depth(tkwin) <= 1) {
+ hateFlags = TK_CONFIG_COLOR_ONLY;
+ } else {
+ hateFlags = TK_CONFIG_MONO_ONLY;
+ }
+
+ /*
+ * Get the build of the config for this interpreter.
+ */
+
+ specPtr = GetCachedSpecs(interp, specs);
+
+ specPtr = FindConfigSpec(interp, specPtr, argvName, needFlags, hateFlags);
+ if (specPtr == NULL) {
+ return TCL_ERROR;
+ }
+ result = FormatConfigValue(interp, tkwin, specPtr, widgRec, buffer,
+ &freeProc);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(result, -1));
+ if (freeProc != NULL) {
+ if ((freeProc == TCL_DYNAMIC) || (freeProc == (Tcl_FreeProc *) free)) {
+ ckfree((char *) result);
+ } else {
+ freeProc((char *) result);
+ }
+ }
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_FreeOptions --
+ *
+ * Free up all resources associated with configuration options.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Any resource in widgRec that is controlled by a configuration option
+ * (e.g. a Tk_3DBorder or XColor) is freed in the appropriate fashion.
+ *
+ * Notes:
+ * Since this is not looking anything up, this uses the static version of
+ * the config specs.
+ *
+ *----------------------------------------------------------------------
+ */
+
+ /* ARGSUSED */
+void
+Tk_FreeOptions(
+ const 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 const 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;
+ }
+ }
+ }
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * GetCachedSpecs --
+ *
+ * Returns a writable per-interpreter (and hence thread-local) copy of
+ * the given spec-table with (some of) the char* fields converted into
+ * Tk_Uid fields; this copy will be released when the interpreter
+ * terminates (during AssocData cleanup).
+ *
+ * Results:
+ * A pointer to the copied table.
+ *
+ * Notes:
+ * The conversion to Tk_Uid is only done the first time, when the table
+ * copy is taken. After that, the table is assumed to have Tk_Uids where
+ * they are needed. The time of deletion of the caches isn't very
+ * important unless you've got a lot of code that uses Tk_ConfigureWidget
+ * (or *Info or *Value} when the interpreter is being deleted.
+ *
+ *--------------------------------------------------------------
+ */
+
+static Tk_ConfigSpec *
+GetCachedSpecs(
+ Tcl_Interp *interp, /* Interpreter in which to store the cache. */
+ const Tk_ConfigSpec *staticSpecs)
+ /* Value to cache a copy of; it is also used
+ * as a key into the cache. */
+{
+ Tk_ConfigSpec *cachedSpecs;
+ Tcl_HashTable *specCacheTablePtr;
+ Tcl_HashEntry *entryPtr;
+ int isNew;
+
+ /*
+ * Get (or allocate if it doesn't exist) the hash table that the writable
+ * copies of the widget specs are stored in. In effect, this is
+ * self-initializing code.
+ */
+
+ specCacheTablePtr =
+ Tcl_GetAssocData(interp, "tkConfigSpec.threadTable", NULL);
+ if (specCacheTablePtr == NULL) {
+ specCacheTablePtr = ckalloc(sizeof(Tcl_HashTable));
+ Tcl_InitHashTable(specCacheTablePtr, TCL_ONE_WORD_KEYS);
+ Tcl_SetAssocData(interp, "tkConfigSpec.threadTable",
+ DeleteSpecCacheTable, specCacheTablePtr);
+ }
+
+ /*
+ * Look up or create the hash entry that the constant specs are mapped to,
+ * which will have the writable specs as its associated value.
+ */
+
+ entryPtr = Tcl_CreateHashEntry(specCacheTablePtr, (char *) staticSpecs,
+ &isNew);
+ if (isNew) {
+ unsigned int entrySpace = sizeof(Tk_ConfigSpec);
+ const Tk_ConfigSpec *staticSpecPtr;
+ Tk_ConfigSpec *specPtr;
+
+ /*
+ * OK, no working copy in this interpreter so copy. Need to work out
+ * how much space to allocate first.
+ */
+
+ for (staticSpecPtr=staticSpecs; staticSpecPtr->type!=TK_CONFIG_END;
+ staticSpecPtr++) {
+ entrySpace += sizeof(Tk_ConfigSpec);
+ }
+
+ /*
+ * Now allocate our working copy's space and copy over the contents
+ * from the master copy.
+ */
+
+ cachedSpecs = ckalloc(entrySpace);
+ memcpy(cachedSpecs, staticSpecs, entrySpace);
+ Tcl_SetHashValue(entryPtr, cachedSpecs);
+
+ /*
+ * Finally, go through and replace database names, database classes
+ * and default values with Tk_Uids. This is the bit that has to be
+ * per-thread.
+ */
+
+ for (specPtr=cachedSpecs; specPtr->type!=TK_CONFIG_END; specPtr++) {
+ if (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);
+ }
+ }
+ }
+ } else {
+ cachedSpecs = Tcl_GetHashValue(entryPtr);
+ }
+
+ return cachedSpecs;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * DeleteSpecCacheTable --
+ *
+ * Delete the per-interpreter copy of all the Tk_ConfigSpec tables which
+ * were stored in the interpreter's assoc-data store.
+ *
+ * Results:
+ * None
+ *
+ * Side effects:
+ * None (does *not* use any Tk API).
+ *
+ *--------------------------------------------------------------
+ */
+
+static void
+DeleteSpecCacheTable(
+ ClientData clientData,
+ Tcl_Interp *interp)
+{
+ Tcl_HashTable *tablePtr = clientData;
+ Tcl_HashEntry *entryPtr;
+ Tcl_HashSearch search;
+
+ for (entryPtr = Tcl_FirstHashEntry(tablePtr,&search); entryPtr != NULL;
+ entryPtr = Tcl_NextHashEntry(&search)) {
+ /*
+ * Someone else deallocates the Tk_Uids themselves.
+ */
+
+ ckfree(Tcl_GetHashValue(entryPtr));
+ }
+ Tcl_DeleteHashTable(tablePtr);
+ ckfree(tablePtr);
+}
+
+/*
+ * Local Variables:
+ * mode: c
+ * c-basic-offset: 4
+ * fill-column: 78
+ * End:
+ */
diff --git a/tk8.6/generic/tkOldTest.c b/tk8.6/generic/tkOldTest.c
new file mode 100644
index 0000000..df1bb6c
--- /dev/null
+++ b/tk8.6/generic/tkOldTest.c
@@ -0,0 +1,410 @@
+/*
+ * tkOldTest.c --
+ *
+ * This file contains C command functions for additional Tcl
+ * commands that are used to test Tk's support for legacy
+ * interfaces. These commands are not normally included in Tcl/Tk
+ * applications; they're only used for testing.
+ *
+ * Copyright (c) 1993-1994 The Regents of the University of California.
+ * Copyright (c) 1994-1997 Sun Microsystems, Inc.
+ * Copyright (c) 1998-1999 by Scriptics Corporation.
+ * Contributions by Don Porter, NIST, 2007. (not subject to US copyright)
+ *
+ * See the file "license.terms" for information on usage and redistribution of
+ * this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ */
+
+#define USE_OLD_IMAGE
+#ifndef USE_TCL_STUBS
+# define USE_TCL_STUBS
+#endif
+#ifndef USE_TK_STUBS
+# define USE_TK_STUBS
+#endif
+#include "tkInt.h"
+
+/*
+ * The following data structure represents the master for a test image:
+ */
+
+typedef struct TImageMaster {
+ Tk_ImageMaster master; /* Tk's token for image master. */
+ Tcl_Interp *interp; /* Interpreter for application. */
+ int width, height; /* Dimensions of image. */
+ char *imageName; /* Name of image (malloc-ed). */
+ char *varName; /* Name of variable in which to log events for
+ * image (malloc-ed). */
+} TImageMaster;
+
+/*
+ * The following data structure represents a particular use of a particular
+ * test image.
+ */
+
+typedef struct TImageInstance {
+ TImageMaster *masterPtr; /* Pointer to master for image. */
+ XColor *fg; /* Foreground color for drawing in image. */
+ GC gc; /* Graphics context for drawing in image. */
+} TImageInstance;
+
+/*
+ * The type record for test images:
+ */
+
+static int ImageCreate(Tcl_Interp *interp,
+ char *name, int argc, char **argv,
+ Tk_ImageType *typePtr, Tk_ImageMaster master,
+ ClientData *clientDataPtr);
+static ClientData ImageGet(Tk_Window tkwin, ClientData clientData);
+static void ImageDisplay(ClientData clientData,
+ Display *display, Drawable drawable,
+ int imageX, int imageY, int width,
+ int height, int drawableX,
+ int drawableY);
+static void ImageFree(ClientData clientData, Display *display);
+static void ImageDelete(ClientData clientData);
+
+static Tk_ImageType imageType = {
+ "oldtest", /* name */
+ (Tk_ImageCreateProc *) ImageCreate, /* createProc */
+ ImageGet, /* getProc */
+ ImageDisplay, /* displayProc */
+ ImageFree, /* freeProc */
+ ImageDelete, /* deleteProc */
+ NULL, /* postscriptPtr */
+ NULL, /* nextPtr */
+ NULL
+};
+
+/*
+ * Forward declarations for functions defined later in this file:
+ */
+
+static int ImageObjCmd(ClientData dummy,
+ Tcl_Interp *interp, int objc,
+ Tcl_Obj * const objv[]);
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkOldTestInit --
+ *
+ * This function performs intialization for the Tk test suite
+ * extensions for testing support for legacy interfaces.
+ *
+ * Results:
+ * Returns a standard Tcl completion code, and leaves an error message in
+ * the interp's result if an error occurs.
+ *
+ * Side effects:
+ * Creates several test commands.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TkOldTestInit(
+ Tcl_Interp *interp)
+{
+ static int initialized = 0;
+
+ if (!initialized) {
+ initialized = 1;
+ Tk_CreateImageType(&imageType);
+ }
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ImageCreate --
+ *
+ * This function is called by the Tk image code to create "oldtest" images.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * The data structure for a new image is allocated.
+ *
+ *----------------------------------------------------------------------
+ */
+
+ /* ARGSUSED */
+static int
+ImageCreate(
+ Tcl_Interp *interp, /* Interpreter for application containing
+ * image. */
+ char *name, /* Name to use for image. */
+ int argc, /* Number of arguments. */
+ char **argv, /* Argument strings for options (doesn't
+ * include image name or type). */
+ Tk_ImageType *typePtr, /* Pointer to our type record (not used). */
+ Tk_ImageMaster master, /* Token for image, to be used by us in later
+ * callbacks. */
+ ClientData *clientDataPtr) /* Store manager's token for image here; it
+ * will be returned in later callbacks. */
+{
+ TImageMaster *timPtr;
+ const char *varName;
+ int i;
+
+ varName = "log";
+ for (i = 0; i < argc; i += 2) {
+ if (strcmp(argv[i], "-variable") != 0) {
+ Tcl_AppendResult(interp, "bad option name \"",
+ argv[i], "\"", NULL);
+ return TCL_ERROR;
+ }
+ if ((i+1) == argc) {
+ Tcl_AppendResult(interp, "no value given for \"",
+ argv[i], "\" option", NULL);
+ return TCL_ERROR;
+ }
+ varName = argv[i+1];
+ }
+
+ timPtr = ckalloc(sizeof(TImageMaster));
+ timPtr->master = master;
+ timPtr->interp = interp;
+ timPtr->width = 30;
+ timPtr->height = 15;
+ timPtr->imageName = ckalloc((unsigned) (strlen(name) + 1));
+ strcpy(timPtr->imageName, name);
+ timPtr->varName = ckalloc((unsigned) (strlen(varName) + 1));
+ strcpy(timPtr->varName, varName);
+ Tcl_CreateObjCommand(interp, name, ImageObjCmd, timPtr, NULL);
+ *clientDataPtr = timPtr;
+ Tk_ImageChanged(master, 0, 0, 30, 15, 30, 15);
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ImageObjCmd --
+ *
+ * This function implements the commands corresponding to individual
+ * images.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * Forces windows to be created.
+ *
+ *----------------------------------------------------------------------
+ */
+
+ /* ARGSUSED */
+static int
+ImageObjCmd(
+ ClientData clientData, /* Main window for application. */
+ Tcl_Interp *interp, /* Current interpreter. */
+ int objc, /* Number of arguments. */
+ Tcl_Obj *const objv[]) /* Argument strings. */
+{
+ TImageMaster *timPtr = clientData;
+ int x, y, width, height;
+
+ if (objc < 2) {
+ Tcl_WrongNumArgs(interp, 1, objv, "option ?arg ...?");
+ return TCL_ERROR;
+ }
+ if (strcmp(Tcl_GetString(objv[1]), "changed") == 0) {
+ if (objc != 8) {
+ Tcl_WrongNumArgs(interp, 1, objv, "changed x y width height"
+ " imageWidth imageHeight");
+ return TCL_ERROR;
+ }
+ if ((Tcl_GetIntFromObj(interp, objv[2], &x) != TCL_OK)
+ || (Tcl_GetIntFromObj(interp, objv[3], &y) != TCL_OK)
+ || (Tcl_GetIntFromObj(interp, objv[4], &width) != TCL_OK)
+ || (Tcl_GetIntFromObj(interp, objv[5], &height) != TCL_OK)
+ || (Tcl_GetIntFromObj(interp, objv[6], &timPtr->width) != TCL_OK)
+ || (Tcl_GetIntFromObj(interp, objv[7], &timPtr->height) != TCL_OK)) {
+ return TCL_ERROR;
+ }
+ Tk_ImageChanged(timPtr->master, x, y, width, height, timPtr->width,
+ timPtr->height);
+ } else {
+ Tcl_AppendResult(interp, "bad option \"", Tcl_GetString(objv[1]),
+ "\": must be changed", NULL);
+ return TCL_ERROR;
+ }
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ImageGet --
+ *
+ * This function is called by Tk to set things up for using a test image
+ * in a particular widget.
+ *
+ * Results:
+ * The return value is a token for the image instance, which is used in
+ * future callbacks to ImageDisplay and ImageFree.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static ClientData
+ImageGet(
+ Tk_Window tkwin, /* Token for window in which image will be
+ * used. */
+ ClientData clientData) /* Pointer to TImageMaster for image. */
+{
+ TImageMaster *timPtr = clientData;
+ TImageInstance *instPtr;
+ char buffer[100];
+ XGCValues gcValues;
+
+ sprintf(buffer, "%s get", timPtr->imageName);
+ Tcl_SetVar2(timPtr->interp, timPtr->varName, NULL, buffer,
+ TCL_GLOBAL_ONLY|TCL_APPEND_VALUE|TCL_LIST_ELEMENT);
+
+ instPtr = ckalloc(sizeof(TImageInstance));
+ instPtr->masterPtr = timPtr;
+ instPtr->fg = Tk_GetColor(timPtr->interp, tkwin, "#ff0000");
+ gcValues.foreground = instPtr->fg->pixel;
+ instPtr->gc = Tk_GetGC(tkwin, GCForeground, &gcValues);
+ return instPtr;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ImageDisplay --
+ *
+ * This function is invoked to redisplay part or all of an image in a
+ * given drawable.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The image gets partially redrawn, as an "X" that shows the exact
+ * redraw area.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+ImageDisplay(
+ ClientData clientData, /* Pointer to TImageInstance for image. */
+ Display *display, /* Display to use for drawing. */
+ Drawable drawable, /* Where to redraw image. */
+ int imageX, int imageY, /* Origin of area to redraw, relative to
+ * origin of image. */
+ int width, int height, /* Dimensions of area to redraw. */
+ int drawableX, int drawableY)
+ /* Coordinates in drawable corresponding to
+ * imageX and imageY. */
+{
+ TImageInstance *instPtr = clientData;
+ char buffer[200 + TCL_INTEGER_SPACE * 6];
+
+ sprintf(buffer, "%s display %d %d %d %d %d %d",
+ instPtr->masterPtr->imageName, imageX, imageY, width, height,
+ drawableX, drawableY);
+ Tcl_SetVar2(instPtr->masterPtr->interp, instPtr->masterPtr->varName, NULL,
+ buffer, TCL_GLOBAL_ONLY|TCL_APPEND_VALUE|TCL_LIST_ELEMENT);
+ if (width > (instPtr->masterPtr->width - imageX)) {
+ width = instPtr->masterPtr->width - imageX;
+ }
+ if (height > (instPtr->masterPtr->height - imageY)) {
+ height = instPtr->masterPtr->height - imageY;
+ }
+ XDrawRectangle(display, drawable, instPtr->gc, drawableX, drawableY,
+ (unsigned) (width-1), (unsigned) (height-1));
+ XDrawLine(display, drawable, instPtr->gc, drawableX, drawableY,
+ (int) (drawableX + width - 1), (int) (drawableY + height - 1));
+ XDrawLine(display, drawable, instPtr->gc, drawableX,
+ (int) (drawableY + height - 1),
+ (int) (drawableX + width - 1), drawableY);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ImageFree --
+ *
+ * This function is called when an instance of an image is no longer
+ * used.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Information related to the instance is freed.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+ImageFree(
+ ClientData clientData, /* Pointer to TImageInstance for instance. */
+ Display *display) /* Display where image was to be drawn. */
+{
+ TImageInstance *instPtr = clientData;
+ char buffer[200];
+
+ sprintf(buffer, "%s free", instPtr->masterPtr->imageName);
+ Tcl_SetVar2(instPtr->masterPtr->interp, instPtr->masterPtr->varName, NULL,
+ buffer, TCL_GLOBAL_ONLY|TCL_APPEND_VALUE|TCL_LIST_ELEMENT);
+ Tk_FreeColor(instPtr->fg);
+ Tk_FreeGC(display, instPtr->gc);
+ ckfree(instPtr);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ImageDelete --
+ *
+ * This function is called to clean up a test image when an application
+ * goes away.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Information about the image is deleted.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+ImageDelete(
+ ClientData clientData) /* Pointer to TImageMaster for image. When
+ * this function is called, no more instances
+ * exist. */
+{
+ TImageMaster *timPtr = clientData;
+ char buffer[100];
+
+ sprintf(buffer, "%s delete", timPtr->imageName);
+ Tcl_SetVar2(timPtr->interp, timPtr->varName, NULL, buffer,
+ TCL_GLOBAL_ONLY|TCL_APPEND_VALUE|TCL_LIST_ELEMENT);
+
+ Tcl_DeleteCommand(timPtr->interp, timPtr->imageName);
+ ckfree(timPtr->imageName);
+ ckfree(timPtr->varName);
+ ckfree(timPtr);
+}
+
+/*
+ * Local Variables:
+ * mode: c
+ * c-basic-offset: 4
+ * fill-column: 78
+ * End:
+ */
diff --git a/tk8.6/generic/tkOption.c b/tk8.6/generic/tkOption.c
new file mode 100644
index 0000000..24e7fb3
--- /dev/null
+++ b/tk8.6/generic/tkOption.c
@@ -0,0 +1,1599 @@
+/*
+ * tkOption.c --
+ *
+ * This module contains functions to manage the option database, which
+ * allows various strings to be associated with windows either by name or
+ * by class or both.
+ *
+ * Copyright (c) 1990-1994 The Regents of the University of California.
+ * Copyright (c) 1994-1997 Sun Microsystems, Inc.
+ *
+ * See the file "license.terms" for information on usage and redistribution of
+ * this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ */
+
+#include "tkInt.h"
+
+/*
+ * The option database is stored as one tree for each main window. Each name
+ * or class field in an option is associated with a node or leaf of the tree.
+ * For example, the options "x.y.z" and "x.y*a" each correspond to three nodes
+ * in the tree; they share the nodes "x" and "x.y", but have different leaf
+ * nodes. One of the following structures exists for each node or leaf in the
+ * option tree. It is actually stored as part of the parent node, and
+ * describes a particular child of the parent.
+ *
+ * The structure of the option db tree is a little confusing. There are four
+ * different kinds of nodes in the tree:
+ * interior class nodes
+ * interior name nodes
+ * leaf class nodes
+ * leaf name nodes
+ *
+ * All interior nodes refer to _window_ classes and names; all leaf nodes
+ * refer to _option_ classes and names. When looking for a particular option,
+ * therefore, you must compare interior node values to corresponding window
+ * values, and compare leaf node values to corresponding option values.
+ *
+ * The tree is actually stored in a collection of arrays; there is one each
+ * combination of WILDCARD/EXACT and CLASS/NAME and NODE/LEAF. The NODE arrays
+ * contain the interior nodes of the tree; each element has a pointer to an
+ * array of elements which are the leaves of the tree. The LEAF arrays, rather
+ * than holding the leaves of the tree, hold a cached subset of the option
+ * database, consisting of the values of all defined options for a single
+ * window, and some additional information about each ancestor of the window
+ * (since some options may be inherited from a parent), all the way back to
+ * the root window.
+ *
+ * Each time a call is made to Tk_GetOption, Tk will attempt to use the cached
+ * information to satisfy the lookup. If the call is for a window other than
+ * that for which options are currently cached, the portion of the cache that
+ * contains information for common ancestors of the two windows is retained
+ * and the remainder is discarded and rebuilt with new information for the new
+ * window.
+ */
+
+typedef struct Element {
+ Tk_Uid nameUid; /* Name or class from one element of an option
+ * spec. */
+ union {
+ struct ElArray *arrayPtr;
+ /* If this is an intermediate node, a pointer
+ * to a structure describing the remaining
+ * elements of all options whose prefixes are
+ * the same up through this element. */
+ Tk_Uid valueUid; /* For leaf nodes, this is the string value of
+ * the option. */
+ } child;
+ int priority; /* Used to select among matching options.
+ * Includes both the priority level and a
+ * serial #. Greater value means higher
+ * priority. Irrelevant except in leaf
+ * nodes. */
+ int flags; /* OR-ed combination of bits. See below for
+ * values. */
+} Element;
+
+/*
+ * Flags in Element structures:
+ *
+ * CLASS - Non-zero means this element refers to a class, zero
+ * means this element refers to a name.
+ * NODE - Zero means this is a leaf element (the child field is
+ * a value, not a pointer to another node). One means
+ * this is a node element.
+ * WILDCARD - Non-zero means this there was a star in the original
+ * specification just before this element. Zero means
+ * there was a dot.
+ */
+
+#define TYPE_MASK 0x7
+
+#define CLASS 0x1
+#define NODE 0x2
+#define WILDCARD 0x4
+
+#define EXACT_LEAF_NAME 0x0
+#define EXACT_LEAF_CLASS 0x1
+#define EXACT_NODE_NAME 0x2
+#define EXACT_NODE_CLASS 0x3
+#define WILDCARD_LEAF_NAME 0x4
+#define WILDCARD_LEAF_CLASS 0x5
+#define WILDCARD_NODE_NAME 0x6
+#define WILDCARD_NODE_CLASS 0x7
+
+/*
+ * The following structure is used to manage a dynamic array of Elements.
+ * These structures are used for two purposes: to store the contents of a node
+ * in the option tree, and for the option stacks described below.
+ */
+
+typedef struct ElArray {
+ int arraySize; /* Number of elements actually allocated in
+ * the "els" array. */
+ int numUsed; /* Number of elements currently in use out of
+ * els. */
+ Element *nextToUse; /* Pointer to &els[numUsed]. */
+ Element els[1]; /* Array of structures describing children of
+ * this node. The array will actually contain
+ * enough elements for all of the children
+ * (and even a few extras, perhaps). This must
+ * be the last field in the structure. */
+} ElArray;
+
+#define EL_ARRAY_SIZE(numEls) ((unsigned) (sizeof(ElArray) \
+ + ((numEls)-1)*sizeof(Element)))
+#define INITIAL_SIZE 5
+
+/*
+ * In addition to the option tree, which is a relatively static structure,
+ * there are eight additional structures called "stacks", which are used to
+ * speed up queries into the option database. The stack structures are
+ * designed for the situation where an individual widget makes repeated
+ * requests for its particular options. The requests differ only in their last
+ * name/class, so during the first request we extract all the options
+ * pertaining to the particular widget and save them in a stack-like cache;
+ * subsequent requests for the same widget can search the cache relatively
+ * quickly. In fact, the cache is a hierarchical one, storing a list of
+ * relevant options for this widget and all of its ancestors up to the
+ * application root; hence the name "stack".
+ *
+ * Each of the eight stacks consists of an array of Elements, ordered in terms
+ * of levels in the window hierarchy. All the elements relevant for the
+ * top-level widget appear first in the array, followed by all those from the
+ * next-level widget on the path to the current widget, etc. down to those for
+ * the current widget.
+ *
+ * Cached information is divided into eight stacks according to the CLASS,
+ * NODE, and WILDCARD flags. Leaf and non-leaf information is kept separate to
+ * speed up individual probes (non-leaf information is only relevant when
+ * building the stacks, but isn't relevant when making probes; similarly, only
+ * non-leaf information is relevant when the stacks are being extended to the
+ * next widget down in the widget hierarchy). Wildcard elements are handled
+ * separately from "exact" elements because once they appear at a particular
+ * level in the stack they remain active for all deeper levels; exact elements
+ * are only relevant at a particular level. For example, when searching for
+ * options relevant in a particular window, the entire wildcard stacks get
+ * checked, but only the portions of the exact stacks that pertain to the
+ * window's parent. Lastly, name and class stacks are kept separate because
+ * different search keys are used when searching them; keeping them separate
+ * speeds up the searches.
+ */
+
+#define NUM_STACKS 8
+
+/*
+ * One of the following structures is used to keep track of each level in the
+ * stacks.
+ */
+
+typedef struct StackLevel {
+ TkWindow *winPtr; /* Window corresponding to this stack
+ * level. */
+ int bases[NUM_STACKS]; /* For each stack, index of first element on
+ * stack corresponding to this level (used to
+ * restore "numUsed" fields when popping out
+ * of a level. */
+} StackLevel;
+
+typedef struct ThreadSpecificData {
+ int initialized; /* 0 means the ThreadSpecific Data structure
+ * for the current thread needs to be
+ * initialized. */
+ ElArray *stacks[NUM_STACKS];
+ TkWindow *cachedWindow; /* Lowest-level window currently loaded in
+ * stacks at present. NULL means stacks have
+ * never been used, or have been invalidated
+ * because of a change to the database. */
+ /*
+ * Information about all of the stack levels that are currently active.
+ * This array grows dynamically to become as large as needed.
+ */
+
+ StackLevel *levels; /* Array describing current stack. */
+ int numLevels; /* Total space allocated. */
+ int curLevel; /* Highest level currently in use. Note:
+ * curLevel is never 0! (I don't remember why
+ * anymore...) */
+ int serial; /* 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. */
+ Element defaultMatch; /* Special "no match" Element to use as
+ * default for searches.*/
+} ThreadSpecificData;
+static Tcl_ThreadDataKey dataKey;
+
+/*
+ * Forward declarations for functions defined in this file:
+ */
+
+static int AddFromString(Tcl_Interp *interp, Tk_Window tkwin,
+ char *string, int priority);
+static void ClearOptionTree(ElArray *arrayPtr);
+static ElArray * ExtendArray(ElArray *arrayPtr, Element *elPtr);
+static void ExtendStacks(ElArray *arrayPtr, int leaf);
+static int GetDefaultOptions(Tcl_Interp *interp,
+ TkWindow *winPtr);
+static ElArray * NewArray(int numEls);
+static void OptionThreadExitProc(ClientData clientData);
+static void OptionInit(TkMainInfo *mainPtr);
+static int ParsePriority(Tcl_Interp *interp, const char *string);
+static int ReadOptionFile(Tcl_Interp *interp, Tk_Window tkwin,
+ const char *fileName, int priority);
+static void SetupStacks(TkWindow *winPtr, int leaf);
+
+/*
+ *--------------------------------------------------------------
+ *
+ * Tk_AddOption --
+ *
+ * Add a new option to the option database.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Information is added to the option database.
+ *
+ *--------------------------------------------------------------
+ */
+
+void
+Tk_AddOption(
+ Tk_Window tkwin, /* Window token; option will be associated
+ * with main window for this window. */
+ const char *name, /* Multi-element name of option. */
+ const char *value, /* String value for option. */
+ int priority) /* Overall priority level to use for this
+ * option, such as TK_USER_DEFAULT_PRIO or
+ * TK_INTERACTIVE_PRIO. Must be between 0 and
+ * TK_MAX_PRIO. */
+{
+ TkWindow *winPtr = ((TkWindow *) tkwin)->mainPtr->winPtr;
+ register ElArray **arrayPtrPtr;
+ register Element *elPtr;
+ Element newEl;
+ register const char *p;
+ const char *field;
+ int count, firstField;
+ ptrdiff_t length;
+#define TMP_SIZE 100
+ char tmp[TMP_SIZE+1];
+ ThreadSpecificData *tsdPtr =
+ Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
+
+ if (winPtr->mainPtr->optionRootPtr == NULL) {
+ OptionInit(winPtr->mainPtr);
+ }
+ tsdPtr->cachedWindow = NULL;/* Invalidate the cache. */
+
+ /*
+ * Compute the priority for the new element, including both the overall
+ * level and the serial number (to disambiguate with the level).
+ */
+
+ if (priority < 0) {
+ priority = 0;
+ } else if (priority > TK_MAX_PRIO) {
+ priority = TK_MAX_PRIO;
+ }
+ newEl.priority = (priority << 24) + tsdPtr->serial;
+ tsdPtr->serial++;
+
+ /*
+ * Parse the option one field at a time.
+ */
+
+ arrayPtrPtr = &(((TkWindow *) tkwin)->mainPtr->optionRootPtr);
+ p = name;
+ for (firstField = 1; ; firstField = 0) {
+ /*
+ * Scan the next field from the name and convert it to a Tk_Uid. Must
+ * copy the field before calling Tk_Uid, so that a terminating NULL
+ * may be added without modifying the source string.
+ */
+
+ if (*p == '*') {
+ newEl.flags = WILDCARD;
+ p++;
+ } else {
+ newEl.flags = 0;
+ }
+ field = p;
+ while ((*p != 0) && (*p != '.') && (*p != '*')) {
+ p++;
+ }
+ length = p - field;
+ if (length > TMP_SIZE) {
+ length = TMP_SIZE;
+ }
+ strncpy(tmp, field, (size_t) length);
+ tmp[length] = 0;
+ newEl.nameUid = Tk_GetUid(tmp);
+ if (isupper(UCHAR(*field))) {
+ newEl.flags |= CLASS;
+ }
+
+ if (*p != 0) {
+ /*
+ * New element will be a node. If this option can't possibly apply
+ * to this main window, then just skip it. Otherwise, add it to
+ * the parent, if it isn't already there, and descend into it.
+ */
+
+ newEl.flags |= NODE;
+ if (firstField && !(newEl.flags & WILDCARD)
+ && (newEl.nameUid != winPtr->nameUid)
+ && (newEl.nameUid != winPtr->classUid)) {
+ return;
+ }
+ for (elPtr = (*arrayPtrPtr)->els, count = (*arrayPtrPtr)->numUsed;
+ ; elPtr++, count--) {
+ if (count == 0) {
+ newEl.child.arrayPtr = NewArray(5);
+ *arrayPtrPtr = ExtendArray(*arrayPtrPtr, &newEl);
+ arrayPtrPtr = &((*arrayPtrPtr)
+ ->nextToUse[-1].child.arrayPtr);
+ break;
+ }
+ if ((elPtr->nameUid == newEl.nameUid)
+ && (elPtr->flags == newEl.flags)) {
+ arrayPtrPtr = &(elPtr->child.arrayPtr);
+ break;
+ }
+ }
+ if (*p == '.') {
+ p++;
+ }
+ } else {
+ /*
+ * New element is a leaf. Add it to the parent, if it isn't
+ * already there. If it exists already, keep whichever value has
+ * highest priority.
+ */
+
+ newEl.child.valueUid = Tk_GetUid(value);
+ for (elPtr = (*arrayPtrPtr)->els, count = (*arrayPtrPtr)->numUsed;
+ ; elPtr++, count--) {
+ if (count == 0) {
+ *arrayPtrPtr = ExtendArray(*arrayPtrPtr, &newEl);
+ return;
+ }
+ if ((elPtr->nameUid == newEl.nameUid)
+ && (elPtr->flags == newEl.flags)) {
+ if (elPtr->priority < newEl.priority) {
+ elPtr->priority = newEl.priority;
+ elPtr->child.valueUid = newEl.child.valueUid;
+ }
+ return;
+ }
+ }
+ }
+ }
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * Tk_GetOption --
+ *
+ * Retrieve an option from the option database.
+ *
+ * Results:
+ * The return value is the value specified in the option database for the
+ * given name and class on the given window. If there is nothing
+ * specified in the database for that option, then NULL is returned.
+ *
+ * Side effects:
+ * The internal caches used to speed up option mapping may be modified,
+ * if this tkwin is different from the last tkwin used for option
+ * retrieval.
+ *
+ *--------------------------------------------------------------
+ */
+
+Tk_Uid
+Tk_GetOption(
+ Tk_Window tkwin, /* Token for window that option is associated
+ * with. */
+ const char *name, /* Name of option. */
+ const char *className) /* Class of option. NULL means there is no
+ * class for this option: just check for
+ * name. */
+{
+ Tk_Uid nameId, classId = NULL;
+ char *masqName;
+ register Element *elPtr, *bestPtr;
+ register int count;
+ StackLevel *levelPtr;
+ int stackDepth[NUM_STACKS];
+ ThreadSpecificData *tsdPtr =
+ Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
+
+ /*
+ * Note: no need to call OptionInit here: it will be done by the
+ * SetupStacks call below (squeeze out those nanoseconds).
+ */
+
+ if (tkwin != (Tk_Window) tsdPtr->cachedWindow) {
+ SetupStacks((TkWindow *) tkwin, 1);
+ }
+
+ /*
+ * Get a default "best" match.
+ */
+
+ bestPtr = &tsdPtr->defaultMatch;
+
+ /*
+ * For megawidget support, we want to have some widget options masquerade
+ * as options for other widgets. For example, a combobox has a button in
+ * it; this button ought to pick up the *Button.background, etc., options.
+ * But because the class of the widget is Combobox, our normal search
+ * won't get that option.
+ *
+ * To work around this, the option name field syntax was extended to allow
+ * for a "." in the name; if this character occurs in the name, then it
+ * indicates that this name contains a new window class and an option
+ * name, ie, "Button.foreground". If we see this form in the name field,
+ * we query the option database directly (since the option stacks will not
+ * have the information we need).
+ */
+
+ masqName = strchr(name, (int)'.');
+ if (masqName != NULL) {
+ /*
+ * This option is masquerading with a different window class. Search
+ * the stack to the depth it was before the current window's
+ * information was pushed (the value for which is stored in the bases
+ * field).
+ */
+
+ levelPtr = &tsdPtr->levels[tsdPtr->curLevel];
+ nameId = Tk_GetUid(masqName+1);
+ for (count = 0; count < NUM_STACKS; count++) {
+ stackDepth[count] = levelPtr->bases[count];
+ }
+ } else {
+ /*
+ * No option masquerading here. Just use the current level to get the
+ * stack depths.
+ */
+
+ nameId = Tk_GetUid(name);
+ for (count = 0; count < NUM_STACKS; count++) {
+ stackDepth[count] = tsdPtr->stacks[count]->numUsed;
+ }
+ }
+
+ /*
+ * Probe the stacks for matches.
+ */
+
+ for (elPtr = tsdPtr->stacks[EXACT_LEAF_NAME]->els,
+ count = stackDepth[EXACT_LEAF_NAME]; count > 0;
+ elPtr++, count--) {
+ if ((elPtr->nameUid == nameId)
+ && (elPtr->priority > bestPtr->priority)) {
+ bestPtr = elPtr;
+ }
+ }
+ for (elPtr = tsdPtr->stacks[WILDCARD_LEAF_NAME]->els,
+ count = stackDepth[WILDCARD_LEAF_NAME]; count > 0;
+ elPtr++, count--) {
+ if ((elPtr->nameUid == nameId)
+ && (elPtr->priority > bestPtr->priority)) {
+ bestPtr = elPtr;
+ }
+ }
+
+ if (className != NULL) {
+ classId = Tk_GetUid(className);
+ for (elPtr = tsdPtr->stacks[EXACT_LEAF_CLASS]->els,
+ count = stackDepth[EXACT_LEAF_CLASS]; count > 0;
+ elPtr++, count--) {
+ if ((elPtr->nameUid == classId)
+ && (elPtr->priority > bestPtr->priority)) {
+ bestPtr = elPtr;
+ }
+ }
+ for (elPtr = tsdPtr->stacks[WILDCARD_LEAF_CLASS]->els,
+ count = stackDepth[WILDCARD_LEAF_CLASS]; count > 0;
+ elPtr++, count--) {
+ if ((elPtr->nameUid == classId)
+ && (elPtr->priority > bestPtr->priority)) {
+ bestPtr = elPtr;
+ }
+ }
+ }
+
+ /*
+ * If this option was masquerading with a different window class, probe
+ * the option database now. Note that this will be inefficient if the
+ * option database is densely populated, or if the widget has many
+ * masquerading options.
+ */
+
+ if (masqName != NULL) {
+ char *masqClass;
+ Tk_Uid nodeId, winClassId, winNameId;
+ unsigned int classNameLength;
+ register Element *nodePtr, *leafPtr;
+ static const int searchOrder[] = {
+ EXACT_NODE_NAME, WILDCARD_NODE_NAME, EXACT_NODE_CLASS,
+ WILDCARD_NODE_CLASS, -1
+ };
+ const int *currentPtr;
+ int currentStack, leafCount;
+
+ /*
+ * Extract the masquerade class name from the name field.
+ */
+
+ classNameLength = (unsigned) (masqName - name);
+ masqClass = ckalloc(classNameLength + 1);
+ strncpy(masqClass, name, classNameLength);
+ masqClass[classNameLength] = '\0';
+
+ winClassId = Tk_GetUid(masqClass);
+ ckfree(masqClass);
+ winNameId = ((TkWindow *) tkwin)->nameUid;
+
+ levelPtr = &tsdPtr->levels[tsdPtr->curLevel];
+
+ for (currentPtr = searchOrder; *currentPtr != -1; currentPtr++) {
+ currentStack = *currentPtr;
+ nodePtr = tsdPtr->stacks[currentStack]->els;
+ count = levelPtr->bases[currentStack];
+
+ /*
+ * For wildcard stacks, check all entries; for non-wildcard
+ * stacks, only check things that matched in the parent.
+ */
+
+ if (!(currentStack & WILDCARD)) {
+ nodePtr += levelPtr[-1].bases[currentStack];
+ count -= levelPtr[-1].bases[currentStack];
+ }
+
+ if (currentStack & CLASS) {
+ nodeId = winClassId;
+ } else {
+ nodeId = winNameId;
+ }
+
+ for ( ; count > 0; nodePtr++, count--) {
+ if (nodePtr->nameUid == nodeId) {
+ leafPtr = nodePtr->child.arrayPtr->els;
+ leafCount = nodePtr->child.arrayPtr->numUsed;
+ for ( ; leafCount > 0; leafPtr++, leafCount--) {
+ if (leafPtr->flags & CLASS && className != NULL) {
+ if (leafPtr->nameUid == classId &&
+ leafPtr->priority > bestPtr->priority) {
+ bestPtr = leafPtr;
+ }
+ } else {
+ if (leafPtr->nameUid == nameId &&
+ leafPtr->priority > bestPtr->priority) {
+ bestPtr = leafPtr;
+ }
+ }
+ }
+ }
+ }
+ }
+ }
+
+ return bestPtr->child.valueUid;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * Tk_OptionObjCmd --
+ *
+ * This function is invoked to process the "option" Tcl command. See the
+ * user documentation for details on what it does.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * See the user documentation.
+ *
+ *--------------------------------------------------------------
+ */
+
+int
+Tk_OptionObjCmd(
+ ClientData clientData, /* Main window associated with interpreter. */
+ Tcl_Interp *interp, /* Current interpreter. */
+ int objc, /* Number of Tcl_Obj arguments. */
+ Tcl_Obj *const objv[]) /* Tcl_Obj arguments. */
+{
+ Tk_Window tkwin = clientData;
+ int index, result;
+ ThreadSpecificData *tsdPtr =
+ Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
+ static const char *const optionCmds[] = {
+ "add", "clear", "get", "readfile", NULL
+ };
+ enum optionVals {
+ OPTION_ADD, OPTION_CLEAR, OPTION_GET, OPTION_READFILE
+ };
+
+ if (objc < 2) {
+ Tcl_WrongNumArgs(interp, 1, objv, "cmd arg ?arg ...?");
+ return TCL_ERROR;
+ }
+
+ result = Tcl_GetIndexFromObjStruct(interp, objv[1], optionCmds,
+ sizeof(char *), "option", 0, &index);
+ if (result != TCL_OK) {
+ return result;
+ }
+
+ result = TCL_OK;
+ switch ((enum optionVals) index) {
+ case OPTION_ADD: {
+ int priority;
+
+ if ((objc != 4) && (objc != 5)) {
+ Tcl_WrongNumArgs(interp, 2, objv, "pattern value ?priority?");
+ return TCL_ERROR;
+ }
+
+ if (objc == 4) {
+ priority = TK_INTERACTIVE_PRIO;
+ } else {
+ priority = ParsePriority(interp, Tcl_GetString(objv[4]));
+ if (priority < 0) {
+ return TCL_ERROR;
+ }
+ }
+ Tk_AddOption(tkwin, Tcl_GetString(objv[2]), Tcl_GetString(objv[3]),
+ priority);
+ break;
+ }
+
+ case OPTION_CLEAR: {
+ TkMainInfo *mainPtr = ((TkWindow *) tkwin)->mainPtr;
+
+ if (objc != 2) {
+ Tcl_WrongNumArgs(interp, 2, objv, "");
+ return TCL_ERROR;
+ }
+ if (mainPtr->optionRootPtr != NULL) {
+ ClearOptionTree(mainPtr->optionRootPtr);
+ mainPtr->optionRootPtr = NULL;
+ }
+ tsdPtr->cachedWindow = NULL;
+ break;
+ }
+
+ case OPTION_GET: {
+ Tk_Window window;
+ Tk_Uid value;
+
+ if (objc != 5) {
+ Tcl_WrongNumArgs(interp, 2, objv, "window name class");
+ return TCL_ERROR;
+ }
+ window = Tk_NameToWindow(interp, Tcl_GetString(objv[2]), tkwin);
+ if (window == NULL) {
+ return TCL_ERROR;
+ }
+ value = Tk_GetOption(window, Tcl_GetString(objv[3]),
+ Tcl_GetString(objv[4]));
+ if (value != NULL) {
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(value, -1));
+ }
+ break;
+ }
+
+ case OPTION_READFILE: {
+ int priority;
+
+ if ((objc != 3) && (objc != 4)) {
+ Tcl_WrongNumArgs(interp, 2, objv, "fileName ?priority?");
+ return TCL_ERROR;
+ }
+
+ if (objc == 4) {
+ priority = ParsePriority(interp, Tcl_GetString(objv[3]));
+ if (priority < 0) {
+ return TCL_ERROR;
+ }
+ } else {
+ priority = TK_INTERACTIVE_PRIO;
+ }
+ result = ReadOptionFile(interp, tkwin, Tcl_GetString(objv[2]),
+ priority);
+ break;
+ }
+ }
+ return result;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * TkOptionDeadWindow --
+ *
+ * This function is called whenever a window is deleted. It cleans up any
+ * option-related stuff associated with the window.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Option-related resources are freed. See code below for details.
+ *
+ *--------------------------------------------------------------
+ */
+
+void
+TkOptionDeadWindow(
+ register TkWindow *winPtr) /* Window to be cleaned up. */
+{
+ ThreadSpecificData *tsdPtr =
+ Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
+
+ /*
+ * If this window is in the option stacks, then clear the stacks.
+ *
+ * XXX: OptionThreadExitProc will be invoked before DeleteWindowsExitProc
+ * XXX: if it is thread-specific (which it should be), invalidating the
+ * XXX: tsd. Tk shutdown needs to be verified to handle this correctly.
+ */
+
+ if (tsdPtr->initialized && (winPtr->optionLevel != -1)) {
+ int i;
+
+ for (i = 1; i <= tsdPtr->curLevel; i++) {
+ tsdPtr->levels[i].winPtr->optionLevel = -1;
+ }
+ tsdPtr->curLevel = -1;
+ tsdPtr->cachedWindow = NULL;
+ }
+
+ /*
+ * If this window was a main window, then delete its option database.
+ */
+
+ if ((winPtr->mainPtr != NULL) && (winPtr->mainPtr->winPtr == winPtr)
+ && (winPtr->mainPtr->optionRootPtr != NULL)) {
+ ClearOptionTree(winPtr->mainPtr->optionRootPtr);
+ winPtr->mainPtr->optionRootPtr = NULL;
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkOptionClassChanged --
+ *
+ * This function is invoked when a window's class changes. If the window
+ * is on the option cache, this function flushes any information for the
+ * window, since the new class could change what is relevant.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The option cache may be flushed in part or in whole.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TkOptionClassChanged(
+ TkWindow *winPtr) /* Window whose class changed. */
+{
+ int i, j, *basePtr;
+ ElArray *arrayPtr;
+ ThreadSpecificData *tsdPtr =
+ Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
+
+ if (winPtr->optionLevel == -1) {
+ return;
+ }
+
+ /*
+ * Find the lowest stack level that refers to this window, then flush all
+ * of the levels above the matching one.
+ */
+
+ for (i = 1; i <= tsdPtr->curLevel; i++) {
+ if (tsdPtr->levels[i].winPtr == winPtr) {
+ for (j = i; j <= tsdPtr->curLevel; j++) {
+ tsdPtr->levels[j].winPtr->optionLevel = -1;
+ }
+ tsdPtr->curLevel = i-1;
+ basePtr = tsdPtr->levels[i].bases;
+ for (j = 0; j < NUM_STACKS; j++) {
+ arrayPtr = tsdPtr->stacks[j];
+ arrayPtr->numUsed = basePtr[j];
+ arrayPtr->nextToUse = &arrayPtr->els[arrayPtr->numUsed];
+ }
+ if (tsdPtr->curLevel <= 0) {
+ tsdPtr->cachedWindow = NULL;
+ } else {
+ tsdPtr->cachedWindow = tsdPtr->levels[tsdPtr->curLevel].winPtr;
+ }
+ break;
+ }
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ParsePriority --
+ *
+ * Parse a string priority value.
+ *
+ * Results:
+ * The return value is the integer priority level corresponding to
+ * string, or -1 if string doesn't point to a valid priority level. In
+ * this case, an error message is left in the interp's result.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+ParsePriority(
+ Tcl_Interp *interp, /* Interpreter to use for error reporting. */
+ const char *string) /* Describes a priority level, either
+ * symbolically or numerically. */
+{
+ int priority, c;
+ size_t length;
+
+ c = string[0];
+ length = strlen(string);
+ if ((c == 'w')
+ && (strncmp(string, "widgetDefault", length) == 0)) {
+ return TK_WIDGET_DEFAULT_PRIO;
+ } else if ((c == 's')
+ && (strncmp(string, "startupFile", length) == 0)) {
+ return TK_STARTUP_FILE_PRIO;
+ } else if ((c == 'u')
+ && (strncmp(string, "userDefault", length) == 0)) {
+ return TK_USER_DEFAULT_PRIO;
+ } else if ((c == 'i')
+ && (strncmp(string, "interactive", length) == 0)) {
+ return TK_INTERACTIVE_PRIO;
+ } else {
+ char *end;
+
+ priority = strtoul(string, &end, 0);
+ if ((end == string) || (*end != 0) || (priority < 0)
+ || (priority > 100)) {
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "bad priority level \"%s\": must be "
+ "widgetDefault, startupFile, userDefault, "
+ "interactive, or a number between 0 and 100", string));
+ Tcl_SetErrorCode(interp, "TK", "VALUE", "PRIORITY", NULL);
+ return -1;
+ }
+ }
+ return priority;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * AddFromString --
+ *
+ * Given a string containing lines in the standard format for X resources
+ * (see other documentation for details on what this is), parse the
+ * resource specifications and enter them as options for tkwin's main
+ * window.
+ *
+ * Results:
+ * The return value is a standard Tcl return code. In the case of an
+ * error in parsing string, TCL_ERROR will be returned and an error
+ * message will be left in the interp's result. The memory at string is
+ * totally trashed by this function. If you care about its contents, make
+ * a copy before calling here.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+AddFromString(
+ Tcl_Interp *interp, /* Interpreter to use for reporting results. */
+ Tk_Window tkwin, /* Token for window: options are entered for
+ * this window's main window. */
+ char *string, /* String containing option specifiers. */
+ int priority) /* Priority level to use for options in this
+ * string, such as TK_USER_DEFAULT_PRIO or
+ * TK_INTERACTIVE_PRIO. Must be between 0 and
+ * TK_MAX_PRIO. */
+{
+ register char *src, *dst;
+ char *name, *value;
+ int lineNum;
+
+ src = string;
+ lineNum = 1;
+ while (1) {
+ /*
+ * Skip leading white space and empty lines and comment lines, and
+ * check for the end of the spec.
+ */
+
+ while ((*src == ' ') || (*src == '\t')) {
+ src++;
+ }
+ if ((*src == '#') || (*src == '!')) {
+ do {
+ src++;
+ if ((src[0] == '\\') && (src[1] == '\n')) {
+ src += 2;
+ lineNum++;
+ }
+ } while ((*src != '\n') && (*src != 0));
+ }
+ if (*src == '\n') {
+ src++;
+ lineNum++;
+ continue;
+ }
+ if (*src == '\0') {
+ break;
+ }
+
+ /*
+ * Parse off the option name, collapsing out backslash-newline
+ * sequences of course.
+ */
+
+ dst = name = src;
+ while (*src != ':') {
+ if ((*src == '\0') || (*src == '\n')) {
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "missing colon on line %d", lineNum));
+ Tcl_SetErrorCode(interp, "TK", "OPTIONDB", "COLON", NULL);
+ return TCL_ERROR;
+ }
+ if ((src[0] == '\\') && (src[1] == '\n')) {
+ src += 2;
+ lineNum++;
+ } else {
+ *dst = *src;
+ dst++;
+ src++;
+ }
+ }
+
+ /*
+ * Eliminate trailing white space on the name, and null-terminate
+ * it.
+ */
+
+ while ((dst != name) && ((dst[-1] == ' ') || (dst[-1] == '\t'))) {
+ dst--;
+ }
+ *dst = '\0';
+
+ /*
+ * Skip white space between the name and the value.
+ */
+
+ src++;
+ while ((*src == ' ') || (*src == '\t')) {
+ src++;
+ }
+ if (*src == '\0') {
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "missing value on line %d", lineNum));
+ Tcl_SetErrorCode(interp, "TK", "OPTIONDB", "VALUE", NULL);
+ return TCL_ERROR;
+ }
+
+ /*
+ * Parse off the value, squeezing out backslash-newline sequences
+ * along the way.
+ */
+
+ dst = value = src;
+ while (*src != '\n') {
+ if (*src == '\0') {
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "missing newline on line %d", lineNum));
+ Tcl_SetErrorCode(interp, "TK", "OPTIONDB", "NEWLINE", NULL);
+ return TCL_ERROR;
+ }
+ if (*src == '\\'){
+ if (src[1] == '\n') {
+ src += 2;
+ lineNum++;
+ continue;
+ } else if (src[1] == 'n') {
+ src += 2;
+ *dst++ = '\n';
+ continue;
+ } else if (src[1] == '\t' || src[1] == ' ' || src[1] == '\\') {
+ ++src;
+ } else if (src[1] >= '0' && src[1] <= '3' && src[2] >= '0' &&
+ src[2] <= '9' && src[3] >= '0' && src[3] <= '9') {
+ *dst++ = ((src[1]&7)<<6) | ((src[2]&7)<<3) | (src[3]&7);
+ src += 4;
+ continue;
+ }
+ }
+ *dst++ = *src++;
+ }
+ *dst = 0;
+
+ /*
+ * Enter the option into the database.
+ */
+
+ Tk_AddOption(tkwin, name, value, priority);
+ src++;
+ lineNum++;
+ }
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ReadOptionFile --
+ *
+ * Read a file of options ("resources" in the old X terminology) and load
+ * them into the option database.
+ *
+ * Results:
+ * The return value is a standard Tcl return code. In the case of an
+ * error in parsing string, TCL_ERROR will be returned and an error
+ * message will be left in the interp's result.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+ReadOptionFile(
+ Tcl_Interp *interp, /* Interpreter to use for reporting results. */
+ Tk_Window tkwin, /* Token for window: options are entered for
+ * this window's main window. */
+ const char *fileName, /* Name of file containing options. */
+ int priority) /* Priority level to use for options in this
+ * file, such as TK_USER_DEFAULT_PRIO or
+ * TK_INTERACTIVE_PRIO. Must be between 0 and
+ * TK_MAX_PRIO. */
+{
+ const char *realName;
+ Tcl_Obj *buffer;
+ int result, bufferSize;
+ Tcl_Channel chan;
+ Tcl_DString newName;
+
+ /*
+ * Prevent file system access in a safe interpreter.
+ */
+
+ if (Tcl_IsSafe(interp)) {
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "can't read options from a file in a safe interpreter", -1));
+ Tcl_SetErrorCode(interp, "TK", "SAFE", "OPTION_FILE", NULL);
+ return TCL_ERROR;
+ }
+
+ realName = Tcl_TranslateFileName(interp, fileName, &newName);
+ if (realName == NULL) {
+ return TCL_ERROR;
+ }
+ chan = Tcl_OpenFileChannel(interp, realName, "r", 0);
+ Tcl_DStringFree(&newName);
+ if (chan == NULL) {
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf("couldn't open \"%s\": %s",
+ fileName, Tcl_PosixError(interp)));
+ return TCL_ERROR;
+ }
+
+ buffer = Tcl_NewObj();
+ Tcl_IncrRefCount(buffer);
+ Tcl_SetChannelOption(NULL, chan, "-encoding", "utf-8");
+ bufferSize = Tcl_ReadChars(chan, buffer, -1, 0);
+ if (bufferSize < 0) {
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "error reading file \"%s\": %s",
+ fileName, Tcl_PosixError(interp)));
+ Tcl_Close(NULL, chan);
+ return TCL_ERROR;
+ }
+ Tcl_Close(NULL, chan);
+ result = AddFromString(interp, tkwin, Tcl_GetString(buffer), priority);
+ Tcl_DecrRefCount(buffer);
+ return result;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * NewArray --
+ *
+ * Create a new ElArray structure of a given size.
+ *
+ * Results:
+ * The return value is a pointer to a properly initialized element array
+ * with "numEls" space. The array is marked as having no active elements.
+ *
+ * Side effects:
+ * Memory is allocated.
+ *
+ *--------------------------------------------------------------
+ */
+
+static ElArray *
+NewArray(
+ int numEls) /* How many elements of space to allocate. */
+{
+ register ElArray *arrayPtr = ckalloc(EL_ARRAY_SIZE(numEls));
+
+ arrayPtr->arraySize = numEls;
+ arrayPtr->numUsed = 0;
+ arrayPtr->nextToUse = arrayPtr->els;
+ return arrayPtr;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * ExtendArray --
+ *
+ * Add a new element to an array, extending the array if necessary.
+ *
+ * Results:
+ * The return value is a pointer to the new array, which will be
+ * different from arrayPtr if the array got expanded.
+ *
+ * Side effects:
+ * Memory may be allocated or freed.
+ *
+ *--------------------------------------------------------------
+ */
+
+static ElArray *
+ExtendArray(
+ register ElArray *arrayPtr, /* Array to be extended. */
+ register Element *elPtr) /* Element to be copied into array. */
+{
+ /*
+ * If the current array has filled up, make it bigger.
+ */
+
+ if (arrayPtr->numUsed >= arrayPtr->arraySize) {
+ register int newSize = 2*arrayPtr->arraySize;
+
+ arrayPtr = ckrealloc(arrayPtr, EL_ARRAY_SIZE(newSize));
+ arrayPtr->arraySize = newSize;
+ arrayPtr->nextToUse = &arrayPtr->els[arrayPtr->numUsed];
+ }
+
+ *arrayPtr->nextToUse = *elPtr;
+ arrayPtr->nextToUse++;
+ arrayPtr->numUsed++;
+ return arrayPtr;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * SetupStacks --
+ *
+ * Arrange the stacks so that they cache all the option information for a
+ * particular window.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The stacks are modified to hold information for tkwin and all its
+ * ancestors in the window hierarchy.
+ *
+ *--------------------------------------------------------------
+ */
+
+static void
+SetupStacks(
+ TkWindow *winPtr, /* Window for which information is to be
+ * cached. */
+ int leaf) /* Non-zero means this is the leaf window
+ * being probed. Zero means this is an
+ * ancestor of the desired leaf. */
+{
+ int level, i;
+ const int *iPtr;
+ register StackLevel *levelPtr;
+ register ElArray *arrayPtr;
+ ThreadSpecificData *tsdPtr =
+ Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
+
+ /*
+ * The following array defines the order in which the current stacks are
+ * searched to find matching entries to add to the stacks. Given the
+ * current priority-based scheme, the order below is no longer relevant;
+ * all that matters is that an element is on the list *somewhere*. The
+ * ordering is a relic of the old days when priorities were determined
+ * differently.
+ */
+
+ static const int searchOrder[] = {WILDCARD_NODE_CLASS, WILDCARD_NODE_NAME,
+ EXACT_NODE_CLASS, EXACT_NODE_NAME, -1};
+
+ if (winPtr->mainPtr->optionRootPtr == NULL) {
+ OptionInit(winPtr->mainPtr);
+ }
+
+ /*
+ * Step 1: make sure that options are cached for this window's parent.
+ */
+
+ if (winPtr->parentPtr != NULL) {
+ level = winPtr->parentPtr->optionLevel;
+ if ((level == -1) || (tsdPtr->cachedWindow == NULL)) {
+ SetupStacks(winPtr->parentPtr, 0);
+ level = winPtr->parentPtr->optionLevel;
+ }
+ level++;
+ } else {
+ level = 1;
+ }
+
+ /*
+ * Step 2: pop extra unneeded information off the stacks and mark those
+ * windows as no longer having cached information.
+ */
+
+ if (tsdPtr->curLevel >= level) {
+ while (tsdPtr->curLevel >= level) {
+ tsdPtr->levels[tsdPtr->curLevel].winPtr->optionLevel = -1;
+ tsdPtr->curLevel--;
+ }
+ levelPtr = &tsdPtr->levels[level];
+ for (i = 0; i < NUM_STACKS; i++) {
+ arrayPtr = tsdPtr->stacks[i];
+ arrayPtr->numUsed = levelPtr->bases[i];
+ arrayPtr->nextToUse = &arrayPtr->els[arrayPtr->numUsed];
+ }
+ }
+ tsdPtr->curLevel = winPtr->optionLevel = level;
+
+ /*
+ * Step 3: if the root database information isn't loaded or isn't valid,
+ * initialize level 0 of the stack from the database root (this only
+ * happens if winPtr is a main window).
+ */
+
+ if ((tsdPtr->curLevel == 1)
+ && ((tsdPtr->cachedWindow == NULL)
+ || (tsdPtr->cachedWindow->mainPtr != winPtr->mainPtr))) {
+ for (i = 0; i < NUM_STACKS; i++) {
+ arrayPtr = tsdPtr->stacks[i];
+ arrayPtr->numUsed = 0;
+ arrayPtr->nextToUse = arrayPtr->els;
+ }
+ ExtendStacks(winPtr->mainPtr->optionRootPtr, 0);
+ }
+
+ /*
+ * Step 4: create a new stack level; grow the level array if we've run out
+ * of levels. Clear the stacks for EXACT_LEAF_NAME and EXACT_LEAF_CLASS
+ * (anything that was there is of no use any more).
+ */
+
+ if (tsdPtr->curLevel >= tsdPtr->numLevels) {
+ StackLevel *newLevels =
+ ckalloc(tsdPtr->numLevels * 2 * sizeof(StackLevel));
+
+ memcpy(newLevels, tsdPtr->levels,
+ tsdPtr->numLevels * sizeof(StackLevel));
+ ckfree(tsdPtr->levels);
+ tsdPtr->numLevels *= 2;
+ tsdPtr->levels = newLevels;
+ }
+ levelPtr = &tsdPtr->levels[tsdPtr->curLevel];
+ levelPtr->winPtr = winPtr;
+ arrayPtr = tsdPtr->stacks[EXACT_LEAF_NAME];
+ arrayPtr->numUsed = 0;
+ arrayPtr->nextToUse = arrayPtr->els;
+ arrayPtr = tsdPtr->stacks[EXACT_LEAF_CLASS];
+ arrayPtr->numUsed = 0;
+ arrayPtr->nextToUse = arrayPtr->els;
+ for (i = 0; i < NUM_STACKS; i++) {
+ levelPtr->bases[i] = tsdPtr->stacks[i]->numUsed;
+ }
+
+ /*
+ * Step 5: scan the current stack level looking for matches to this
+ * window's name or class; where found, add new information to the stacks.
+ */
+
+ for (iPtr = searchOrder; *iPtr != -1; iPtr++) {
+ register Element *elPtr;
+ int count;
+ Tk_Uid id;
+
+ i = *iPtr;
+ if (i & CLASS) {
+ id = winPtr->classUid;
+ } else {
+ id = winPtr->nameUid;
+ }
+ elPtr = tsdPtr->stacks[i]->els;
+ count = levelPtr->bases[i];
+
+ /*
+ * For wildcard stacks, check all entries; for non-wildcard stacks,
+ * only check things that matched in the parent.
+ */
+
+ if (!(i & WILDCARD)) {
+ elPtr += levelPtr[-1].bases[i];
+ count -= levelPtr[-1].bases[i];
+ }
+ for ( ; count > 0; elPtr++, count--) {
+ if (elPtr->nameUid != id) {
+ continue;
+ }
+ ExtendStacks(elPtr->child.arrayPtr, leaf);
+ }
+ }
+ tsdPtr->cachedWindow = winPtr;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * ExtendStacks --
+ *
+ * Given an element array, copy all the elements from the array onto the
+ * system stacks (except for irrelevant leaf elements).
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The option stacks are extended.
+ *
+ *--------------------------------------------------------------
+ */
+
+static void
+ExtendStacks(
+ ElArray *arrayPtr, /* Array of elements to copy onto stacks. */
+ int leaf) /* If zero, then don't copy exact leaf
+ * elements. */
+{
+ register int count;
+ register Element *elPtr;
+ ThreadSpecificData *tsdPtr =
+ Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
+
+ for (elPtr = arrayPtr->els, count = arrayPtr->numUsed;
+ count > 0; elPtr++, count--) {
+ if (!(elPtr->flags & (NODE|WILDCARD)) && !leaf) {
+ continue;
+ }
+ tsdPtr->stacks[elPtr->flags] =
+ ExtendArray(tsdPtr->stacks[elPtr->flags], elPtr);
+ }
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * OptionThreadExitProc --
+ *
+ * Free data structures for option handling.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Option-related data structures get freed.
+ *
+ *--------------------------------------------------------------
+ */
+
+static void
+OptionThreadExitProc(
+ ClientData clientData) /* not used */
+{
+ ThreadSpecificData *tsdPtr =
+ Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
+
+ if (tsdPtr->initialized) {
+ int i;
+
+ for (i = 0; i < NUM_STACKS; i++) {
+ ckfree(tsdPtr->stacks[i]);
+ }
+ ckfree(tsdPtr->levels);
+ tsdPtr->initialized = 0;
+ }
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * OptionInit --
+ *
+ * Initialize data structures for option handling.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Option-related data structures get initialized.
+ *
+ *--------------------------------------------------------------
+ */
+
+static void
+OptionInit(
+ register TkMainInfo *mainPtr)
+ /* Top-level information about window that
+ * isn't initialized yet. */
+{
+ int i;
+ Tcl_Interp *interp;
+ ThreadSpecificData *tsdPtr =
+ Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
+ Element *defaultMatchPtr = &tsdPtr->defaultMatch;
+
+ /*
+ * First, once-only initialization.
+ */
+
+ if (tsdPtr->initialized == 0) {
+ tsdPtr->initialized = 1;
+ tsdPtr->cachedWindow = NULL;
+ tsdPtr->numLevels = 5;
+ tsdPtr->curLevel = -1;
+ tsdPtr->serial = 0;
+
+ tsdPtr->levels = ckalloc(5 * sizeof(StackLevel));
+ for (i = 0; i < NUM_STACKS; i++) {
+ tsdPtr->stacks[i] = NewArray(10);
+ tsdPtr->levels[0].bases[i] = 0;
+ }
+
+ defaultMatchPtr->nameUid = NULL;
+ defaultMatchPtr->child.valueUid = NULL;
+ defaultMatchPtr->priority = -1;
+ defaultMatchPtr->flags = 0;
+ Tcl_CreateThreadExitHandler(OptionThreadExitProc, NULL);
+ }
+
+ /*
+ * Then, per-main-window initialization. Create and delete dummy
+ * interpreter for message logging.
+ */
+
+ mainPtr->optionRootPtr = NewArray(20);
+ interp = Tcl_CreateInterp();
+ GetDefaultOptions(interp, mainPtr->winPtr);
+ Tcl_DeleteInterp(interp);
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * ClearOptionTree --
+ *
+ * This function is called to erase everything in a hierarchical option
+ * database.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * All the options associated with arrayPtr are deleted, along with all
+ * option subtrees. The space pointed to by arrayPtr is freed.
+ *
+ *--------------------------------------------------------------
+ */
+
+static void
+ClearOptionTree(
+ ElArray *arrayPtr) /* Array of options; delete everything
+ * referred to recursively by this. */
+{
+ register Element *elPtr;
+ int count;
+
+ for (count = arrayPtr->numUsed, elPtr = arrayPtr->els; count > 0;
+ count--, elPtr++) {
+ if (elPtr->flags & NODE) {
+ ClearOptionTree(elPtr->child.arrayPtr);
+ }
+ }
+ ckfree(arrayPtr);
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * GetDefaultOptions --
+ *
+ * This function is invoked to load the default set of options for a
+ * window.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Options are added to those for winPtr's main window. If there exists a
+ * RESOURCE_MANAGER proprety for winPtr's display, that is used.
+ * Otherwise, the .Xdefaults file in the user's home directory is used.
+ *
+ *--------------------------------------------------------------
+ */
+
+static int
+GetDefaultOptions(
+ Tcl_Interp *interp, /* Interpreter to use for error reporting. */
+ TkWindow *winPtr) /* Fetch option defaults for main window
+ * associated with this. */
+{
+ char *regProp, **regPropPtr = &regProp;
+ int result, actualFormat;
+ unsigned long numItems, bytesAfter;
+ Atom actualType;
+
+ /*
+ * Try the RESOURCE_MANAGER property on the root window first.
+ */
+
+ regProp = NULL;
+ result = XGetWindowProperty(winPtr->display,
+ RootWindow(winPtr->display, 0), XA_RESOURCE_MANAGER, 0, 100000,
+ False, XA_STRING, &actualType, &actualFormat, &numItems,
+ &bytesAfter, (unsigned char **) regPropPtr);
+
+ if ((result == Success) && (actualType == XA_STRING)
+ && (actualFormat == 8)) {
+ result = AddFromString(interp, (Tk_Window) winPtr, regProp,
+ TK_USER_DEFAULT_PRIO);
+ XFree(regProp);
+ return result;
+ }
+
+ /*
+ * No luck there. Try a .Xdefaults file in the user's home directory.
+ */
+
+ if (regProp != NULL) {
+ XFree(regProp);
+ }
+ result = ReadOptionFile(interp, (Tk_Window) winPtr, "~/.Xdefaults",
+ TK_USER_DEFAULT_PRIO);
+ return result;
+}
+
+/*
+ * Local Variables:
+ * mode: c
+ * c-basic-offset: 4
+ * fill-column: 78
+ * End:
+ */
diff --git a/tk8.6/generic/tkPack.c b/tk8.6/generic/tkPack.c
new file mode 100644
index 0000000..88a4b2d
--- /dev/null
+++ b/tk8.6/generic/tkPack.c
@@ -0,0 +1,1859 @@
+/*
+ * tkPack.c --
+ *
+ * This file contains code to implement the "packer" geometry manager for
+ * Tk.
+ *
+ * Copyright (c) 1990-1994 The Regents of the University of California.
+ * Copyright (c) 1994-1997 Sun Microsystems, Inc.
+ *
+ * See the file "license.terms" for information on usage and redistribution of
+ * this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ */
+
+#include "tkInt.h"
+
+typedef enum {TOP, BOTTOM, LEFT, RIGHT} Side;
+static const char *const sideNames[] = {
+ "top", "bottom", "left", "right", NULL
+};
+
+/*
+ * For each window that the packer cares about (either because the window is
+ * managed by the packer or because the window has slaves that are managed by
+ * the packer), there is a structure of the following type:
+ */
+
+typedef struct Packer {
+ Tk_Window tkwin; /* Tk token for window. NULL means that the
+ * window has been deleted, but the packet
+ * hasn't had a chance to clean up yet because
+ * the structure is still in use. */
+ struct Packer *masterPtr; /* Master window within which this window is
+ * packed (NULL means this window isn't
+ * managed by the packer). */
+ struct Packer *nextPtr; /* Next window packed within same master. List
+ * is priority-ordered: first on list gets
+ * packed first. */
+ struct Packer *slavePtr; /* First in list of slaves packed inside this
+ * window (NULL means no packed slaves). */
+ Side side; /* Side of master against which this window is
+ * packed. */
+ Tk_Anchor anchor; /* If frame allocated for window is larger
+ * than window needs, this indicates how where
+ * to position window in frame. */
+ int padX, padY; /* Total additional pixels to leave around the
+ * window. Some is of this space is on each
+ * side. This is space *outside* the window:
+ * we'll allocate extra space in frame but
+ * won't enlarge window). */
+ int padLeft, padTop; /* The part of padX or padY to use on the left
+ * or top of the widget, respectively. By
+ * default, this is half of padX or padY. */
+ int iPadX, iPadY; /* Total extra pixels to allocate inside the
+ * window (half of this amount will appear on
+ * each side). */
+ int doubleBw; /* Twice the window's last known border width.
+ * If this changes, the window must be
+ * repacked within its master. */
+ int *abortPtr; /* If non-NULL, it means that there is a
+ * nested call to ArrangePacking already
+ * working on this window. *abortPtr may be
+ * set to 1 to abort that nested call. This
+ * happens, for example, if tkwin or any of
+ * its slaves is deleted. */
+ int flags; /* Miscellaneous flags; see below for
+ * definitions. */
+} Packer;
+
+/*
+ * Flag values for Packer structures:
+ *
+ * REQUESTED_REPACK: 1 means a Tcl_DoWhenIdle request has already
+ * been made to repack all the slaves of this
+ * window.
+ * FILLX: 1 means if frame allocated for window is wider
+ * than window needs, expand window to fill
+ * frame. 0 means don't make window any larger
+ * than needed.
+ * FILLY: Same as FILLX, except for height.
+ * EXPAND: 1 means this window's frame will absorb any
+ * extra space in the master window.
+ * OLD_STYLE: 1 means this window is being managed with the
+ * old-style packer algorithms (before Tk version
+ * 3.3). The main difference is that padding and
+ * filling are done differently.
+ * DONT_PROPAGATE: 1 means don't set this window's requested
+ * size. 0 means if this window is a master then
+ * Tk will set its requested size to fit the
+ * needs of its slaves.
+ * ALLOCED_MASTER 1 means that Pack has allocated itself as
+ * geometry master for this window.
+ */
+
+#define REQUESTED_REPACK 1
+#define FILLX 2
+#define FILLY 4
+#define EXPAND 8
+#define OLD_STYLE 16
+#define DONT_PROPAGATE 32
+#define ALLOCED_MASTER 64
+
+/*
+ * The following structure is the official type record for the packer:
+ */
+
+static void PackReqProc(ClientData clientData, Tk_Window tkwin);
+static void PackLostSlaveProc(ClientData clientData,
+ Tk_Window tkwin);
+
+static const Tk_GeomMgr packerType = {
+ "pack", /* name */
+ PackReqProc, /* requestProc */
+ PackLostSlaveProc, /* lostSlaveProc */
+};
+
+/*
+ * Forward declarations for functions defined later in this file:
+ */
+
+static void ArrangePacking(ClientData clientData);
+static int ConfigureSlaves(Tcl_Interp *interp, Tk_Window tkwin,
+ int objc, Tcl_Obj *const objv[]);
+static void DestroyPacker(void *memPtr);
+static Packer * GetPacker(Tk_Window tkwin);
+static int PackAfter(Tcl_Interp *interp, Packer *prevPtr,
+ Packer *masterPtr, int objc,Tcl_Obj *const objv[]);
+static void PackStructureProc(ClientData clientData,
+ XEvent *eventPtr);
+static void Unlink(Packer *packPtr);
+static int XExpansion(Packer *slavePtr, int cavityWidth);
+static int YExpansion(Packer *slavePtr, int cavityHeight);
+
+/*
+ *------------------------------------------------------------------------
+ *
+ * TkAppendPadAmount --
+ *
+ * This function generates a text value that describes one of the -padx,
+ * -pady, -ipadx, or -ipady configuration options. The text value
+ * generated is appended to the given Tcl_Obj.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * None.
+ *
+ *------------------------------------------------------------------------
+ */
+
+void
+TkAppendPadAmount(
+ Tcl_Obj *bufferObj, /* The interpreter into which the result is
+ * written. */
+ const char *switchName, /* One of "padx", "pady", "ipadx" or
+ * "ipady" */
+ int halfSpace, /* The left or top padding amount */
+ int allSpace) /* The total amount of padding */
+{
+ Tcl_Obj *padding[2];
+
+ if (halfSpace*2 == allSpace) {
+ Tcl_DictObjPut(NULL, bufferObj, Tcl_NewStringObj(switchName, -1),
+ Tcl_NewIntObj(halfSpace));
+ } else {
+ padding[0] = Tcl_NewIntObj(halfSpace);
+ padding[1] = Tcl_NewIntObj(allSpace - halfSpace);
+ Tcl_DictObjPut(NULL, bufferObj, Tcl_NewStringObj(switchName, -1),
+ Tcl_NewListObj(2, padding));
+ }
+}
+
+/*
+ *------------------------------------------------------------------------
+ *
+ * Tk_PackCmd --
+ *
+ * This function is invoked to process the "pack" Tcl command. See the
+ * user documentation for details on what it does.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * See the user documentation.
+ *
+ *------------------------------------------------------------------------
+ */
+
+int
+Tk_PackObjCmd(
+ ClientData 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 = clientData;
+ const char *argv2;
+ static const char *const optionStrings[] = {
+ /* after, append, before and unpack are deprecated */
+ "after", "append", "before", "unpack",
+ "configure", "forget", "info", "propagate", "slaves", NULL };
+ enum options {
+ PACK_AFTER, PACK_APPEND, PACK_BEFORE, PACK_UNPACK,
+ PACK_CONFIGURE, PACK_FORGET, PACK_INFO, PACK_PROPAGATE, PACK_SLAVES };
+ int index;
+
+ if (objc >= 2) {
+ const char *string = Tcl_GetString(objv[1]);
+
+ if (string[0] == '.') {
+ return ConfigureSlaves(interp, tkwin, objc-1, objv+1);
+ }
+ }
+ if (objc < 3) {
+ Tcl_WrongNumArgs(interp, 1, objv, "option arg ?arg ...?");
+ return TCL_ERROR;
+ }
+
+ if (Tcl_GetIndexFromObjStruct(interp, objv[1], optionStrings,
+ sizeof(char *), "option", 0, &index) != TCL_OK) {
+ /*
+ * Call it again without the deprecated ones to get a proper error
+ * message. This works well since there can't be any ambiguity between
+ * deprecated and new options.
+ */
+
+ Tcl_ResetResult(interp);
+ Tcl_GetIndexFromObjStruct(interp, objv[1], &optionStrings[4],
+ sizeof(char *), "option", 0, &index);
+ return TCL_ERROR;
+ }
+
+ argv2 = Tcl_GetString(objv[2]);
+ switch ((enum options) index) {
+ case PACK_AFTER: {
+ Packer *prevPtr;
+ Tk_Window tkwin2;
+
+ if (TkGetWindowFromObj(interp, tkwin, objv[2], &tkwin2) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ prevPtr = GetPacker(tkwin2);
+ if (prevPtr->masterPtr == NULL) {
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "window \"%s\" isn't packed", argv2));
+ Tcl_SetErrorCode(interp, "TK", "PACK", "NOT_PACKED", NULL);
+ return TCL_ERROR;
+ }
+ return PackAfter(interp, prevPtr, prevPtr->masterPtr, objc-3, objv+3);
+ }
+ case PACK_APPEND: {
+ Packer *masterPtr;
+ register Packer *prevPtr;
+ Tk_Window tkwin2;
+
+ if (TkGetWindowFromObj(interp, tkwin, objv[2], &tkwin2) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ masterPtr = GetPacker(tkwin2);
+ prevPtr = masterPtr->slavePtr;
+ if (prevPtr != NULL) {
+ while (prevPtr->nextPtr != NULL) {
+ prevPtr = prevPtr->nextPtr;
+ }
+ }
+ return PackAfter(interp, prevPtr, masterPtr, objc-3, objv+3);
+ }
+ case PACK_BEFORE: {
+ Packer *packPtr, *masterPtr;
+ register Packer *prevPtr;
+ Tk_Window tkwin2;
+
+ if (TkGetWindowFromObj(interp, tkwin, objv[2], &tkwin2) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ packPtr = GetPacker(tkwin2);
+ if (packPtr->masterPtr == NULL) {
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "window \"%s\" isn't packed", argv2));
+ Tcl_SetErrorCode(interp, "TK", "PACK", "NOT_PACKED", NULL);
+ return TCL_ERROR;
+ }
+ masterPtr = packPtr->masterPtr;
+ prevPtr = masterPtr->slavePtr;
+ if (prevPtr == packPtr) {
+ prevPtr = NULL;
+ } else {
+ for ( ; ; prevPtr = prevPtr->nextPtr) {
+ if (prevPtr == NULL) {
+ Tcl_Panic("\"pack before\" couldn't find predecessor");
+ }
+ if (prevPtr->nextPtr == packPtr) {
+ break;
+ }
+ }
+ }
+ return PackAfter(interp, prevPtr, masterPtr, objc-3, objv+3);
+ }
+ case PACK_CONFIGURE:
+ if (argv2[0] != '.') {
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "bad argument \"%s\": must be name of window", argv2));
+ Tcl_SetErrorCode(interp, "TK", "VALUE", "WINDOW_PATH", NULL);
+ return TCL_ERROR;
+ }
+ return ConfigureSlaves(interp, tkwin, objc-2, objv+2);
+ case PACK_FORGET: {
+ Tk_Window slave;
+ Packer *slavePtr;
+ int i;
+
+ for (i = 2; i < objc; i++) {
+ if (TkGetWindowFromObj(interp, tkwin, objv[i], &slave) != TCL_OK) {
+ continue;
+ }
+ slavePtr = GetPacker(slave);
+ if ((slavePtr != NULL) && (slavePtr->masterPtr != NULL)) {
+ Tk_ManageGeometry(slave, NULL, NULL);
+ if (slavePtr->masterPtr->tkwin != Tk_Parent(slavePtr->tkwin)) {
+ Tk_UnmaintainGeometry(slavePtr->tkwin,
+ slavePtr->masterPtr->tkwin);
+ }
+ Unlink(slavePtr);
+ Tk_UnmapWindow(slavePtr->tkwin);
+ }
+ }
+ break;
+ }
+ case PACK_INFO: {
+ register Packer *slavePtr;
+ Tk_Window slave;
+ Tcl_Obj *infoObj;
+
+ if (objc != 3) {
+ Tcl_WrongNumArgs(interp, 2, objv, "window");
+ return TCL_ERROR;
+ }
+ if (TkGetWindowFromObj(interp, tkwin, objv[2], &slave) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ slavePtr = GetPacker(slave);
+ if (slavePtr->masterPtr == NULL) {
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "window \"%s\" isn't packed", argv2));
+ Tcl_SetErrorCode(interp, "TK", "PACK", "NOT_PACKED", NULL);
+ return TCL_ERROR;
+ }
+
+ infoObj = Tcl_NewObj();
+ Tcl_DictObjPut(NULL, infoObj, Tcl_NewStringObj("-in", -1),
+ TkNewWindowObj(slavePtr->masterPtr->tkwin));
+ Tcl_DictObjPut(NULL, infoObj, Tcl_NewStringObj("-anchor", -1),
+ Tcl_NewStringObj(Tk_NameOfAnchor(slavePtr->anchor), -1));
+ Tcl_DictObjPut(NULL, infoObj, Tcl_NewStringObj("-expand", -1),
+ Tcl_NewBooleanObj(slavePtr->flags & EXPAND));
+ switch (slavePtr->flags & (FILLX|FILLY)) {
+ case 0:
+ Tcl_DictObjPut(NULL, infoObj, Tcl_NewStringObj("-fill", -1),
+ Tcl_NewStringObj("none", -1));
+ break;
+ case FILLX:
+ Tcl_DictObjPut(NULL, infoObj, Tcl_NewStringObj("-fill", -1),
+ Tcl_NewStringObj("x", -1));
+ break;
+ case FILLY:
+ Tcl_DictObjPut(NULL, infoObj, Tcl_NewStringObj("-fill", -1),
+ Tcl_NewStringObj("y", -1));
+ break;
+ case FILLX|FILLY:
+ Tcl_DictObjPut(NULL, infoObj, Tcl_NewStringObj("-fill", -1),
+ Tcl_NewStringObj("both", -1));
+ break;
+ }
+ TkAppendPadAmount(infoObj, "-ipadx", slavePtr->iPadX/2, slavePtr->iPadX);
+ TkAppendPadAmount(infoObj, "-ipady", slavePtr->iPadY/2, slavePtr->iPadY);
+ TkAppendPadAmount(infoObj, "-padx", slavePtr->padLeft,slavePtr->padX);
+ TkAppendPadAmount(infoObj, "-pady", slavePtr->padTop, slavePtr->padY);
+ Tcl_DictObjPut(NULL, infoObj, Tcl_NewStringObj("-side", -1),
+ Tcl_NewStringObj(sideNames[slavePtr->side], -1));
+ Tcl_SetObjResult(interp, infoObj);
+ break;
+ }
+ case PACK_PROPAGATE: {
+ Tk_Window master;
+ Packer *masterPtr;
+ int propagate;
+
+ if (objc > 4) {
+ Tcl_WrongNumArgs(interp, 2, objv, "window ?boolean?");
+ return TCL_ERROR;
+ }
+ if (TkGetWindowFromObj(interp, tkwin, objv[2], &master) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ masterPtr = GetPacker(master);
+ if (objc == 3) {
+ Tcl_SetObjResult(interp,
+ Tcl_NewBooleanObj(!(masterPtr->flags & DONT_PROPAGATE)));
+ return TCL_OK;
+ }
+ if (Tcl_GetBooleanFromObj(interp, objv[3], &propagate) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (propagate) {
+ /*
+ * If we have slaves, we need to register as geometry master.
+ */
+
+ if (masterPtr->slavePtr != NULL) {
+ if (TkSetGeometryMaster(interp, master, "pack") != TCL_OK) {
+ return TCL_ERROR;
+ }
+ masterPtr->flags |= ALLOCED_MASTER;
+ }
+ masterPtr->flags &= ~DONT_PROPAGATE;
+
+ /*
+ * Repack the master to allow new geometry information to
+ * propagate upwards to the master's master.
+ */
+
+ if (masterPtr->abortPtr != NULL) {
+ *masterPtr->abortPtr = 1;
+ }
+ if (!(masterPtr->flags & REQUESTED_REPACK)) {
+ masterPtr->flags |= REQUESTED_REPACK;
+ Tcl_DoWhenIdle(ArrangePacking, masterPtr);
+ }
+ } else {
+ if (masterPtr->flags & ALLOCED_MASTER) {
+ TkFreeGeometryMaster(master, "pack");
+ masterPtr->flags &= ~ALLOCED_MASTER;
+ }
+ masterPtr->flags |= DONT_PROPAGATE;
+ }
+ break;
+ }
+ case PACK_SLAVES: {
+ Tk_Window master;
+ Packer *masterPtr, *slavePtr;
+ Tcl_Obj *resultObj;
+
+ if (objc != 3) {
+ Tcl_WrongNumArgs(interp, 2, objv, "window");
+ return TCL_ERROR;
+ }
+ if (TkGetWindowFromObj(interp, tkwin, objv[2], &master) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ resultObj = Tcl_NewObj();
+ masterPtr = GetPacker(master);
+ for (slavePtr = masterPtr->slavePtr; slavePtr != NULL;
+ slavePtr = slavePtr->nextPtr) {
+ Tcl_ListObjAppendElement(NULL, resultObj,
+ TkNewWindowObj(slavePtr->tkwin));
+ }
+ Tcl_SetObjResult(interp, resultObj);
+ break;
+ }
+ case PACK_UNPACK: {
+ Tk_Window tkwin2;
+ Packer *packPtr;
+
+ if (objc != 3) {
+ Tcl_WrongNumArgs(interp, 2, objv, "window");
+ return TCL_ERROR;
+ }
+ if (TkGetWindowFromObj(interp, tkwin, objv[2], &tkwin2) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ packPtr = GetPacker(tkwin2);
+ if ((packPtr != NULL) && (packPtr->masterPtr != NULL)) {
+ Tk_ManageGeometry(tkwin2, NULL, NULL);
+ if (packPtr->masterPtr->tkwin != Tk_Parent(packPtr->tkwin)) {
+ Tk_UnmaintainGeometry(packPtr->tkwin,
+ packPtr->masterPtr->tkwin);
+ }
+ Unlink(packPtr);
+ Tk_UnmapWindow(packPtr->tkwin);
+ }
+ break;
+ }
+ }
+
+ return TCL_OK;
+}
+
+/*
+ *------------------------------------------------------------------------
+ *
+ * PackReqProc --
+ *
+ * This function is invoked by Tk_GeometryRequest for windows managed by
+ * the packer.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Arranges for tkwin, and all its managed siblings, to be re-packed at
+ * the next idle point.
+ *
+ *------------------------------------------------------------------------
+ */
+
+ /* ARGSUSED */
+static void
+PackReqProc(
+ ClientData clientData, /* Packer's information about window that got
+ * new preferred geometry. */
+ Tk_Window tkwin) /* Other Tk-related information about the
+ * window. */
+{
+ register Packer *packPtr = clientData;
+
+ packPtr = packPtr->masterPtr;
+ if (!(packPtr->flags & REQUESTED_REPACK)) {
+ packPtr->flags |= REQUESTED_REPACK;
+ Tcl_DoWhenIdle(ArrangePacking, packPtr);
+ }
+}
+
+/*
+ *------------------------------------------------------------------------
+ *
+ * PackLostSlaveProc --
+ *
+ * This function is invoked by Tk whenever some other geometry claims
+ * control over a slave that used to be managed by us.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Forgets all packer-related information about the slave.
+ *
+ *------------------------------------------------------------------------
+ */
+
+ /* ARGSUSED */
+static void
+PackLostSlaveProc(
+ ClientData clientData, /* Packer structure for slave window that was
+ * stolen away. */
+ Tk_Window tkwin) /* Tk's handle for the slave window. */
+{
+ register Packer *slavePtr = clientData;
+
+ if (slavePtr->masterPtr->tkwin != Tk_Parent(slavePtr->tkwin)) {
+ Tk_UnmaintainGeometry(slavePtr->tkwin, slavePtr->masterPtr->tkwin);
+ }
+ Unlink(slavePtr);
+ Tk_UnmapWindow(slavePtr->tkwin);
+}
+
+/*
+ *------------------------------------------------------------------------
+ *
+ * ArrangePacking --
+ *
+ * This function is invoked (using the Tcl_DoWhenIdle mechanism) to
+ * re-layout a set of windows managed by the packer. It is invoked at
+ * idle time so that a series of packer requests can be merged into a
+ * single layout operation.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The packed slaves of masterPtr may get resized or moved.
+ *
+ *------------------------------------------------------------------------
+ */
+
+static void
+ArrangePacking(
+ ClientData clientData) /* Structure describing master whose slaves
+ * are to be re-layed out. */
+{
+ register Packer *masterPtr = clientData;
+ register Packer *slavePtr;
+ int cavityX, cavityY, cavityWidth, cavityHeight;
+ /* These variables keep track of the
+ * as-yet-unallocated space remaining in the
+ * middle of the master window. */
+ int frameX, frameY, frameWidth, frameHeight;
+ /* These variables keep track of the frame
+ * allocated to the current window. */
+ int x, y, width, height; /* These variables are used to hold the actual
+ * geometry of the current window. */
+ int abort; /* May get set to non-zero to abort this
+ * repacking operation. */
+ int borderX, borderY;
+ int borderTop, borderBtm;
+ int borderLeft, borderRight;
+ int maxWidth, maxHeight, tmp;
+
+ masterPtr->flags &= ~REQUESTED_REPACK;
+
+ /*
+ * If the master has no slaves anymore, then don't do anything at all:
+ * just leave the master's size as-is.
+ */
+
+ if (masterPtr->slavePtr == NULL) {
+ return;
+ }
+
+ /*
+ * Abort any nested call to ArrangePacking for this window, since we'll do
+ * everything necessary here, and set up so this call can be aborted if
+ * necessary.
+ */
+
+ if (masterPtr->abortPtr != NULL) {
+ *masterPtr->abortPtr = 1;
+ }
+ masterPtr->abortPtr = &abort;
+ abort = 0;
+ Tcl_Preserve(masterPtr);
+
+ /*
+ * Pass #1: scan all the slaves to figure out the total amount of space
+ * needed. Two separate width and height values are computed:
+ *
+ * width - Holds the sum of the widths (plus padding) of all the
+ * slaves seen so far that were packed LEFT or RIGHT.
+ * height - Holds the sum of the heights (plus padding) of all the
+ * slaves seen so far that were packed TOP or BOTTOM.
+ *
+ * maxWidth - Gradually builds up the width needed by the master to
+ * just barely satisfy all the slave's needs. For each
+ * slave, the code computes the width needed for all the
+ * slaves so far and updates maxWidth if the new value is
+ * greater.
+ * maxHeight - Same as maxWidth, except keeps height info.
+ */
+
+ width = maxWidth = Tk_InternalBorderLeft(masterPtr->tkwin) +
+ Tk_InternalBorderRight(masterPtr->tkwin);
+ height = maxHeight = Tk_InternalBorderTop(masterPtr->tkwin) +
+ Tk_InternalBorderBottom(masterPtr->tkwin);
+ for (slavePtr = masterPtr->slavePtr; slavePtr != NULL;
+ slavePtr = slavePtr->nextPtr) {
+ if ((slavePtr->side == TOP) || (slavePtr->side == BOTTOM)) {
+ tmp = Tk_ReqWidth(slavePtr->tkwin) + slavePtr->doubleBw
+ + slavePtr->padX + slavePtr->iPadX + width;
+ if (tmp > maxWidth) {
+ maxWidth = tmp;
+ }
+ height += Tk_ReqHeight(slavePtr->tkwin) + slavePtr->doubleBw
+ + slavePtr->padY + slavePtr->iPadY;
+ } else {
+ tmp = Tk_ReqHeight(slavePtr->tkwin) + slavePtr->doubleBw
+ + slavePtr->padY + slavePtr->iPadY + height;
+ if (tmp > maxHeight) {
+ maxHeight = tmp;
+ }
+ width += Tk_ReqWidth(slavePtr->tkwin) + slavePtr->doubleBw
+ + slavePtr->padX + slavePtr->iPadX;
+ }
+ }
+ if (width > maxWidth) {
+ maxWidth = width;
+ }
+ if (height > maxHeight) {
+ maxHeight = height;
+ }
+
+ if (maxWidth < Tk_MinReqWidth(masterPtr->tkwin)) {
+ maxWidth = Tk_MinReqWidth(masterPtr->tkwin);
+ }
+ if (maxHeight < Tk_MinReqHeight(masterPtr->tkwin)) {
+ maxHeight = Tk_MinReqHeight(masterPtr->tkwin);
+ }
+
+ /*
+ * If the total amount of space needed in the master window has changed,
+ * and if we're propagating geometry information, then notify the next
+ * geometry manager up and requeue ourselves to start again after the
+ * master has had a chance to resize us.
+ */
+
+ if (((maxWidth != Tk_ReqWidth(masterPtr->tkwin))
+ || (maxHeight != Tk_ReqHeight(masterPtr->tkwin)))
+ && !(masterPtr->flags & DONT_PROPAGATE)) {
+ Tk_GeometryRequest(masterPtr->tkwin, maxWidth, maxHeight);
+ masterPtr->flags |= REQUESTED_REPACK;
+ Tcl_DoWhenIdle(ArrangePacking, masterPtr);
+ goto done;
+ }
+
+ /*
+ * Pass #2: scan the slaves a second time assigning new sizes. The
+ * "cavity" variables keep track of the unclaimed space in the cavity of
+ * the window; this shrinks inward as we allocate windows around the
+ * edges. The "frame" variables keep track of the space allocated to the
+ * current window and its frame. The current window is then placed
+ * somewhere inside the frame, depending on anchor.
+ */
+
+ cavityX = x = Tk_InternalBorderLeft(masterPtr->tkwin);
+ cavityY = y = Tk_InternalBorderTop(masterPtr->tkwin);
+ cavityWidth = Tk_Width(masterPtr->tkwin) -
+ Tk_InternalBorderLeft(masterPtr->tkwin) -
+ Tk_InternalBorderRight(masterPtr->tkwin);
+ cavityHeight = Tk_Height(masterPtr->tkwin) -
+ Tk_InternalBorderTop(masterPtr->tkwin) -
+ Tk_InternalBorderBottom(masterPtr->tkwin);
+ for (slavePtr = masterPtr->slavePtr; slavePtr != NULL;
+ slavePtr = slavePtr->nextPtr) {
+ if ((slavePtr->side == TOP) || (slavePtr->side == BOTTOM)) {
+ frameWidth = cavityWidth;
+ frameHeight = Tk_ReqHeight(slavePtr->tkwin) + slavePtr->doubleBw
+ + slavePtr->padY + slavePtr->iPadY;
+ if (slavePtr->flags & EXPAND) {
+ frameHeight += YExpansion(slavePtr, cavityHeight);
+ }
+ cavityHeight -= frameHeight;
+ if (cavityHeight < 0) {
+ frameHeight += cavityHeight;
+ cavityHeight = 0;
+ }
+ frameX = cavityX;
+ if (slavePtr->side == TOP) {
+ frameY = cavityY;
+ cavityY += frameHeight;
+ } else {
+ frameY = cavityY + cavityHeight;
+ }
+ } else {
+ frameHeight = cavityHeight;
+ frameWidth = Tk_ReqWidth(slavePtr->tkwin) + slavePtr->doubleBw
+ + slavePtr->padX + slavePtr->iPadX;
+ if (slavePtr->flags & EXPAND) {
+ frameWidth += XExpansion(slavePtr, cavityWidth);
+ }
+ cavityWidth -= frameWidth;
+ if (cavityWidth < 0) {
+ frameWidth += cavityWidth;
+ cavityWidth = 0;
+ }
+ frameY = cavityY;
+ if (slavePtr->side == LEFT) {
+ frameX = cavityX;
+ cavityX += frameWidth;
+ } else {
+ frameX = cavityX + cavityWidth;
+ }
+ }
+
+ /*
+ * Now that we've got the size of the frame for the window, compute
+ * the window's actual size and location using the fill, padding, and
+ * frame factors. The variables "borderX" and "borderY" are used to
+ * handle the differences between old-style packing and the new style
+ * (in old-style, iPadX and iPadY are always zero and padding is
+ * completely ignored except when computing frame size).
+ */
+
+ if (slavePtr->flags & OLD_STYLE) {
+ borderX = borderY = 0;
+ borderTop = borderBtm = 0;
+ borderLeft = borderRight = 0;
+ } else {
+ borderX = slavePtr->padX;
+ borderY = slavePtr->padY;
+ borderLeft = slavePtr->padLeft;
+ borderRight = borderX - borderLeft;
+ borderTop = slavePtr->padTop;
+ borderBtm = borderY - borderTop;
+ }
+ width = Tk_ReqWidth(slavePtr->tkwin) + slavePtr->doubleBw
+ + slavePtr->iPadX;
+ if ((slavePtr->flags & FILLX)
+ || (width > (frameWidth - borderX))) {
+ width = frameWidth - borderX;
+ }
+ height = Tk_ReqHeight(slavePtr->tkwin) + slavePtr->doubleBw
+ + slavePtr->iPadY;
+ if ((slavePtr->flags & FILLY)
+ || (height > (frameHeight - borderY))) {
+ height = frameHeight - borderY;
+ }
+ switch (slavePtr->anchor) {
+ case TK_ANCHOR_N:
+ x = frameX + (borderLeft + frameWidth - width - borderRight)/2;
+ y = frameY + borderTop;
+ break;
+ case TK_ANCHOR_NE:
+ x = frameX + frameWidth - width - borderRight;
+ y = frameY + borderTop;
+ break;
+ case TK_ANCHOR_E:
+ x = frameX + frameWidth - width - borderRight;
+ y = frameY + (borderTop + frameHeight - height - borderBtm)/2;
+ break;
+ case TK_ANCHOR_SE:
+ x = frameX + frameWidth - width - borderRight;
+ y = frameY + frameHeight - height - borderBtm;
+ break;
+ case TK_ANCHOR_S:
+ x = frameX + (borderLeft + frameWidth - width - borderRight)/2;
+ y = frameY + frameHeight - height - borderBtm;
+ break;
+ case TK_ANCHOR_SW:
+ x = frameX + borderLeft;
+ y = frameY + frameHeight - height - borderBtm;
+ break;
+ case TK_ANCHOR_W:
+ x = frameX + borderLeft;
+ y = frameY + (borderTop + frameHeight - height - borderBtm)/2;
+ break;
+ case TK_ANCHOR_NW:
+ x = frameX + borderLeft;
+ y = frameY + borderTop;
+ break;
+ case TK_ANCHOR_CENTER:
+ x = frameX + (borderLeft + frameWidth - width - borderRight)/2;
+ y = frameY + (borderTop + frameHeight - height - borderBtm)/2;
+ break;
+ default:
+ Tcl_Panic("bad frame factor in ArrangePacking");
+ }
+ width -= slavePtr->doubleBw;
+ height -= slavePtr->doubleBw;
+
+ /*
+ * The final step is to set the position, size, and mapped/unmapped
+ * state of the slave. If the slave is a child of the master, then do
+ * this here. Otherwise let Tk_MaintainGeometry do the work.
+ */
+
+ if (masterPtr->tkwin == Tk_Parent(slavePtr->tkwin)) {
+ if ((width <= 0) || (height <= 0)) {
+ Tk_UnmapWindow(slavePtr->tkwin);
+ } else {
+ if ((x != Tk_X(slavePtr->tkwin))
+ || (y != Tk_Y(slavePtr->tkwin))
+ || (width != Tk_Width(slavePtr->tkwin))
+ || (height != Tk_Height(slavePtr->tkwin))) {
+ Tk_MoveResizeWindow(slavePtr->tkwin, x, y, width, height);
+ }
+ if (abort) {
+ goto done;
+ }
+
+ /*
+ * Don't map the slave if the master isn't mapped: wait until
+ * the master gets mapped later.
+ */
+
+ if (Tk_IsMapped(masterPtr->tkwin)) {
+ Tk_MapWindow(slavePtr->tkwin);
+ }
+ }
+ } else {
+ if ((width <= 0) || (height <= 0)) {
+ Tk_UnmaintainGeometry(slavePtr->tkwin, masterPtr->tkwin);
+ Tk_UnmapWindow(slavePtr->tkwin);
+ } else {
+ Tk_MaintainGeometry(slavePtr->tkwin, masterPtr->tkwin,
+ x, y, width, height);
+ }
+ }
+
+ /*
+ * Changes to the window's structure could cause almost anything to
+ * happen, including deleting the parent or child. If this happens,
+ * we'll be told to abort.
+ */
+
+ if (abort) {
+ goto done;
+ }
+ }
+
+ done:
+ masterPtr->abortPtr = NULL;
+ Tcl_Release(masterPtr);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * XExpansion --
+ *
+ * Given a list of packed slaves, the first of which is packed on the
+ * left or right and is expandable, compute how much to expand the child.
+ *
+ * Results:
+ * The return value is the number of additional pixels to give to the
+ * child.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+XExpansion(
+ register Packer *slavePtr, /* First in list of remaining slaves. */
+ int cavityWidth) /* Horizontal space left for all remaining
+ * slaves. */
+{
+ int numExpand, minExpand, curExpand;
+ int childWidth;
+
+ /*
+ * This function is tricky because windows packed top or bottom can be
+ * interspersed among expandable windows packed left or right. Scan
+ * through the list, keeping a running sum of the widths of all left and
+ * right windows (actually, count the cavity space not allocated) and a
+ * running count of all expandable left and right windows. At each top or
+ * bottom window, and at the end of the list, compute the expansion factor
+ * that seems reasonable at that point. Return the smallest factor seen at
+ * any of these points.
+ */
+
+ minExpand = cavityWidth;
+ numExpand = 0;
+ for ( ; slavePtr != NULL; slavePtr = slavePtr->nextPtr) {
+ childWidth = Tk_ReqWidth(slavePtr->tkwin) + slavePtr->doubleBw
+ + slavePtr->padX + slavePtr->iPadX;
+ if ((slavePtr->side == TOP) || (slavePtr->side == BOTTOM)) {
+ if (numExpand) {
+ curExpand = (cavityWidth - childWidth)/numExpand;
+ if (curExpand < minExpand) {
+ minExpand = curExpand;
+ }
+ }
+ } else {
+ cavityWidth -= childWidth;
+ if (slavePtr->flags & EXPAND) {
+ numExpand++;
+ }
+ }
+ }
+ if (numExpand) {
+ curExpand = cavityWidth/numExpand;
+ if (curExpand < minExpand) {
+ minExpand = curExpand;
+ }
+ }
+ return (minExpand < 0) ? 0 : minExpand;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * YExpansion --
+ *
+ * Given a list of packed slaves, the first of which is packed on the top
+ * or bottom and is expandable, compute how much to expand the child.
+ *
+ * Results:
+ * The return value is the number of additional pixels to give to the
+ * child.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+YExpansion(
+ register Packer *slavePtr, /* First in list of remaining slaves. */
+ int cavityHeight) /* Vertical space left for all remaining
+ * slaves. */
+{
+ int numExpand, minExpand, curExpand;
+ int childHeight;
+
+ /*
+ * See comments for XExpansion.
+ */
+
+ minExpand = cavityHeight;
+ numExpand = 0;
+ for ( ; slavePtr != NULL; slavePtr = slavePtr->nextPtr) {
+ childHeight = Tk_ReqHeight(slavePtr->tkwin) + slavePtr->doubleBw
+ + slavePtr->padY + slavePtr->iPadY;
+ if ((slavePtr->side == LEFT) || (slavePtr->side == RIGHT)) {
+ if (numExpand) {
+ curExpand = (cavityHeight - childHeight)/numExpand;
+ if (curExpand < minExpand) {
+ minExpand = curExpand;
+ }
+ }
+ } else {
+ cavityHeight -= childHeight;
+ if (slavePtr->flags & EXPAND) {
+ numExpand++;
+ }
+ }
+ }
+ if (numExpand) {
+ curExpand = cavityHeight/numExpand;
+ if (curExpand < minExpand) {
+ minExpand = curExpand;
+ }
+ }
+ return (minExpand < 0) ? 0 : minExpand;
+}
+
+/*
+ *------------------------------------------------------------------------
+ *
+ * GetPacker --
+ *
+ * This internal function is used to locate a Packer structure for a
+ * given window, creating one if one doesn't exist already.
+ *
+ * Results:
+ * The return value is a pointer to the Packer structure corresponding to
+ * tkwin.
+ *
+ * Side effects:
+ * A new packer structure may be created. If so, then a callback is set
+ * up to clean things up when the window is deleted.
+ *
+ *------------------------------------------------------------------------
+ */
+
+static Packer *
+GetPacker(
+ Tk_Window tkwin) /* Token for window for which packer structure
+ * is desired. */
+{
+ register Packer *packPtr;
+ Tcl_HashEntry *hPtr;
+ int isNew;
+ TkDisplay *dispPtr = ((TkWindow *) tkwin)->dispPtr;
+
+ if (!dispPtr->packInit) {
+ dispPtr->packInit = 1;
+ Tcl_InitHashTable(&dispPtr->packerHashTable, TCL_ONE_WORD_KEYS);
+ }
+
+ /*
+ * See if there's already packer for this window. If not, then create a
+ * new one.
+ */
+
+ hPtr = Tcl_CreateHashEntry(&dispPtr->packerHashTable, (char *) tkwin,
+ &isNew);
+ if (!isNew) {
+ return Tcl_GetHashValue(hPtr);
+ }
+ packPtr = ckalloc(sizeof(Packer));
+ packPtr->tkwin = tkwin;
+ packPtr->masterPtr = NULL;
+ packPtr->nextPtr = NULL;
+ packPtr->slavePtr = NULL;
+ packPtr->side = TOP;
+ packPtr->anchor = TK_ANCHOR_CENTER;
+ packPtr->padX = packPtr->padY = 0;
+ packPtr->padLeft = packPtr->padTop = 0;
+ packPtr->iPadX = packPtr->iPadY = 0;
+ packPtr->doubleBw = 2*Tk_Changes(tkwin)->border_width;
+ packPtr->abortPtr = NULL;
+ packPtr->flags = 0;
+ Tcl_SetHashValue(hPtr, packPtr);
+ Tk_CreateEventHandler(tkwin, StructureNotifyMask,
+ PackStructureProc, packPtr);
+ return packPtr;
+}
+
+/*
+ *------------------------------------------------------------------------
+ *
+ * PackAfter --
+ *
+ * This function does most of the real work of adding one or more windows
+ * into the packing order for its master.
+ *
+ * Results:
+ * A standard Tcl return value.
+ *
+ * Side effects:
+ * The geometry of the specified windows may change, both now and again
+ * in the future.
+ *
+ *------------------------------------------------------------------------
+ */
+
+static int
+PackAfter(
+ Tcl_Interp *interp, /* Interpreter for error reporting. */
+ Packer *prevPtr, /* Pack windows in argv just after this
+ * window; NULL means pack as first child of
+ * masterPtr. */
+ Packer *masterPtr, /* Master in which to pack windows. */
+ int objc, /* Number of elements in objv. */
+ Tcl_Obj *const objv[]) /* Array of lists, each containing 2 elements:
+ * window name and side against which to
+ * pack. */
+{
+ register Packer *packPtr;
+ Tk_Window tkwin, ancestor, parent;
+ Tcl_Obj **options;
+ int index, optionCount, c;
+
+ /*
+ * Iterate over all of the window specifiers, each consisting of two
+ * arguments. The first argument contains the window name and the
+ * additional arguments contain options such as "top" or "padx 20".
+ */
+
+ for ( ; objc > 0; objc -= 2, objv += 2, prevPtr = packPtr) {
+ if (objc < 2) {
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "wrong # args: window \"%s\" should be followed by options",
+ Tcl_GetString(objv[0])));
+ Tcl_SetErrorCode(interp, "TCL", "WRONGARGS", NULL);
+ return TCL_ERROR;
+ }
+
+ /*
+ * Find the packer for the window to be packed, and make sure that the
+ * window in which it will be packed is either its or a descendant of
+ * its parent.
+ */
+
+ if (TkGetWindowFromObj(interp, masterPtr->tkwin, objv[0], &tkwin)
+ != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ parent = Tk_Parent(tkwin);
+ for (ancestor = masterPtr->tkwin; ; ancestor = Tk_Parent(ancestor)) {
+ if (ancestor == parent) {
+ break;
+ }
+ if (((Tk_FakeWin *) (ancestor))->flags & TK_TOP_HIERARCHY) {
+ badWindow:
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "can't pack %s inside %s", Tcl_GetString(objv[0]),
+ Tk_PathName(masterPtr->tkwin)));
+ Tcl_SetErrorCode(interp, "TK", "GEOMETRY", "HIERARCHY", NULL);
+ return TCL_ERROR;
+ }
+ }
+ if (((Tk_FakeWin *) (tkwin))->flags & TK_TOP_HIERARCHY) {
+ goto badWindow;
+ }
+ if (tkwin == masterPtr->tkwin) {
+ goto badWindow;
+ }
+ packPtr = GetPacker(tkwin);
+
+ /*
+ * Process options for this window.
+ */
+
+ if (Tcl_ListObjGetElements(interp, objv[1], &optionCount, &options)
+ != TCL_OK) {
+ return TCL_ERROR;
+ }
+ packPtr->side = TOP;
+ packPtr->anchor = TK_ANCHOR_CENTER;
+ packPtr->padX = packPtr->padY = 0;
+ packPtr->padLeft = packPtr->padTop = 0;
+ packPtr->iPadX = packPtr->iPadY = 0;
+ packPtr->flags &= ~(FILLX|FILLY|EXPAND);
+ packPtr->flags |= OLD_STYLE;
+ for (index = 0 ; index < optionCount; index++) {
+ Tcl_Obj *curOptPtr = options[index];
+ const char *curOpt = Tcl_GetString(curOptPtr);
+ size_t length = curOptPtr->length;
+
+ c = curOpt[0];
+
+ if ((c == 't')
+ && (strncmp(curOpt, "top", length)) == 0) {
+ packPtr->side = TOP;
+ } else if ((c == 'b')
+ && (strncmp(curOpt, "bottom", length)) == 0) {
+ packPtr->side = BOTTOM;
+ } else if ((c == 'l')
+ && (strncmp(curOpt, "left", length)) == 0) {
+ packPtr->side = LEFT;
+ } else if ((c == 'r')
+ && (strncmp(curOpt, "right", length)) == 0) {
+ packPtr->side = RIGHT;
+ } else if ((c == 'e')
+ && (strncmp(curOpt, "expand", length)) == 0) {
+ packPtr->flags |= EXPAND;
+ } else if ((c == 'f')
+ && (strcmp(curOpt, "fill")) == 0) {
+ packPtr->flags |= FILLX|FILLY;
+ } else if ((length == 5) && (strcmp(curOpt, "fillx")) == 0) {
+ packPtr->flags |= FILLX;
+ } else if ((length == 5) && (strcmp(curOpt, "filly")) == 0) {
+ packPtr->flags |= FILLY;
+ } else if ((c == 'p') && (strcmp(curOpt, "padx")) == 0) {
+ if (optionCount < (index+2)) {
+ missingPad:
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "wrong # args: \"%s\" option must be"
+ " followed by screen distance", curOpt));
+ Tcl_SetErrorCode(interp, "TK", "OLDPACK", "BAD_PARAMETER",
+ NULL);
+ return TCL_ERROR;
+ }
+ if (TkParsePadAmount(interp, tkwin, options[index+1],
+ &packPtr->padLeft, &packPtr->padX) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ packPtr->padX /= 2;
+ packPtr->padLeft /= 2;
+ packPtr->iPadX = 0;
+ index++;
+ } else if ((c == 'p') && (strcmp(curOpt, "pady")) == 0) {
+ if (optionCount < (index+2)) {
+ goto missingPad;
+ }
+ if (TkParsePadAmount(interp, tkwin, options[index+1],
+ &packPtr->padTop, &packPtr->padY) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ packPtr->padY /= 2;
+ packPtr->padTop /= 2;
+ packPtr->iPadY = 0;
+ index++;
+ } else if ((c == 'f') && (length > 1)
+ && (strncmp(curOpt, "frame", (size_t) length) == 0)) {
+ if (optionCount < (index+2)) {
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "wrong # args: \"frame\""
+ " option must be followed by anchor point", -1));
+ Tcl_SetErrorCode(interp, "TK", "OLDPACK", "BAD_PARAMETER",
+ NULL);
+ return TCL_ERROR;
+ }
+ if (Tk_GetAnchorFromObj(interp, options[index+1],
+ &packPtr->anchor) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ index++;
+ } else {
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "bad option \"%s\": should be top, bottom, left,"
+ " right, expand, fill, fillx, filly, padx, pady, or"
+ " frame", curOpt));
+ Tcl_SetErrorCode(interp, "TK", "OLDPACK", "BAD_PARAMETER",
+ NULL);
+ return TCL_ERROR;
+ }
+ }
+
+ if (packPtr != prevPtr) {
+ /*
+ * Unpack this window if it's currently packed.
+ */
+
+ if (packPtr->masterPtr != NULL) {
+ if ((packPtr->masterPtr != masterPtr) &&
+ (packPtr->masterPtr->tkwin
+ != Tk_Parent(packPtr->tkwin))) {
+ Tk_UnmaintainGeometry(packPtr->tkwin,
+ packPtr->masterPtr->tkwin);
+ }
+ Unlink(packPtr);
+ }
+
+ /*
+ * Add the window in the correct place in its master's packing
+ * order, then make sure that the window is managed by us.
+ */
+
+ packPtr->masterPtr = masterPtr;
+ if (prevPtr == NULL) {
+ packPtr->nextPtr = masterPtr->slavePtr;
+ masterPtr->slavePtr = packPtr;
+ } else {
+ packPtr->nextPtr = prevPtr->nextPtr;
+ prevPtr->nextPtr = packPtr;
+ }
+ Tk_ManageGeometry(tkwin, &packerType, packPtr);
+
+ if (!(masterPtr->flags & DONT_PROPAGATE)) {
+ if (TkSetGeometryMaster(interp, masterPtr->tkwin, "pack")
+ != TCL_OK) {
+ Tk_ManageGeometry(tkwin, NULL, NULL);
+ Unlink(packPtr);
+ return TCL_ERROR;
+ }
+ masterPtr->flags |= ALLOCED_MASTER;
+ }
+ }
+ }
+
+ /*
+ * Arrange for the master to be re-packed at the first idle moment.
+ */
+
+ if (masterPtr->abortPtr != NULL) {
+ *masterPtr->abortPtr = 1;
+ }
+ if (!(masterPtr->flags & REQUESTED_REPACK)) {
+ masterPtr->flags |= REQUESTED_REPACK;
+ Tcl_DoWhenIdle(ArrangePacking, masterPtr);
+ }
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Unlink --
+ *
+ * Remove a packer from its master's list of slaves.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The master will be scheduled for repacking.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+Unlink(
+ register Packer *packPtr) /* Window to unlink. */
+{
+ register Packer *masterPtr, *packPtr2;
+
+ masterPtr = packPtr->masterPtr;
+ if (masterPtr == NULL) {
+ return;
+ }
+ if (masterPtr->slavePtr == packPtr) {
+ masterPtr->slavePtr = packPtr->nextPtr;
+ } else {
+ for (packPtr2 = masterPtr->slavePtr; ; packPtr2 = packPtr2->nextPtr) {
+ if (packPtr2 == NULL) {
+ Tcl_Panic("Unlink couldn't find previous window");
+ }
+ if (packPtr2->nextPtr == packPtr) {
+ packPtr2->nextPtr = packPtr->nextPtr;
+ break;
+ }
+ }
+ }
+ if (!(masterPtr->flags & REQUESTED_REPACK)) {
+ masterPtr->flags |= REQUESTED_REPACK;
+ Tcl_DoWhenIdle(ArrangePacking, masterPtr);
+ }
+ if (masterPtr->abortPtr != NULL) {
+ *masterPtr->abortPtr = 1;
+ }
+
+ packPtr->masterPtr = NULL;
+
+ /*
+ * If we have emptied this master from slaves it means we are no longer
+ * handling it and should mark it as free.
+ */
+
+ if (masterPtr->slavePtr == NULL && masterPtr->flags & ALLOCED_MASTER) {
+ TkFreeGeometryMaster(masterPtr->tkwin, "pack");
+ masterPtr->flags &= ~ALLOCED_MASTER;
+ }
+
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * DestroyPacker --
+ *
+ * This function is invoked by Tcl_EventuallyFree or Tcl_Release to clean
+ * up the internal structure of a packer at a safe time (when no-one is
+ * using it anymore).
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Everything associated with the packer is freed up.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+DestroyPacker(
+ void *memPtr) /* Info about packed window that is now
+ * dead. */
+{
+ register Packer *packPtr = memPtr;
+
+ ckfree(packPtr);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * PackStructureProc --
+ *
+ * This function is invoked by the Tk event dispatcher in response to
+ * StructureNotify events.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * If a window was just deleted, clean up all its packer-related
+ * information. If it was just resized, repack its slaves, if any.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+PackStructureProc(
+ ClientData clientData, /* Our information about window referred to by
+ * eventPtr. */
+ XEvent *eventPtr) /* Describes what just happened. */
+{
+ register Packer *packPtr = clientData;
+
+ if (eventPtr->type == ConfigureNotify) {
+ if ((packPtr->slavePtr != NULL)
+ && !(packPtr->flags & REQUESTED_REPACK)) {
+ packPtr->flags |= REQUESTED_REPACK;
+ Tcl_DoWhenIdle(ArrangePacking, packPtr);
+ }
+ if ((packPtr->masterPtr != NULL)
+ && (packPtr->doubleBw != 2*Tk_Changes(packPtr->tkwin)->border_width)) {
+ if (!(packPtr->masterPtr->flags & REQUESTED_REPACK)) {
+ packPtr->doubleBw = 2*Tk_Changes(packPtr->tkwin)->border_width;
+ packPtr->masterPtr->flags |= REQUESTED_REPACK;
+ Tcl_DoWhenIdle(ArrangePacking, packPtr->masterPtr);
+ }
+ }
+ } else if (eventPtr->type == DestroyNotify) {
+ register Packer *slavePtr, *nextPtr;
+
+ if (packPtr->masterPtr != NULL) {
+ Unlink(packPtr);
+ }
+
+ for (slavePtr = packPtr->slavePtr; slavePtr != NULL;
+ slavePtr = nextPtr) {
+ Tk_ManageGeometry(slavePtr->tkwin, NULL, NULL);
+ Tk_UnmapWindow(slavePtr->tkwin);
+ slavePtr->masterPtr = NULL;
+ nextPtr = slavePtr->nextPtr;
+ slavePtr->nextPtr = NULL;
+ }
+
+ if (packPtr->tkwin != NULL) {
+ TkDisplay *dispPtr = ((TkWindow *) packPtr->tkwin)->dispPtr;
+ Tcl_DeleteHashEntry(Tcl_FindHashEntry(&dispPtr->packerHashTable,
+ (char *) packPtr->tkwin));
+ }
+
+ if (packPtr->flags & REQUESTED_REPACK) {
+ Tcl_CancelIdleCall(ArrangePacking, packPtr);
+ }
+ packPtr->tkwin = NULL;
+ Tcl_EventuallyFree(packPtr, (Tcl_FreeProc *) DestroyPacker);
+ } else if (eventPtr->type == MapNotify) {
+ /*
+ * When a master gets mapped, must redo the geometry computation so
+ * that all of its slaves get remapped.
+ */
+
+ if ((packPtr->slavePtr != NULL)
+ && !(packPtr->flags & REQUESTED_REPACK)) {
+ packPtr->flags |= REQUESTED_REPACK;
+ Tcl_DoWhenIdle(ArrangePacking, packPtr);
+ }
+ } else if (eventPtr->type == UnmapNotify) {
+ register Packer *packPtr2;
+
+ /*
+ * Unmap all of the slaves when the master gets unmapped, so that they
+ * don't bother to keep redisplaying themselves.
+ */
+
+ for (packPtr2 = packPtr->slavePtr; packPtr2 != NULL;
+ packPtr2 = packPtr2->nextPtr) {
+ Tk_UnmapWindow(packPtr2->tkwin);
+ }
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ConfigureSlaves --
+ *
+ * This implements the guts of the "pack configure" command. Given a list
+ * of slaves and configuration options, it arranges for the packer to
+ * manage the slaves and sets the specified options.
+ *
+ * Results:
+ * TCL_OK is returned if all went well. Otherwise, TCL_ERROR is returned
+ * and the interp's result is set to contain an error message.
+ *
+ * Side effects:
+ * Slave windows get taken over by the packer.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+ConfigureSlaves(
+ Tcl_Interp *interp, /* Interpreter for error reporting. */
+ Tk_Window tkwin, /* Any window in application containing
+ * slaves. Used to look up slave names. */
+ int objc, /* Number of elements in argv. */
+ Tcl_Obj *const objv[]) /* Argument objects: contains one or more
+ * window names followed by any number of
+ * "option value" pairs. Caller must make sure
+ * that there is at least one window name. */
+{
+ Packer *masterPtr, *slavePtr, *prevPtr, *otherPtr;
+ Tk_Window other, slave, parent, ancestor;
+ int i, j, numWindows, tmp, positionGiven;
+ const char *string;
+ static const char *const optionStrings[] = {
+ "-after", "-anchor", "-before", "-expand", "-fill",
+ "-in", "-ipadx", "-ipady", "-padx", "-pady", "-side", NULL };
+ enum options {
+ CONF_AFTER, CONF_ANCHOR, CONF_BEFORE, CONF_EXPAND, CONF_FILL,
+ CONF_IN, CONF_IPADX, CONF_IPADY, CONF_PADX, CONF_PADY, CONF_SIDE };
+ int index, side;
+
+ /*
+ * Find out how many windows are specified.
+ */
+
+ for (numWindows = 0; numWindows < objc; numWindows++) {
+ string = Tcl_GetString(objv[numWindows]);
+ if (string[0] != '.') {
+ break;
+ }
+ }
+
+ /*
+ * Iterate over all of the slave windows, parsing the configuration
+ * options for each slave. It's a bit wasteful to re-parse the options for
+ * each slave, but things get too messy if we try to parse the arguments
+ * just once at the beginning. For example, if a slave already is packed
+ * we want to just change a few existing values without resetting
+ * everything. If there are multiple windows, the -after, -before, and -in
+ * options only get processed for the first window.
+ */
+
+ masterPtr = NULL;
+ prevPtr = NULL;
+ positionGiven = 0;
+ for (j = 0; j < numWindows; j++) {
+ if (TkGetWindowFromObj(interp, tkwin, objv[j], &slave) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (Tk_TopWinHierarchy(slave)) {
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "can't pack \"%s\": it's a top-level window",
+ Tcl_GetString(objv[j])));
+ Tcl_SetErrorCode(interp, "TK", "GEOMETRY", "TOPLEVEL", NULL);
+ return TCL_ERROR;
+ }
+ slavePtr = GetPacker(slave);
+ slavePtr->flags &= ~OLD_STYLE;
+
+ /*
+ * If the slave isn't currently packed, reset all of its configuration
+ * information to default values (there could be old values left from
+ * a previous packing).
+ */
+
+ if (slavePtr->masterPtr == NULL) {
+ slavePtr->side = TOP;
+ slavePtr->anchor = TK_ANCHOR_CENTER;
+ slavePtr->padX = slavePtr->padY = 0;
+ slavePtr->padLeft = slavePtr->padTop = 0;
+ slavePtr->iPadX = slavePtr->iPadY = 0;
+ slavePtr->flags &= ~(FILLX|FILLY|EXPAND);
+ }
+
+ for (i = numWindows; i < objc; i+=2) {
+ if ((i+2) > objc) {
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "extra option \"%s\" (option with no value?)",
+ Tcl_GetString(objv[i])));
+ Tcl_SetErrorCode(interp, "TK", "PACK", "BAD_PARAMETER", NULL);
+ return TCL_ERROR;
+ }
+ if (Tcl_GetIndexFromObjStruct(interp, objv[i], optionStrings,
+ sizeof(char *), "option", 0, &index) != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ switch ((enum options) index) {
+ case CONF_AFTER:
+ if (j == 0) {
+ if (TkGetWindowFromObj(interp, tkwin, objv[i+1], &other)
+ != TCL_OK) {
+ return TCL_ERROR;
+ }
+ prevPtr = GetPacker(other);
+ if (prevPtr->masterPtr == NULL) {
+ notPacked:
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "window \"%s\" isn't packed",
+ Tcl_GetString(objv[i+1])));
+ Tcl_SetErrorCode(interp, "TK", "PACK", "NOT_PACKED",
+ NULL);
+ return TCL_ERROR;
+ }
+ masterPtr = prevPtr->masterPtr;
+ positionGiven = 1;
+ }
+ break;
+ case CONF_ANCHOR:
+ if (Tk_GetAnchorFromObj(interp, objv[i+1], &slavePtr->anchor)
+ != TCL_OK) {
+ return TCL_ERROR;
+ }
+ break;
+ case CONF_BEFORE:
+ if (j == 0) {
+ if (TkGetWindowFromObj(interp, tkwin, objv[i+1], &other)
+ != TCL_OK) {
+ return TCL_ERROR;
+ }
+ otherPtr = GetPacker(other);
+ if (otherPtr->masterPtr == NULL) {
+ goto notPacked;
+ }
+ masterPtr = otherPtr->masterPtr;
+ prevPtr = masterPtr->slavePtr;
+ if (prevPtr == otherPtr) {
+ prevPtr = NULL;
+ } else {
+ while (prevPtr->nextPtr != otherPtr) {
+ prevPtr = prevPtr->nextPtr;
+ }
+ }
+ positionGiven = 1;
+ }
+ break;
+ case CONF_EXPAND:
+ if (Tcl_GetBooleanFromObj(interp, objv[i+1], &tmp) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ slavePtr->flags &= ~EXPAND;
+ if (tmp) {
+ slavePtr->flags |= EXPAND;
+ }
+ break;
+ case CONF_FILL:
+ string = Tcl_GetString(objv[i+1]);
+ if (strcmp(string, "none") == 0) {
+ slavePtr->flags &= ~(FILLX|FILLY);
+ } else if (strcmp(string, "x") == 0) {
+ slavePtr->flags = (slavePtr->flags & ~FILLY) | FILLX;
+ } else if (strcmp(string, "y") == 0) {
+ slavePtr->flags = (slavePtr->flags & ~FILLX) | FILLY;
+ } else if (strcmp(string, "both") == 0) {
+ slavePtr->flags |= FILLX|FILLY;
+ } else {
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "bad fill style \"%s\": must be "
+ "none, x, y, or both", string));
+ Tcl_SetErrorCode(interp, "TK", "VALUE", "FILL", NULL);
+ return TCL_ERROR;
+ }
+ break;
+ case CONF_IN:
+ if (j == 0) {
+ if (TkGetWindowFromObj(interp, tkwin, objv[i+1], &other)
+ != TCL_OK) {
+ return TCL_ERROR;
+ }
+ masterPtr = GetPacker(other);
+ prevPtr = masterPtr->slavePtr;
+ if (prevPtr != NULL) {
+ while (prevPtr->nextPtr != NULL) {
+ prevPtr = prevPtr->nextPtr;
+ }
+ }
+ positionGiven = 1;
+ }
+ break;
+ case CONF_IPADX:
+ if ((Tk_GetPixelsFromObj(interp, slave, objv[i+1], &tmp)
+ != TCL_OK) || (tmp < 0)) {
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "bad ipadx value \"%s\": must be positive screen"
+ " distance", Tcl_GetString(objv[i+1])));
+ Tcl_SetErrorCode(interp, "TK", "VALUE", "INT_PAD", NULL);
+ return TCL_ERROR;
+ }
+ slavePtr->iPadX = tmp * 2;
+ break;
+ case CONF_IPADY:
+ if ((Tk_GetPixelsFromObj(interp, slave, objv[i+1], &tmp)
+ != TCL_OK) || (tmp < 0)) {
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "bad ipady value \"%s\": must be positive screen"
+ " distance", Tcl_GetString(objv[i+1])));
+ Tcl_SetErrorCode(interp, "TK", "VALUE", "INT_PAD", NULL);
+ return TCL_ERROR;
+ }
+ slavePtr->iPadY = tmp * 2;
+ break;
+ case CONF_PADX:
+ if (TkParsePadAmount(interp, slave, objv[i+1],
+ &slavePtr->padLeft, &slavePtr->padX) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ break;
+ case CONF_PADY:
+ if (TkParsePadAmount(interp, slave, objv[i+1],
+ &slavePtr->padTop, &slavePtr->padY) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ break;
+ case CONF_SIDE:
+ if (Tcl_GetIndexFromObjStruct(interp, objv[i+1], sideNames,
+ sizeof(char *), "side", TCL_EXACT, &side) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ slavePtr->side = (Side) side;
+ break;
+ }
+ }
+
+ /*
+ * If no position in a packing list was specified and the slave is
+ * already packed, then leave it in its current location in its
+ * current packing list.
+ */
+
+ if (!positionGiven && (slavePtr->masterPtr != NULL)) {
+ masterPtr = slavePtr->masterPtr;
+ goto scheduleLayout;
+ }
+
+ /*
+ * If the slave is going to be put back after itself or the same -in
+ * window is passed in again, then just skip the whole operation,
+ * since it won't work anyway.
+ */
+
+ if (prevPtr == slavePtr) {
+ masterPtr = slavePtr->masterPtr;
+ goto scheduleLayout;
+ }
+
+ /*
+ * If none of the "-in", "-before", or "-after" options has been
+ * specified, arrange for the slave to go at the end of the order for
+ * its parent.
+ */
+
+ if (!positionGiven) {
+ masterPtr = GetPacker(Tk_Parent(slave));
+ prevPtr = masterPtr->slavePtr;
+ if (prevPtr != NULL) {
+ while (prevPtr->nextPtr != NULL) {
+ prevPtr = prevPtr->nextPtr;
+ }
+ }
+ }
+
+ /*
+ * Make sure that the slave's parent is either the master or an
+ * ancestor of the master, and that the master and slave aren't the
+ * same.
+ */
+
+ parent = Tk_Parent(slave);
+ for (ancestor = masterPtr->tkwin; ; ancestor = Tk_Parent(ancestor)) {
+ if (ancestor == parent) {
+ break;
+ }
+ if (Tk_TopWinHierarchy(ancestor)) {
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "can't pack %s inside %s", Tcl_GetString(objv[j]),
+ Tk_PathName(masterPtr->tkwin)));
+ Tcl_SetErrorCode(interp, "TK", "GEOMETRY", "HIERARCHY", NULL);
+ return TCL_ERROR;
+ }
+ }
+ if (slave == masterPtr->tkwin) {
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "can't pack %s inside itself", Tcl_GetString(objv[j])));
+ Tcl_SetErrorCode(interp, "TK", "GEOMETRY", "SELF", NULL);
+ return TCL_ERROR;
+ }
+
+ /*
+ * Unpack the slave if it's currently packed, then position it after
+ * prevPtr.
+ */
+
+ if (slavePtr->masterPtr != NULL) {
+ if ((slavePtr->masterPtr != masterPtr) &&
+ (slavePtr->masterPtr->tkwin
+ != Tk_Parent(slavePtr->tkwin))) {
+ Tk_UnmaintainGeometry(slavePtr->tkwin,
+ slavePtr->masterPtr->tkwin);
+ }
+ Unlink(slavePtr);
+ }
+
+ slavePtr->masterPtr = masterPtr;
+ if (prevPtr == NULL) {
+ slavePtr->nextPtr = masterPtr->slavePtr;
+ masterPtr->slavePtr = slavePtr;
+ } else {
+ slavePtr->nextPtr = prevPtr->nextPtr;
+ prevPtr->nextPtr = slavePtr;
+ }
+ Tk_ManageGeometry(slave, &packerType, slavePtr);
+ prevPtr = slavePtr;
+
+ if (!(masterPtr->flags & DONT_PROPAGATE)) {
+ if (TkSetGeometryMaster(interp, masterPtr->tkwin, "pack")
+ != TCL_OK) {
+ Tk_ManageGeometry(slave, NULL, NULL);
+ Unlink(slavePtr);
+ return TCL_ERROR;
+ }
+ masterPtr->flags |= ALLOCED_MASTER;
+ }
+
+ /*
+ * Arrange for the master to be re-packed at the first idle moment.
+ */
+
+ scheduleLayout:
+ if (masterPtr->abortPtr != NULL) {
+ *masterPtr->abortPtr = 1;
+ }
+ if (!(masterPtr->flags & REQUESTED_REPACK)) {
+ masterPtr->flags |= REQUESTED_REPACK;
+ Tcl_DoWhenIdle(ArrangePacking, masterPtr);
+ }
+ }
+ return TCL_OK;
+}
+
+/*
+ * Local Variables:
+ * mode: c
+ * c-basic-offset: 4
+ * fill-column: 78
+ * End:
+ */
diff --git a/tk8.6/generic/tkPanedWindow.c b/tk8.6/generic/tkPanedWindow.c
new file mode 100644
index 0000000..f350d0ad
--- /dev/null
+++ b/tk8.6/generic/tkPanedWindow.c
@@ -0,0 +1,3144 @@
+/*
+ * tkPanedWindow.c --
+ *
+ * This module implements "paned window" widgets that are object based. A
+ * "paned window" is a widget that manages the geometry for some number
+ * of other widgets, placing a movable "sash" between them, which can be
+ * used to alter the relative sizes of adjacent widgets.
+ *
+ * Copyright (c) 1997 Sun Microsystems, Inc.
+ * Copyright (c) 2000 Ajuba Solutions.
+ *
+ * See the file "license.terms" for information on usage and redistribution of
+ * this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ */
+
+#include "default.h"
+#include "tkInt.h"
+
+/*
+ * Flag values for "sticky"ness. The 16 combinations subsume the packer's
+ * notion of anchor and fill.
+ *
+ * STICK_NORTH This window sticks to the top of its cavity.
+ * STICK_EAST This window sticks to the right edge of its cavity.
+ * STICK_SOUTH This window sticks to the bottom of its cavity.
+ * STICK_WEST This window sticks to the left edge of its cavity.
+ */
+
+#define STICK_NORTH 1
+#define STICK_EAST 2
+#define STICK_SOUTH 4
+#define STICK_WEST 8
+
+/*
+ * The following table defines the legal values for the -orient option.
+ */
+
+static const char *const orientStrings[] = {
+ "horizontal", "vertical", NULL
+};
+
+enum orient { ORIENT_HORIZONTAL, ORIENT_VERTICAL };
+
+/*
+ * The following table defines the legal values for the -stretch option.
+ */
+
+static const char *const stretchStrings[] = {
+ "always", "first", "last", "middle", "never", NULL
+};
+
+enum stretch {
+ STRETCH_ALWAYS, /* Always give extra space to this pane. */
+ STRETCH_FIRST, /* Give extra space to pane if it is first. */
+ STRETCH_LAST, /* Give extra space to pane if it is last. */
+ STRETCH_MIDDLE, /* Give extra space to pane only if it is
+ * neither first nor last. */
+ STRETCH_NEVER /* Never give extra space to this pane. */
+};
+
+/*
+ * Codify the stretchiness rule in one place.
+ */
+
+#define IsStretchable(stretch,index,first,last) \
+ (((stretch) == STRETCH_ALWAYS) || \
+ ((stretch) == STRETCH_FIRST && (index) == (first)) || \
+ ((stretch) == STRETCH_LAST && (index) == (last)) || \
+ ((stretch) == STRETCH_MIDDLE && (index) != (first) && (index) != (last)))
+
+typedef struct {
+ Tk_OptionTable pwOptions; /* Token for paned window option table. */
+ Tk_OptionTable slaveOpts; /* Token for slave cget option table. */
+} OptionTables;
+
+/*
+ * One structure of the following type is kept for each window
+ * managed by a paned window widget.
+ */
+
+typedef struct Slave {
+ Tk_Window tkwin; /* Window being managed. */
+ int minSize; /* Minimum size of this pane, on the relevant
+ * axis, in pixels. */
+ int padx; /* Additional padding requested for slave, in
+ * the x dimension. */
+ int pady; /* Additional padding requested for slave, in
+ * the y dimension. */
+ Tcl_Obj *widthPtr, *heightPtr;
+ /* Tcl_Obj rep's of slave width/height, to
+ * allow for null values. */
+ int width; /* Slave width. */
+ int height; /* Slave height. */
+ int sticky; /* Sticky string. */
+ int x, y; /* Coordinates of the widget. */
+ int paneWidth, paneHeight; /* Pane dimensions (may be different from
+ * slave width/height). */
+ int sashx, sashy; /* Coordinates of the sash of the right or
+ * bottom of this pane. */
+ int markx, marky; /* Coordinates of the last mark set for the
+ * sash. */
+ int handlex, handley; /* Coordinates of the sash handle. */
+ enum stretch stretch; /* Controls how slave grows/shrinks */
+ int hide; /* Controls visibility of pane */
+ struct PanedWindow *masterPtr;
+ /* Paned window managing the window. */
+ Tk_Window after; /* Placeholder for parsing options. */
+ Tk_Window before; /* Placeholder for parsing options. */
+} Slave;
+
+/*
+ * A data structure of the following type is kept for each paned window widget
+ * managed by this file:
+ */
+
+typedef struct PanedWindow {
+ Tk_Window tkwin; /* Window that embodies the paned window. */
+ Tk_Window proxywin; /* Window for the resizing proxy. */
+ Display *display; /* X's token for the window's display. */
+ Tcl_Interp *interp; /* Interpreter associated with widget. */
+ Tcl_Command widgetCmd; /* Token for square's widget command. */
+ Tk_OptionTable optionTable; /* Token representing the configuration
+ * specifications. */
+ Tk_OptionTable slaveOpts; /* Token for slave cget table. */
+ Tk_3DBorder background; /* Background color. */
+ int borderWidth; /* Value of -borderwidth option. */
+ int relief; /* 3D border effect (TK_RELIEF_RAISED, etc) */
+ Tcl_Obj *widthPtr; /* Tcl_Obj rep for width. */
+ Tcl_Obj *heightPtr; /* Tcl_Obj rep for height. */
+ int width, height; /* Width and height of the widget. */
+ enum orient orient; /* Orientation of the widget. */
+ Tk_Cursor cursor; /* Current cursor for window, or None. */
+ int resizeOpaque; /* Boolean indicating whether resize should be
+ * opaque or rubberband style. */
+ int sashRelief; /* Relief used to draw sash. */
+ int sashWidth; /* Width of each sash, in pixels. */
+ Tcl_Obj *sashWidthPtr; /* Tcl_Obj rep for sash width. */
+ int sashPad; /* Additional padding around each sash. */
+ Tcl_Obj *sashPadPtr; /* Tcl_Obj rep for sash padding. */
+ int showHandle; /* Boolean indicating whether sash handles
+ * should be drawn. */
+ int handleSize; /* Size of one side of a sash handle (handles
+ * are square), in pixels. */
+ int handlePad; /* Distance from border to draw handle. */
+ Tcl_Obj *handleSizePtr; /* Tcl_Obj rep for handle size. */
+ Tk_Cursor sashCursor; /* Cursor used when mouse is above a sash. */
+ GC gc; /* Graphics context for copying from
+ * off-screen pixmap onto screen. */
+ int proxyx, proxyy; /* Proxy x,y coordinates. */
+ Tk_3DBorder proxyBackground;/* Background color used to draw proxy. If NULL, use background. */
+ Tcl_Obj *proxyBorderWidthPtr; /* Tcl_Obj rep for proxyBorderWidth */
+ int proxyBorderWidth; /* Borderwidth used to draw proxy. */
+ int proxyRelief; /* Relief used to draw proxy, if TK_RELIEF_NULL then use relief. */
+ Slave **slaves; /* Pointer to array of Slaves. */
+ int numSlaves; /* Number of slaves. */
+ int sizeofSlaves; /* Number of elements in the slaves array. */
+ int flags; /* Flags for widget; see below. */
+} PanedWindow;
+
+/*
+ * Flags used for paned windows:
+ *
+ * REDRAW_PENDING: Non-zero means a DoWhenIdle handler has been
+ * queued to redraw this window.
+ *
+ * WIDGET_DELETED: Non-zero means that the paned window has been,
+ * or is in the process of being, deleted.
+ *
+ * RESIZE_PENDING: Non-zero means that the window might need to
+ * change its size (or the size of its panes)
+ * because of a change in the size of one of its
+ * children.
+ */
+
+#define REDRAW_PENDING 0x0001
+#define WIDGET_DELETED 0x0002
+#define REQUESTED_RELAYOUT 0x0004
+#define RECOMPUTE_GEOMETRY 0x0008
+#define PROXY_REDRAW_PENDING 0x0010
+#define RESIZE_PENDING 0x0020
+
+/*
+ * Forward declarations for functions defined later in this file:
+ */
+
+int Tk_PanedWindowObjCmd(ClientData clientData,
+ Tcl_Interp *interp, int objc,
+ Tcl_Obj *const objv[]);
+static void PanedWindowCmdDeletedProc(ClientData clientData);
+static int ConfigurePanedWindow(Tcl_Interp *interp,
+ PanedWindow *pwPtr, int objc,
+ Tcl_Obj *const objv[]);
+static void DestroyPanedWindow(PanedWindow *pwPtr);
+static void DisplayPanedWindow(ClientData clientData);
+static void PanedWindowEventProc(ClientData clientData,
+ XEvent *eventPtr);
+static void ProxyWindowEventProc(ClientData clientData,
+ XEvent *eventPtr);
+static void DisplayProxyWindow(ClientData clientData);
+static void PanedWindowWorldChanged(ClientData instanceData);
+static int PanedWindowWidgetObjCmd(ClientData clientData,
+ Tcl_Interp *, int objc, Tcl_Obj * const objv[]);
+static void PanedWindowLostSlaveProc(ClientData clientData,
+ Tk_Window tkwin);
+static void PanedWindowReqProc(ClientData clientData,
+ Tk_Window tkwin);
+static void ArrangePanes(ClientData clientData);
+static void Unlink(Slave *slavePtr);
+static Slave * GetPane(PanedWindow *pwPtr, Tk_Window tkwin);
+static void GetFirstLastVisiblePane(PanedWindow *pwPtr,
+ int *firstPtr, int *lastPtr);
+static void SlaveStructureProc(ClientData clientData,
+ XEvent *eventPtr);
+static int PanedWindowSashCommand(PanedWindow *pwPtr,
+ Tcl_Interp *interp, int objc,
+ Tcl_Obj * const objv[]);
+static int PanedWindowProxyCommand(PanedWindow *pwPtr,
+ Tcl_Interp *interp, int objc,
+ Tcl_Obj * const objv[]);
+static void ComputeGeometry(PanedWindow *pwPtr);
+static int ConfigureSlaves(PanedWindow *pwPtr,
+ Tcl_Interp *interp, int objc,
+ Tcl_Obj * const objv[]);
+static void DestroyOptionTables(ClientData clientData,
+ Tcl_Interp *interp);
+static int SetSticky(ClientData clientData, Tcl_Interp *interp,
+ Tk_Window tkwin, Tcl_Obj **value, char *recordPtr,
+ int internalOffset, char *oldInternalPtr,
+ int flags);
+static Tcl_Obj * GetSticky(ClientData clientData, Tk_Window tkwin,
+ char *recordPtr, int internalOffset);
+static void RestoreSticky(ClientData clientData, Tk_Window tkwin,
+ char *internalPtr, char *oldInternalPtr);
+static void AdjustForSticky(int sticky, int cavityWidth,
+ int cavityHeight, int *xPtr, int *yPtr,
+ int *slaveWidthPtr, int *slaveHeightPtr);
+static void MoveSash(PanedWindow *pwPtr, int sash, int diff);
+static int ObjectIsEmpty(Tcl_Obj *objPtr);
+static char * ComputeSlotAddress(char *recordPtr, int offset);
+static int PanedWindowIdentifyCoords(PanedWindow *pwPtr,
+ Tcl_Interp *interp, int x, int y);
+
+/*
+ * Sashes are between panes only, so there is one less sash than slaves
+ */
+
+#define ValidSashIndex(pwPtr, sash) \
+ (((sash) >= 0) && ((sash) < ((pwPtr)->numSlaves-1)))
+
+static const Tk_GeomMgr panedWindowMgrType = {
+ "panedwindow", /* name */
+ PanedWindowReqProc, /* requestProc */
+ PanedWindowLostSlaveProc, /* lostSlaveProc */
+};
+
+/*
+ * Information used for objv parsing.
+ */
+
+#define GEOMETRY 0x0001
+
+/*
+ * The following structure contains pointers to functions used for processing
+ * the custom "-sticky" option for slave windows.
+ */
+
+static const Tk_ObjCustomOption stickyOption = {
+ "sticky", /* name */
+ SetSticky, /* setProc */
+ GetSticky, /* getProc */
+ RestoreSticky, /* restoreProc */
+ NULL, /* freeProc */
+ 0
+};
+
+static const Tk_OptionSpec optionSpecs[] = {
+ {TK_OPTION_BORDER, "-background", "background", "Background",
+ DEF_PANEDWINDOW_BG_COLOR, -1, Tk_Offset(PanedWindow, background), 0,
+ DEF_PANEDWINDOW_BG_MONO, 0},
+ {TK_OPTION_SYNONYM, "-bd", NULL, NULL,
+ NULL, 0, -1, 0, "-borderwidth", 0},
+ {TK_OPTION_SYNONYM, "-bg", NULL, NULL,
+ NULL, 0, -1, 0, "-background", 0},
+ {TK_OPTION_PIXELS, "-borderwidth", "borderWidth", "BorderWidth",
+ DEF_PANEDWINDOW_BORDERWIDTH, -1, Tk_Offset(PanedWindow, borderWidth),
+ 0, 0, GEOMETRY},
+ {TK_OPTION_CURSOR, "-cursor", "cursor", "Cursor",
+ DEF_PANEDWINDOW_CURSOR, -1, Tk_Offset(PanedWindow, cursor),
+ TK_OPTION_NULL_OK, 0, 0},
+ {TK_OPTION_PIXELS, "-handlepad", "handlePad", "HandlePad",
+ DEF_PANEDWINDOW_HANDLEPAD, -1, Tk_Offset(PanedWindow, handlePad),
+ 0, 0, GEOMETRY},
+ {TK_OPTION_PIXELS, "-handlesize", "handleSize", "HandleSize",
+ DEF_PANEDWINDOW_HANDLESIZE, Tk_Offset(PanedWindow, handleSizePtr),
+ Tk_Offset(PanedWindow, handleSize), 0, 0, GEOMETRY},
+ {TK_OPTION_PIXELS, "-height", "height", "Height",
+ DEF_PANEDWINDOW_HEIGHT, Tk_Offset(PanedWindow, heightPtr),
+ Tk_Offset(PanedWindow, height), TK_OPTION_NULL_OK, 0, GEOMETRY},
+ {TK_OPTION_BOOLEAN, "-opaqueresize", "opaqueResize", "OpaqueResize",
+ DEF_PANEDWINDOW_OPAQUERESIZE, -1,
+ Tk_Offset(PanedWindow, resizeOpaque), 0, 0, 0},
+ {TK_OPTION_STRING_TABLE, "-orient", "orient", "Orient",
+ DEF_PANEDWINDOW_ORIENT, -1, Tk_Offset(PanedWindow, orient),
+ 0, orientStrings, GEOMETRY},
+ {TK_OPTION_BORDER, "-proxybackground", "proxyBackground", "ProxyBackground",
+ 0, -1, Tk_Offset(PanedWindow, proxyBackground), TK_OPTION_NULL_OK,
+ (ClientData) DEF_PANEDWINDOW_BG_MONO},
+ {TK_OPTION_PIXELS, "-proxyborderwidth", "proxyBorderWidth", "ProxyBorderWidth",
+ DEF_PANEDWINDOW_PROXYBORDER, Tk_Offset(PanedWindow, proxyBorderWidthPtr),
+ Tk_Offset(PanedWindow, proxyBorderWidth), 0, 0, GEOMETRY},
+ {TK_OPTION_RELIEF, "-proxyrelief", "proxyRelief", "Relief",
+ 0, -1, Tk_Offset(PanedWindow, proxyRelief),
+ TK_OPTION_NULL_OK, 0, 0},
+ {TK_OPTION_RELIEF, "-relief", "relief", "Relief",
+ DEF_PANEDWINDOW_RELIEF, -1, Tk_Offset(PanedWindow, relief), 0, 0, 0},
+ {TK_OPTION_CURSOR, "-sashcursor", "sashCursor", "Cursor",
+ DEF_PANEDWINDOW_SASHCURSOR, -1, Tk_Offset(PanedWindow, sashCursor),
+ TK_OPTION_NULL_OK, 0, 0},
+ {TK_OPTION_PIXELS, "-sashpad", "sashPad", "SashPad",
+ DEF_PANEDWINDOW_SASHPAD, -1, Tk_Offset(PanedWindow, sashPad),
+ 0, 0, GEOMETRY},
+ {TK_OPTION_RELIEF, "-sashrelief", "sashRelief", "Relief",
+ DEF_PANEDWINDOW_SASHRELIEF, -1, Tk_Offset(PanedWindow, sashRelief),
+ 0, 0, 0},
+ {TK_OPTION_PIXELS, "-sashwidth", "sashWidth", "Width",
+ DEF_PANEDWINDOW_SASHWIDTH, Tk_Offset(PanedWindow, sashWidthPtr),
+ Tk_Offset(PanedWindow, sashWidth), 0, 0, GEOMETRY},
+ {TK_OPTION_BOOLEAN, "-showhandle", "showHandle", "ShowHandle",
+ DEF_PANEDWINDOW_SHOWHANDLE, -1, Tk_Offset(PanedWindow, showHandle),
+ 0, 0, GEOMETRY},
+ {TK_OPTION_PIXELS, "-width", "width", "Width",
+ DEF_PANEDWINDOW_WIDTH, Tk_Offset(PanedWindow, widthPtr),
+ Tk_Offset(PanedWindow, width), TK_OPTION_NULL_OK, 0, GEOMETRY},
+ {TK_OPTION_END, NULL, NULL, NULL, NULL, 0, 0, 0, 0, 0}
+};
+
+static const Tk_OptionSpec slaveOptionSpecs[] = {
+ {TK_OPTION_WINDOW, "-after", NULL, NULL,
+ DEF_PANEDWINDOW_PANE_AFTER, -1, Tk_Offset(Slave, after),
+ TK_OPTION_NULL_OK, 0, 0},
+ {TK_OPTION_WINDOW, "-before", NULL, NULL,
+ DEF_PANEDWINDOW_PANE_BEFORE, -1, Tk_Offset(Slave, before),
+ TK_OPTION_NULL_OK, 0, 0},
+ {TK_OPTION_PIXELS, "-height", NULL, NULL,
+ DEF_PANEDWINDOW_PANE_HEIGHT, Tk_Offset(Slave, heightPtr),
+ Tk_Offset(Slave, height), TK_OPTION_NULL_OK, 0, 0},
+ {TK_OPTION_BOOLEAN, "-hide", "hide", "Hide",
+ DEF_PANEDWINDOW_PANE_HIDE, -1, Tk_Offset(Slave, hide), 0,0,GEOMETRY},
+ {TK_OPTION_PIXELS, "-minsize", NULL, NULL,
+ DEF_PANEDWINDOW_PANE_MINSIZE, -1, Tk_Offset(Slave, minSize), 0, 0, 0},
+ {TK_OPTION_PIXELS, "-padx", NULL, NULL,
+ DEF_PANEDWINDOW_PANE_PADX, -1, Tk_Offset(Slave, padx), 0, 0, 0},
+ {TK_OPTION_PIXELS, "-pady", NULL, NULL,
+ DEF_PANEDWINDOW_PANE_PADY, -1, Tk_Offset(Slave, pady), 0, 0, 0},
+ {TK_OPTION_CUSTOM, "-sticky", NULL, NULL,
+ DEF_PANEDWINDOW_PANE_STICKY, -1, Tk_Offset(Slave, sticky), 0,
+ &stickyOption, 0},
+ {TK_OPTION_STRING_TABLE, "-stretch", "stretch", "Stretch",
+ DEF_PANEDWINDOW_PANE_STRETCH, -1, Tk_Offset(Slave, stretch), 0,
+ (ClientData) stretchStrings, 0},
+ {TK_OPTION_PIXELS, "-width", NULL, NULL,
+ DEF_PANEDWINDOW_PANE_WIDTH, Tk_Offset(Slave, widthPtr),
+ Tk_Offset(Slave, width), TK_OPTION_NULL_OK, 0, 0},
+ {TK_OPTION_END, NULL, NULL, NULL, NULL, 0, 0, 0, 0, 0}
+};
+
+/*
+ *--------------------------------------------------------------
+ *
+ * Tk_PanedWindowObjCmd --
+ *
+ * This function is invoked to process the "panedwindow" Tcl command. It
+ * creates a new "panedwindow" widget.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * A new widget is created and configured.
+ *
+ *--------------------------------------------------------------
+ */
+
+int
+Tk_PanedWindowObjCmd(
+ ClientData clientData, /* NULL. */
+ Tcl_Interp *interp, /* Current interpreter. */
+ int objc, /* Number of arguments. */
+ Tcl_Obj * const objv[]) /* Argument objects. */
+{
+ PanedWindow *pwPtr;
+ Tk_Window tkwin, parent;
+ OptionTables *pwOpts;
+ XSetWindowAttributes atts;
+
+ if (objc < 2) {
+ Tcl_WrongNumArgs(interp, 1, objv, "pathName ?-option value ...?");
+ return TCL_ERROR;
+ }
+
+ tkwin = Tk_CreateWindowFromPath(interp, Tk_MainWindow(interp),
+ Tcl_GetString(objv[1]), NULL);
+ if (tkwin == NULL) {
+ return TCL_ERROR;
+ }
+
+ pwOpts = (OptionTables *)
+ Tcl_GetAssocData(interp, "PanedWindowOptionTables", NULL);
+ if (pwOpts == NULL) {
+ /*
+ * The first time this function is invoked, the option tables will be
+ * NULL. We then create the option tables from the templates and store
+ * a pointer to the tables as the command's clinical so we'll have
+ * easy access to it in the future.
+ */
+
+ pwOpts = ckalloc(sizeof(OptionTables));
+
+ /*
+ * Set up an exit handler to free the optionTables struct.
+ */
+
+ Tcl_SetAssocData(interp, "PanedWindowOptionTables",
+ DestroyOptionTables, pwOpts);
+
+ /*
+ * Create the paned window option tables.
+ */
+
+ pwOpts->pwOptions = Tk_CreateOptionTable(interp, optionSpecs);
+ pwOpts->slaveOpts = Tk_CreateOptionTable(interp, slaveOptionSpecs);
+ }
+
+ Tk_SetClass(tkwin, "Panedwindow");
+
+ /*
+ * Allocate and initialize the widget record.
+ */
+
+ pwPtr = ckalloc(sizeof(PanedWindow));
+ memset((void *)pwPtr, 0, (sizeof(PanedWindow)));
+ pwPtr->tkwin = tkwin;
+ pwPtr->display = Tk_Display(tkwin);
+ pwPtr->interp = interp;
+ pwPtr->widgetCmd = Tcl_CreateObjCommand(interp,
+ Tk_PathName(pwPtr->tkwin), PanedWindowWidgetObjCmd, pwPtr,
+ PanedWindowCmdDeletedProc);
+ pwPtr->optionTable = pwOpts->pwOptions;
+ pwPtr->slaveOpts = pwOpts->slaveOpts;
+ pwPtr->relief = TK_RELIEF_RAISED;
+ pwPtr->gc = None;
+ pwPtr->cursor = None;
+ pwPtr->sashCursor = None;
+
+ /*
+ * Keep a hold of the associated tkwin until we destroy the widget,
+ * otherwise Tk might free it while we still need it.
+ */
+
+ Tcl_Preserve(pwPtr->tkwin);
+
+ if (Tk_InitOptions(interp, (char *) pwPtr, pwOpts->pwOptions,
+ tkwin) != TCL_OK) {
+ Tk_DestroyWindow(pwPtr->tkwin);
+ return TCL_ERROR;
+ }
+
+ Tk_CreateEventHandler(pwPtr->tkwin, ExposureMask|StructureNotifyMask,
+ PanedWindowEventProc, pwPtr);
+
+ /*
+ * Find the toplevel ancestor of the panedwindow, and make a proxy win as
+ * a child of that window; this way the proxy can always float above
+ * slaves in the panedwindow.
+ */
+
+ parent = Tk_Parent(pwPtr->tkwin);
+ while (!(Tk_IsTopLevel(parent))) {
+ parent = Tk_Parent(parent);
+ if (parent == NULL) {
+ parent = pwPtr->tkwin;
+ break;
+ }
+ }
+
+ pwPtr->proxywin = Tk_CreateAnonymousWindow(interp, parent, NULL);
+
+ /*
+ * The proxy window has to be able to share GCs with the main panedwindow
+ * despite being children of windows with potentially different
+ * characteristics, and it looks better that way too. [Bug 702230] Also
+ * set the X window save under attribute to avoid expose events as the
+ * proxy sash is dragged across the panes. [Bug 1036963]
+ */
+
+ Tk_SetWindowVisual(pwPtr->proxywin,
+ Tk_Visual(tkwin), Tk_Depth(tkwin), Tk_Colormap(tkwin));
+ Tk_CreateEventHandler(pwPtr->proxywin, ExposureMask, ProxyWindowEventProc,
+ pwPtr);
+ atts.save_under = True;
+ Tk_ChangeWindowAttributes(pwPtr->proxywin, CWSaveUnder, &atts);
+
+ if (ConfigurePanedWindow(interp, pwPtr, objc - 2, objv + 2) != TCL_OK) {
+ Tk_DestroyWindow(pwPtr->proxywin);
+ Tk_DestroyWindow(pwPtr->tkwin);
+ return TCL_ERROR;
+ }
+
+ Tcl_SetObjResult(interp, TkNewWindowObj(pwPtr->tkwin));
+ return TCL_OK;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * PanedWindowWidgetObjCmd --
+ *
+ * This function is invoked to process the Tcl command that corresponds
+ * to a widget managed by this module. See the user documentation for
+ * details on what it does.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * See the user documentation.
+ *
+ *--------------------------------------------------------------
+ */
+
+static int
+PanedWindowWidgetObjCmd(
+ ClientData clientData, /* Information about square widget. */
+ Tcl_Interp *interp, /* Current interpreter. */
+ int objc, /* Number of arguments. */
+ Tcl_Obj * const objv[]) /* Argument objects. */
+{
+ PanedWindow *pwPtr = clientData;
+ int result = TCL_OK;
+ static const char *const optionStrings[] = {
+ "add", "cget", "configure", "forget", "identify", "panecget",
+ "paneconfigure", "panes", "proxy", "sash", NULL
+ };
+ enum options {
+ PW_ADD, PW_CGET, PW_CONFIGURE, PW_FORGET, PW_IDENTIFY, PW_PANECGET,
+ PW_PANECONFIGURE, PW_PANES, PW_PROXY, PW_SASH
+ };
+ Tcl_Obj *resultObj;
+ int index, count, i, x, y;
+ Tk_Window tkwin;
+ Slave *slavePtr;
+
+ if (objc < 2) {
+ Tcl_WrongNumArgs(interp, 1, objv, "option ?arg arg...?");
+ return TCL_ERROR;
+ }
+
+ if (Tcl_GetIndexFromObj(interp, objv[1], optionStrings, "command",
+ 0, &index) != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ Tcl_Preserve(pwPtr);
+
+ switch ((enum options) index) {
+ case PW_ADD:
+ if (objc < 3) {
+ Tcl_WrongNumArgs(interp, 2, objv, "widget ?widget ...?");
+ result = TCL_ERROR;
+ break;
+ }
+ result = ConfigureSlaves(pwPtr, interp, objc, objv);
+ break;
+
+ case PW_CGET:
+ if (objc != 3) {
+ Tcl_WrongNumArgs(interp, 2, objv, "option");
+ result = TCL_ERROR;
+ break;
+ }
+ resultObj = Tk_GetOptionValue(interp, (char *) pwPtr,
+ pwPtr->optionTable, objv[2], pwPtr->tkwin);
+ if (resultObj == NULL) {
+ result = TCL_ERROR;
+ } else {
+ Tcl_SetObjResult(interp, resultObj);
+ }
+ break;
+
+ case PW_CONFIGURE:
+ resultObj = NULL;
+ if (objc <= 3) {
+ resultObj = Tk_GetOptionInfo(interp, (char *) pwPtr,
+ pwPtr->optionTable,
+ (objc == 3) ? objv[2] : NULL, pwPtr->tkwin);
+ if (resultObj == NULL) {
+ result = TCL_ERROR;
+ } else {
+ Tcl_SetObjResult(interp, resultObj);
+ }
+ } else {
+ result = ConfigurePanedWindow(interp, pwPtr, objc - 2, objv + 2);
+ }
+ break;
+
+ case PW_FORGET: {
+ int i;
+
+ if (objc < 3) {
+ Tcl_WrongNumArgs(interp, 2, objv, "widget ?widget ...?");
+ result = TCL_ERROR;
+ break;
+ }
+
+ /*
+ * Clean up each window named in the arg list.
+ */
+ for (count = 0, i = 2; i < objc; i++) {
+ Tk_Window slave = Tk_NameToWindow(interp, Tcl_GetString(objv[i]),
+ pwPtr->tkwin);
+
+ if (slave == NULL) {
+ continue;
+ }
+ slavePtr = GetPane(pwPtr, slave);
+ if ((slavePtr != NULL) && (slavePtr->masterPtr != NULL)) {
+ count++;
+ Tk_ManageGeometry(slave, NULL, NULL);
+ Tk_UnmaintainGeometry(slavePtr->tkwin, pwPtr->tkwin);
+ Tk_DeleteEventHandler(slavePtr->tkwin, StructureNotifyMask,
+ SlaveStructureProc, slavePtr);
+ Tk_UnmapWindow(slavePtr->tkwin);
+ Unlink(slavePtr);
+ }
+ if (count != 0) {
+ ComputeGeometry(pwPtr);
+ }
+ }
+ break;
+ }
+
+ case PW_IDENTIFY:
+ if (objc != 4) {
+ Tcl_WrongNumArgs(interp, 2, objv, "x y");
+ result = TCL_ERROR;
+ break;
+ }
+
+ if ((Tcl_GetIntFromObj(interp, objv[2], &x) != TCL_OK)
+ || (Tcl_GetIntFromObj(interp, objv[3], &y) != TCL_OK)) {
+ result = TCL_ERROR;
+ break;
+ }
+ result = PanedWindowIdentifyCoords(pwPtr, interp, x, y);
+ break;
+
+ case PW_PANECGET:
+ if (objc != 4) {
+ Tcl_WrongNumArgs(interp, 2, objv, "pane option");
+ result = TCL_ERROR;
+ break;
+ }
+ tkwin = Tk_NameToWindow(interp, Tcl_GetString(objv[2]), pwPtr->tkwin);
+ if (tkwin == NULL) {
+ result = TCL_ERROR;
+ break;
+ }
+ resultObj = NULL;
+ for (i = 0; i < pwPtr->numSlaves; i++) {
+ if (pwPtr->slaves[i]->tkwin == tkwin) {
+ resultObj = Tk_GetOptionValue(interp,
+ (char *) pwPtr->slaves[i], pwPtr->slaveOpts,
+ objv[3], tkwin);
+ }
+ }
+ if (resultObj == NULL) {
+ if (i == pwPtr->numSlaves) {
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "not managed by this window", -1));
+ Tcl_SetErrorCode(interp, "TK", "PANEDWINDOW", "UNMANAGED",
+ NULL);
+ }
+ result = TCL_ERROR;
+ } else {
+ Tcl_SetObjResult(interp, resultObj);
+ }
+ break;
+
+ case PW_PANECONFIGURE:
+ if (objc < 3) {
+ Tcl_WrongNumArgs(interp, 2, objv,
+ "pane ?option? ?value option value ...?");
+ result = TCL_ERROR;
+ break;
+ }
+ resultObj = NULL;
+ if (objc <= 4) {
+ tkwin = Tk_NameToWindow(interp, Tcl_GetString(objv[2]),
+ pwPtr->tkwin);
+ if (tkwin == NULL) {
+ /*
+ * Just a plain old bad window; Tk_NameToWindow filled in an
+ * error message for us.
+ */
+
+ result = TCL_ERROR;
+ break;
+ }
+ for (i = 0; i < pwPtr->numSlaves; i++) {
+ if (pwPtr->slaves[i]->tkwin == tkwin) {
+ resultObj = Tk_GetOptionInfo(interp,
+ (char *) pwPtr->slaves[i], pwPtr->slaveOpts,
+ (objc == 4) ? objv[3] : NULL,
+ pwPtr->tkwin);
+ if (resultObj == NULL) {
+ result = TCL_ERROR;
+ } else {
+ Tcl_SetObjResult(interp, resultObj);
+ }
+ break;
+ }
+ }
+ } else {
+ result = ConfigureSlaves(pwPtr, interp, objc, objv);
+ }
+ break;
+
+ case PW_PANES:
+ resultObj = Tcl_NewObj();
+ for (i = 0; i < pwPtr->numSlaves; i++) {
+ Tcl_ListObjAppendElement(NULL, resultObj,
+ TkNewWindowObj(pwPtr->slaves[i]->tkwin));
+ }
+ Tcl_SetObjResult(interp, resultObj);
+ break;
+
+ case PW_PROXY:
+ result = PanedWindowProxyCommand(pwPtr, interp, objc, objv);
+ break;
+
+ case PW_SASH:
+ result = PanedWindowSashCommand(pwPtr, interp, objc, objv);
+ break;
+ }
+ Tcl_Release(pwPtr);
+ return result;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ConfigureSlaves --
+ *
+ * Add or alter the configuration options of a slave in a paned window.
+ *
+ * Results:
+ * Standard Tcl result.
+ *
+ * Side effects:
+ * Depends on options; may add a slave to the paned window, may alter the
+ * geometry management options of a slave.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+ConfigureSlaves(
+ PanedWindow *pwPtr, /* Information about paned window. */
+ Tcl_Interp *interp, /* Current interpreter. */
+ int objc, /* Number of arguments. */
+ Tcl_Obj *const objv[]) /* Argument objects. */
+{
+ int i, firstOptionArg, j, found, doubleBw, index, numNewSlaves, haveLoc;
+ int insertIndex;
+ Tk_Window tkwin = NULL, ancestor, parent;
+ Slave *slavePtr, **inserts, **newSlaves;
+ Slave options;
+ const char *arg;
+
+ /*
+ * Find the non-window name arguments; these are the configure options for
+ * the slaves. Also validate that the window names given are legitimate
+ * (ie, they are real windows, they are not the panedwindow itself, etc.).
+ */
+
+ for (i = 2; i < objc; i++) {
+ arg = Tcl_GetString(objv[i]);
+ if (arg[0] == '-') {
+ break;
+ } else {
+ tkwin = Tk_NameToWindow(interp, arg, pwPtr->tkwin);
+ if (tkwin == NULL) {
+ /*
+ * Just a plain old bad window; Tk_NameToWindow filled in an
+ * error message for us.
+ */
+
+ return TCL_ERROR;
+ } else if (tkwin == pwPtr->tkwin) {
+ /*
+ * A panedwindow cannot manage itself.
+ */
+
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "can't add %s to itself", arg));
+ Tcl_SetErrorCode(interp, "TK", "GEOMETRY", "SELF", NULL);
+ return TCL_ERROR;
+ } else if (Tk_IsTopLevel(tkwin)) {
+ /*
+ * A panedwindow cannot manage a toplevel.
+ */
+
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "can't add toplevel %s to %s", arg,
+ Tk_PathName(pwPtr->tkwin)));
+ Tcl_SetErrorCode(interp, "TK", "GEOMETRY", "TOPLEVEL", NULL);
+ return TCL_ERROR;
+ } else {
+ /*
+ * Make sure the panedwindow is the parent of the slave,
+ * or a descendant of the slave's parent.
+ */
+
+ parent = Tk_Parent(tkwin);
+ for (ancestor = pwPtr->tkwin;;ancestor = Tk_Parent(ancestor)) {
+ if (ancestor == parent) {
+ break;
+ }
+ if (Tk_IsTopLevel(ancestor)) {
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "can't add %s to %s", arg,
+ Tk_PathName(pwPtr->tkwin)));
+ Tcl_SetErrorCode(interp, "TK", "GEOMETRY",
+ "HIERARCHY", NULL);
+ return TCL_ERROR;
+ }
+ }
+ }
+ }
+ }
+ firstOptionArg = i;
+
+ /*
+ * Pre-parse the configuration options, to get the before/after specifiers
+ * into an easy-to-find location (a local variable). Also, check the
+ * return from Tk_SetOptions once, here, so we can save a little bit of
+ * extra testing in the for loop below.
+ */
+
+ memset((void *)&options, 0, sizeof(Slave));
+ if (Tk_SetOptions(interp, (char *) &options, pwPtr->slaveOpts,
+ objc - firstOptionArg, objv + firstOptionArg,
+ pwPtr->tkwin, NULL, NULL) != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ /*
+ * If either -after or -before was given, find the numerical index that
+ * corresponds to the given window. If both -after and -before are given,
+ * the option precedence is: -after, then -before.
+ */
+
+ index = -1;
+ haveLoc = 0;
+ if (options.after != None) {
+ tkwin = options.after;
+ haveLoc = 1;
+ for (i = 0; i < pwPtr->numSlaves; i++) {
+ if (options.after == pwPtr->slaves[i]->tkwin) {
+ index = i + 1;
+ break;
+ }
+ }
+ } else if (options.before != None) {
+ tkwin = options.before;
+ haveLoc = 1;
+ for (i = 0; i < pwPtr->numSlaves; i++) {
+ if (options.before == pwPtr->slaves[i]->tkwin) {
+ index = i;
+ break;
+ }
+ }
+ }
+
+ /*
+ * If a window was given for -after/-before, but it's not a window managed
+ * by the panedwindow, throw an error
+ */
+
+ if (haveLoc && index == -1) {
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "window \"%s\" is not managed by %s",
+ Tk_PathName(tkwin), Tk_PathName(pwPtr->tkwin)));
+ Tcl_SetErrorCode(interp, "TK", "PANEDWINDOW", "UNMANAGED", NULL);
+ Tk_FreeConfigOptions((char *) &options, pwPtr->slaveOpts,
+ pwPtr->tkwin);
+ return TCL_ERROR;
+ }
+
+ /*
+ * Allocate an array to hold, in order, the pointers to the slave
+ * structures corresponding to the windows specified. Some of those
+ * structures may already have existed, some may be new.
+ */
+
+ inserts = ckalloc(sizeof(Slave *) * (firstOptionArg - 2));
+ insertIndex = 0;
+
+ /*
+ * Populate the inserts array, creating new slave structures as necessary,
+ * applying the options to each structure as we go, and, if necessary,
+ * marking the spot in the original slaves array as empty (for
+ * pre-existing slave structures).
+ */
+
+ for (i = 0, numNewSlaves = 0; i < firstOptionArg - 2; i++) {
+ /*
+ * We don't check that tkwin is NULL here, because the pre-pass above
+ * guarantees that the input at this stage is good.
+ */
+
+ tkwin = Tk_NameToWindow(interp, Tcl_GetString(objv[i + 2]),
+ pwPtr->tkwin);
+
+ found = 0;
+ for (j = 0; j < pwPtr->numSlaves; j++) {
+ if (pwPtr->slaves[j] != NULL && pwPtr->slaves[j]->tkwin == tkwin) {
+ Tk_SetOptions(interp, (char *) pwPtr->slaves[j],
+ pwPtr->slaveOpts, objc - firstOptionArg,
+ objv + firstOptionArg, pwPtr->tkwin, NULL, NULL);
+ if (pwPtr->slaves[j]->minSize < 0) {
+ pwPtr->slaves[j]->minSize = 0;
+ }
+ found = 1;
+
+ /*
+ * If the slave is supposed to move, add it to the inserts
+ * array now; otherwise, leave it where it is.
+ */
+
+ if (index != -1) {
+ inserts[insertIndex++] = pwPtr->slaves[j];
+ pwPtr->slaves[j] = NULL;
+ }
+ break;
+ }
+ }
+
+ if (found) {
+ continue;
+ }
+
+ /*
+ * Make sure this slave wasn't already put into the inserts array,
+ * i.e., when the user specifies the same window multiple times in a
+ * single add commaned.
+ */
+ for (j = 0; j < insertIndex; j++) {
+ if (inserts[j]->tkwin == tkwin) {
+ found = 1;
+ break;
+ }
+ }
+ if (found) {
+ continue;
+ }
+
+ /*
+ * Create a new slave structure and initialize it. All slaves start
+ * out with their "natural" dimensions.
+ */
+
+ slavePtr = ckalloc(sizeof(Slave));
+ memset(slavePtr, 0, sizeof(Slave));
+ Tk_InitOptions(interp, (char *)slavePtr, pwPtr->slaveOpts,
+ pwPtr->tkwin);
+ Tk_SetOptions(interp, (char *)slavePtr, pwPtr->slaveOpts,
+ objc - firstOptionArg, objv + firstOptionArg,
+ pwPtr->tkwin, NULL, NULL);
+ slavePtr->tkwin = tkwin;
+ slavePtr->masterPtr = pwPtr;
+ doubleBw = 2 * Tk_Changes(slavePtr->tkwin)->border_width;
+ if (slavePtr->width > 0) {
+ slavePtr->paneWidth = slavePtr->width;
+ } else {
+ slavePtr->paneWidth = Tk_ReqWidth(tkwin) + doubleBw;
+ }
+ if (slavePtr->height > 0) {
+ slavePtr->paneHeight = slavePtr->height;
+ } else {
+ slavePtr->paneHeight = Tk_ReqHeight(tkwin) + doubleBw;
+ }
+ if (slavePtr->minSize < 0) {
+ slavePtr->minSize = 0;
+ }
+
+ /*
+ * Set up the geometry management callbacks for this slave.
+ */
+
+ Tk_CreateEventHandler(slavePtr->tkwin, StructureNotifyMask,
+ SlaveStructureProc, slavePtr);
+ Tk_ManageGeometry(slavePtr->tkwin, &panedWindowMgrType, slavePtr);
+ inserts[insertIndex++] = slavePtr;
+ numNewSlaves++;
+ }
+
+ /*
+ * Allocate the new slaves array, then copy the slaves into it, in order.
+ */
+
+ i = sizeof(Slave *) * (pwPtr->numSlaves + numNewSlaves);
+ newSlaves = ckalloc(i);
+ memset(newSlaves, 0, (size_t) i);
+ if (index == -1) {
+ /*
+ * If none of the existing slaves have to be moved, just copy the old
+ * and append the new.
+ */
+ memcpy((void *)&(newSlaves[0]), pwPtr->slaves,
+ sizeof(Slave *) * pwPtr->numSlaves);
+ memcpy((void *)&(newSlaves[pwPtr->numSlaves]), inserts,
+ sizeof(Slave *) * numNewSlaves);
+ } else {
+ /*
+ * If some of the existing slaves were moved, the old slaves array
+ * will be partially populated, with some valid and some invalid
+ * entries. Walk through it, copying valid entries to the new slaves
+ * array as we go; when we get to the insert location for the new
+ * slaves, copy the inserts array over, then finish off the old slaves
+ * array.
+ */
+
+ for (i = 0, j = 0; i < index; i++) {
+ if (pwPtr->slaves[i] != NULL) {
+ newSlaves[j] = pwPtr->slaves[i];
+ j++;
+ }
+ }
+
+ memcpy((void *)&(newSlaves[j]), inserts, sizeof(Slave *)*insertIndex);
+ j += firstOptionArg - 2;
+
+ for (i = index; i < pwPtr->numSlaves; i++) {
+ if (pwPtr->slaves[i] != NULL) {
+ newSlaves[j] = pwPtr->slaves[i];
+ j++;
+ }
+ }
+ }
+
+ /*
+ * Make the new slaves array the paned window's slave array, and clean up.
+ */
+
+ ckfree(pwPtr->slaves);
+ ckfree(inserts);
+ pwPtr->slaves = newSlaves;
+
+ /*
+ * Set the paned window's slave count to the new value.
+ */
+
+ pwPtr->numSlaves += numNewSlaves;
+
+ Tk_FreeConfigOptions((char *) &options, pwPtr->slaveOpts, pwPtr->tkwin);
+
+ ComputeGeometry(pwPtr);
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * PanedWindowSashCommand --
+ *
+ * Implementation of the panedwindow sash subcommand. See the user
+ * documentation for details on what it does.
+ *
+ * Results:
+ * Standard Tcl result.
+ *
+ * Side effects:
+ * Depends on the arguments.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+PanedWindowSashCommand(
+ PanedWindow *pwPtr, /* Pointer to paned window information. */
+ Tcl_Interp *interp, /* Current interpreter. */
+ int objc, /* Number of arguments. */
+ Tcl_Obj *const objv[]) /* Argument objects. */
+{
+ static const char *const sashOptionStrings[] = {
+ "coord", "dragto", "mark", "place", NULL
+ };
+ enum sashOptions {
+ SASH_COORD, SASH_DRAGTO, SASH_MARK, SASH_PLACE
+ };
+ int index, sash, x, y, diff;
+ Tcl_Obj *coords[2];
+ Slave *slavePtr;
+
+ if (objc < 3) {
+ Tcl_WrongNumArgs(interp, 2, objv, "option ?arg ...?");
+ return TCL_ERROR;
+ }
+
+ if (Tcl_GetIndexFromObj(interp, objv[2], sashOptionStrings, "option", 0,
+ &index) != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ switch ((enum sashOptions) index) {
+ case SASH_COORD:
+ if (objc != 4) {
+ Tcl_WrongNumArgs(interp, 3, objv, "index");
+ return TCL_ERROR;
+ }
+
+ if (Tcl_GetIntFromObj(interp, objv[3], &sash) != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ if (!ValidSashIndex(pwPtr, sash)) {
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "invalid sash index", -1));
+ Tcl_SetErrorCode(interp, "TK", "VALUE", "SASH_INDEX", NULL);
+ return TCL_ERROR;
+ }
+ slavePtr = pwPtr->slaves[sash];
+
+ coords[0] = Tcl_NewIntObj(slavePtr->sashx);
+ coords[1] = Tcl_NewIntObj(slavePtr->sashy);
+ Tcl_SetObjResult(interp, Tcl_NewListObj(2, coords));
+ break;
+
+ case SASH_MARK:
+ if (objc != 6 && objc != 4) {
+ Tcl_WrongNumArgs(interp, 3, objv, "index ?x y?");
+ return TCL_ERROR;
+ }
+
+ if (Tcl_GetIntFromObj(interp, objv[3], &sash) != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ if (!ValidSashIndex(pwPtr, sash)) {
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "invalid sash index", -1));
+ Tcl_SetErrorCode(interp, "TK", "VALUE", "SASH_INDEX", NULL);
+ return TCL_ERROR;
+ }
+
+ if (objc == 6) {
+ if (Tcl_GetIntFromObj(interp, objv[4], &x) != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ if (Tcl_GetIntFromObj(interp, objv[5], &y) != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ pwPtr->slaves[sash]->markx = x;
+ pwPtr->slaves[sash]->marky = y;
+ } else {
+ coords[0] = Tcl_NewIntObj(pwPtr->slaves[sash]->markx);
+ coords[1] = Tcl_NewIntObj(pwPtr->slaves[sash]->marky);
+ Tcl_SetObjResult(interp, Tcl_NewListObj(2, coords));
+ }
+ break;
+
+ case SASH_DRAGTO:
+ case SASH_PLACE:
+ if (objc != 6) {
+ Tcl_WrongNumArgs(interp, 3, objv, "index x y");
+ return TCL_ERROR;
+ }
+
+ if (Tcl_GetIntFromObj(interp, objv[3], &sash) != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ if (!ValidSashIndex(pwPtr, sash)) {
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "invalid sash index", -1));
+ Tcl_SetErrorCode(interp, "TK", "VALUE", "SASH_INDEX", NULL);
+ return TCL_ERROR;
+ }
+
+ if (Tcl_GetIntFromObj(interp, objv[4], &x) != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ if (Tcl_GetIntFromObj(interp, objv[5], &y) != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ slavePtr = pwPtr->slaves[sash];
+ if (pwPtr->orient == ORIENT_HORIZONTAL) {
+ if (index == SASH_PLACE) {
+ diff = x - pwPtr->slaves[sash]->sashx;
+ } else {
+ diff = x - pwPtr->slaves[sash]->markx;
+ }
+ } else {
+ if (index == SASH_PLACE) {
+ diff = y - pwPtr->slaves[sash]->sashy;
+ } else {
+ diff = y - pwPtr->slaves[sash]->marky;
+ }
+ }
+
+ MoveSash(pwPtr, sash, diff);
+ ComputeGeometry(pwPtr);
+ }
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ConfigurePanedWindow --
+ *
+ * This function is called to process an argv/argc list in conjunction
+ * with the Tk option database to configure (or reconfigure) a paned
+ * window widget.
+ *
+ * Results:
+ * The return value is a standard Tcl result. If TCL_ERROR is returned,
+ * then the interp's result contains an error message.
+ *
+ * Side effects:
+ * Configuration information, such as colors, border width, etc. get set
+ * for pwPtr; old resources get freed, if there were any.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+ConfigurePanedWindow(
+ Tcl_Interp *interp, /* Used for error reporting. */
+ PanedWindow *pwPtr, /* Information about widget. */
+ int objc, /* Number of arguments. */
+ Tcl_Obj *const objv[]) /* Argument values. */
+{
+ Tk_SavedOptions savedOptions;
+ int typemask = 0;
+
+ if (Tk_SetOptions(interp, (char *) pwPtr, pwPtr->optionTable, objc, objv,
+ pwPtr->tkwin, &savedOptions, &typemask) != TCL_OK) {
+ Tk_RestoreSavedOptions(&savedOptions);
+ return TCL_ERROR;
+ }
+
+ Tk_FreeSavedOptions(&savedOptions);
+
+ PanedWindowWorldChanged(pwPtr);
+
+ /*
+ * If an option that affects geometry has changed, make a re-layout
+ * request.
+ */
+
+ if (typemask & GEOMETRY) {
+ ComputeGeometry(pwPtr);
+ }
+
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * PanedWindowWorldChanged --
+ *
+ * This function is invoked anytime a paned window's world has changed in
+ * some way that causes the widget to have to recompute graphics contexts
+ * and geometry.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Paned window will be relayed out and redisplayed.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+PanedWindowWorldChanged(
+ ClientData instanceData) /* Information about the paned window. */
+{
+ XGCValues gcValues;
+ GC newGC;
+ PanedWindow *pwPtr = instanceData;
+
+ /*
+ * Allocated a graphics context for drawing the paned window widget
+ * elements (background, sashes, etc.) and set the window background.
+ */
+
+ gcValues.background = Tk_3DBorderColor(pwPtr->background)->pixel;
+ newGC = Tk_GetGC(pwPtr->tkwin, GCBackground, &gcValues);
+ if (pwPtr->gc != None) {
+ Tk_FreeGC(pwPtr->display, pwPtr->gc);
+ }
+ pwPtr->gc = newGC;
+ Tk_SetWindowBackground(pwPtr->tkwin, gcValues.background);
+
+ /*
+ * Issue geometry size requests to Tk.
+ */
+
+ Tk_SetInternalBorder(pwPtr->tkwin, pwPtr->borderWidth);
+ if (pwPtr->width > 0 && pwPtr->height > 0) {
+ Tk_GeometryRequest(pwPtr->tkwin, pwPtr->width, pwPtr->height);
+ }
+
+ /*
+ * Arrange for the window to be redrawn, if neccessary.
+ */
+
+ if (Tk_IsMapped(pwPtr->tkwin) && !(pwPtr->flags & REDRAW_PENDING)) {
+ Tcl_DoWhenIdle(DisplayPanedWindow, pwPtr);
+ pwPtr->flags |= REDRAW_PENDING;
+ }
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * PanedWindowEventProc --
+ *
+ * This function is invoked by the Tk dispatcher for various events on
+ * paned windows.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * When the window gets deleted, internal structures get cleaned up. When
+ * it gets exposed, it is redisplayed.
+ *
+ *--------------------------------------------------------------
+ */
+
+static void
+PanedWindowEventProc(
+ ClientData clientData, /* Information about window. */
+ XEvent *eventPtr) /* Information about event. */
+{
+ PanedWindow *pwPtr = clientData;
+ int i;
+
+ if (eventPtr->type == Expose) {
+ if (pwPtr->tkwin != NULL && !(pwPtr->flags & REDRAW_PENDING)) {
+ Tcl_DoWhenIdle(DisplayPanedWindow, pwPtr);
+ pwPtr->flags |= REDRAW_PENDING;
+ }
+ } else if (eventPtr->type == ConfigureNotify) {
+ pwPtr->flags |= REQUESTED_RELAYOUT;
+ if (pwPtr->tkwin != NULL && !(pwPtr->flags & REDRAW_PENDING)) {
+ Tcl_DoWhenIdle(DisplayPanedWindow, pwPtr);
+ pwPtr->flags |= REDRAW_PENDING;
+ }
+ } else if (eventPtr->type == DestroyNotify) {
+ DestroyPanedWindow(pwPtr);
+ } else if (eventPtr->type == UnmapNotify) {
+ for (i = 0; i < pwPtr->numSlaves; i++) {
+ if (!pwPtr->slaves[i]->hide) {
+ Tk_UnmapWindow(pwPtr->slaves[i]->tkwin);
+ }
+ }
+ } else if (eventPtr->type == MapNotify) {
+ for (i = 0; i < pwPtr->numSlaves; i++) {
+ if (!pwPtr->slaves[i]->hide) {
+ Tk_MapWindow(pwPtr->slaves[i]->tkwin);
+ }
+ }
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * PanedWindowCmdDeletedProc --
+ *
+ * This function is invoked when a widget command is deleted. If the
+ * widget isn't already in the process of being destroyed, this command
+ * destroys it.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The widget is destroyed.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+PanedWindowCmdDeletedProc(
+ ClientData clientData) /* Pointer to widget record for widget. */
+{
+ PanedWindow *pwPtr = clientData;
+
+ /*
+ * This function could be invoked either because the window was destroyed
+ * and the command was then deleted or because the command was deleted,
+ * and then this function destroys the widget. The WIDGET_DELETED flag
+ * distinguishes these cases.
+ */
+
+ if (!(pwPtr->flags & WIDGET_DELETED)) {
+ Tk_DestroyWindow(pwPtr->proxywin);
+ Tk_DestroyWindow(pwPtr->tkwin);
+ }
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * DisplayPanedWindow --
+ *
+ * This function redraws the contents of a paned window widget. It is
+ * invoked as a do-when-idle handler, so it only runs when there's
+ * nothing else for the application to do.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Information appears on the screen.
+ *
+ *--------------------------------------------------------------
+ */
+
+static void
+DisplayPanedWindow(
+ ClientData clientData) /* Information about window. */
+{
+ PanedWindow *pwPtr = clientData;
+ Slave *slavePtr;
+ Pixmap pixmap;
+ Tk_Window tkwin = pwPtr->tkwin;
+ int i, sashWidth, sashHeight;
+ const int horizontal = (pwPtr->orient == ORIENT_HORIZONTAL);
+ int first, last;
+
+ pwPtr->flags &= ~REDRAW_PENDING;
+ if ((pwPtr->tkwin == NULL) || !Tk_IsMapped(tkwin)) {
+ return;
+ }
+
+ if (pwPtr->flags & REQUESTED_RELAYOUT) {
+ ArrangePanes(clientData);
+ }
+
+#ifndef TK_NO_DOUBLE_BUFFERING
+ /*
+ * Create a pixmap for double-buffering, if necessary.
+ */
+
+ pixmap = Tk_GetPixmap(Tk_Display(tkwin), Tk_WindowId(tkwin),
+ Tk_Width(tkwin), Tk_Height(tkwin), Tk_Depth(tkwin));
+#else
+ pixmap = Tk_WindowId(tkwin);
+#endif /* TK_NO_DOUBLE_BUFFERING */
+
+ /*
+ * Redraw the widget's background and border.
+ */
+
+ Tk_Fill3DRectangle(tkwin, pixmap, pwPtr->background, 0, 0,
+ Tk_Width(tkwin), Tk_Height(tkwin), pwPtr->borderWidth,
+ pwPtr->relief);
+
+ /*
+ * Set up boilerplate geometry values for sashes (width, height, common
+ * coordinates).
+ */
+
+ if (horizontal) {
+ sashHeight = Tk_Height(tkwin) - (2 * Tk_InternalBorderWidth(tkwin));
+ sashWidth = pwPtr->sashWidth;
+ } else {
+ sashWidth = Tk_Width(tkwin) - (2 * Tk_InternalBorderWidth(tkwin));
+ sashHeight = pwPtr->sashWidth;
+ }
+
+ /*
+ * Draw the sashes.
+ */
+
+ GetFirstLastVisiblePane(pwPtr, &first, &last);
+ for (i = 0; i < pwPtr->numSlaves - 1; i++) {
+ slavePtr = pwPtr->slaves[i];
+ if (slavePtr->hide || i == last) {
+ continue;
+ }
+ if (sashWidth > 0 && sashHeight > 0) {
+ Tk_Fill3DRectangle(tkwin, pixmap, pwPtr->background,
+ slavePtr->sashx, slavePtr->sashy, sashWidth, sashHeight,
+ 1, pwPtr->sashRelief);
+ }
+ if (pwPtr->showHandle) {
+ Tk_Fill3DRectangle(tkwin, pixmap, pwPtr->background,
+ slavePtr->handlex, slavePtr->handley,
+ pwPtr->handleSize, pwPtr->handleSize, 1,
+ TK_RELIEF_RAISED);
+ }
+ }
+
+#ifndef TK_NO_DOUBLE_BUFFERING
+ /*
+ * Copy the information from the off-screen pixmap onto the screen, then
+ * delete the pixmap.
+ */
+
+ XCopyArea(Tk_Display(tkwin), pixmap, Tk_WindowId(tkwin), pwPtr->gc, 0, 0,
+ (unsigned) Tk_Width(tkwin), (unsigned) Tk_Height(tkwin), 0, 0);
+ Tk_FreePixmap(Tk_Display(tkwin), pixmap);
+#endif /* TK_NO_DOUBLE_BUFFERING */
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * DestroyPanedWindow --
+ *
+ * This function is invoked by PanedWindowEventProc to free the internal
+ * structure of a paned window.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Everything associated with the paned window is freed up.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+DestroyPanedWindow(
+ PanedWindow *pwPtr) /* Info about paned window widget. */
+{
+ int i;
+
+ /*
+ * First mark the widget as in the process of being deleted, so that any
+ * code that causes calls to other paned window functions will abort.
+ */
+
+ pwPtr->flags |= WIDGET_DELETED;
+
+ /*
+ * Cancel idle callbacks for redrawing the widget and for rearranging the
+ * panes.
+ */
+
+ if (pwPtr->flags & REDRAW_PENDING) {
+ Tcl_CancelIdleCall(DisplayPanedWindow, pwPtr);
+ }
+ if (pwPtr->flags & RESIZE_PENDING) {
+ Tcl_CancelIdleCall(ArrangePanes, pwPtr);
+ }
+
+ /*
+ * Clean up the slave list; foreach slave:
+ * o Cancel the slave's structure notification callback
+ * o Cancel geometry management for the slave.
+ * o Free memory for the slave
+ */
+
+ for (i = 0; i < pwPtr->numSlaves; i++) {
+ Tk_DeleteEventHandler(pwPtr->slaves[i]->tkwin, StructureNotifyMask,
+ SlaveStructureProc, pwPtr->slaves[i]);
+ Tk_ManageGeometry(pwPtr->slaves[i]->tkwin, NULL, NULL);
+ Tk_FreeConfigOptions((char *) pwPtr->slaves[i], pwPtr->slaveOpts,
+ pwPtr->tkwin);
+ ckfree(pwPtr->slaves[i]);
+ pwPtr->slaves[i] = NULL;
+ }
+ if (pwPtr->slaves) {
+ ckfree(pwPtr->slaves);
+ }
+
+ /*
+ * Remove the widget command from the interpreter.
+ */
+
+ Tcl_DeleteCommandFromToken(pwPtr->interp, pwPtr->widgetCmd);
+
+ /*
+ * Let Tk_FreeConfigOptions clean up the rest.
+ */
+
+ Tk_FreeConfigOptions((char *) pwPtr, pwPtr->optionTable, pwPtr->tkwin);
+ Tcl_Release(pwPtr->tkwin);
+ pwPtr->tkwin = NULL;
+
+ Tcl_EventuallyFree(pwPtr, TCL_DYNAMIC);
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * PanedWindowReqProc --
+ *
+ * This function is invoked by Tk_GeometryRequest for windows managed by
+ * a paned window.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Arranges for tkwin, and all its managed siblings, to be re-arranged at
+ * the next idle point.
+ *
+ *--------------------------------------------------------------
+ */
+
+static void
+PanedWindowReqProc(
+ ClientData clientData, /* Paned window's information about window
+ * that got new preferred geometry. */
+ Tk_Window tkwin) /* Other Tk-related information about the
+ * window. */
+{
+ Slave *slavePtr = clientData;
+ PanedWindow *pwPtr = (PanedWindow *) slavePtr->masterPtr;
+
+ if (Tk_IsMapped(pwPtr->tkwin)) {
+ if (!(pwPtr->flags & RESIZE_PENDING)) {
+ pwPtr->flags |= RESIZE_PENDING;
+ Tcl_DoWhenIdle(ArrangePanes, pwPtr);
+ }
+ } else {
+ int doubleBw = 2 * Tk_Changes(slavePtr->tkwin)->border_width;
+
+ if (slavePtr->width <= 0) {
+ slavePtr->paneWidth = Tk_ReqWidth(slavePtr->tkwin) + doubleBw;
+ }
+ if (slavePtr->height <= 0) {
+ slavePtr->paneHeight = Tk_ReqHeight(slavePtr->tkwin) + doubleBw;
+ }
+ ComputeGeometry(pwPtr);
+ }
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * PanedWindowLostSlaveProc --
+ *
+ * This function is invoked by Tk whenever some other geometry claims
+ * control over a slave that used to be managed by us.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Forgets all information about the slave. Causes geometry to be
+ * recomputed for the panedwindow.
+ *
+ *--------------------------------------------------------------
+ */
+
+static void
+PanedWindowLostSlaveProc(
+ ClientData clientData, /* Grid structure for slave window that was
+ * stolen away. */
+ Tk_Window tkwin) /* Tk's handle for the slave window. */
+{
+ register Slave *slavePtr = clientData;
+ PanedWindow *pwPtr = (PanedWindow *) slavePtr->masterPtr;
+
+ if (pwPtr->tkwin != Tk_Parent(slavePtr->tkwin)) {
+ Tk_UnmaintainGeometry(slavePtr->tkwin, pwPtr->tkwin);
+ }
+ Unlink(slavePtr);
+ Tk_DeleteEventHandler(slavePtr->tkwin, StructureNotifyMask,
+ SlaveStructureProc, slavePtr);
+ Tk_UnmapWindow(slavePtr->tkwin);
+ slavePtr->tkwin = NULL;
+ ckfree(slavePtr);
+ ComputeGeometry(pwPtr);
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * ArrangePanes --
+ *
+ * This function is invoked (using the Tcl_DoWhenIdle mechanism) to
+ * re-layout a set of windows managed by a paned window. It is invoked at
+ * idle time so that a series of pane requests can be merged into a
+ * single layout operation.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The slaves of masterPtr may get resized or moved.
+ *
+ *--------------------------------------------------------------
+ */
+
+static void
+ArrangePanes(
+ ClientData clientData) /* Structure describing parent whose slaves
+ * are to be re-layed out. */
+{
+ register PanedWindow *pwPtr = clientData;
+ register Slave *slavePtr;
+ int i, slaveWidth, slaveHeight, slaveX, slaveY;
+ int paneWidth, paneHeight, paneSize, paneMinSize;
+ int doubleBw;
+ int x, y;
+ int sashWidth, sashOffset, sashCount, handleOffset;
+ int sashReserve, sxReserve, syReserve;
+ int internalBW;
+ int paneDynSize, paneDynMinSize, pwHeight, pwWidth, pwSize;
+ int first, last;
+ int stretchReserve, stretchAmount;
+ const int horizontal = (pwPtr->orient == ORIENT_HORIZONTAL);
+
+ pwPtr->flags &= ~(REQUESTED_RELAYOUT|RESIZE_PENDING);
+
+ /*
+ * If the parent has no slaves anymore, then don't do anything at all:
+ * just leave the parent's size as-is. Otherwise there is no way to
+ * "relinquish" control over the parent so another geometry manager can
+ * take over.
+ */
+
+ if (pwPtr->numSlaves == 0) {
+ return;
+ }
+
+ Tcl_Preserve(pwPtr);
+
+ /*
+ * Find index of first and last visible panes.
+ */
+
+ GetFirstLastVisiblePane(pwPtr, &first, &last);
+
+ /*
+ * First pass; compute sizes
+ */
+
+ paneDynSize = paneDynMinSize = 0;
+ internalBW = Tk_InternalBorderWidth(pwPtr->tkwin);
+ pwHeight = Tk_Height(pwPtr->tkwin) - (2 * internalBW);
+ pwWidth = Tk_Width(pwPtr->tkwin) - (2 * internalBW);
+ x = y = internalBW;
+ stretchReserve = (horizontal ? pwWidth : pwHeight);
+
+ /*
+ * Calculate the sash width, including handle and padding, and the sash
+ * and handle offsets.
+ */
+
+ sashOffset = handleOffset = pwPtr->sashPad;
+ if (pwPtr->showHandle && pwPtr->handleSize > pwPtr->sashWidth) {
+ sashWidth = (2 * pwPtr->sashPad) + pwPtr->handleSize;
+ sashOffset = ((pwPtr->handleSize - pwPtr->sashWidth) / 2)
+ + pwPtr->sashPad;
+ } else {
+ sashWidth = (2 * pwPtr->sashPad) + pwPtr->sashWidth;
+ handleOffset = ((pwPtr->sashWidth - pwPtr->handleSize) / 2)
+ + pwPtr->sashPad;
+ }
+
+ for (i = sashCount = 0; i < pwPtr->numSlaves; i++) {
+ slavePtr = pwPtr->slaves[i];
+
+ if (slavePtr->hide) {
+ continue;
+ }
+
+ /*
+ * Compute the total size needed by all the slaves and the left-over,
+ * or shortage of space available.
+ */
+
+ if (horizontal) {
+ paneSize = slavePtr->paneWidth;
+ stretchReserve -= paneSize + (2 * slavePtr->padx);
+ } else {
+ paneSize = slavePtr->paneHeight;
+ stretchReserve -= paneSize + (2 * slavePtr->pady);
+ }
+ if (IsStretchable(slavePtr->stretch,i,first,last)
+ && Tk_IsMapped(pwPtr->tkwin)) {
+ paneDynSize += paneSize;
+ paneDynMinSize += slavePtr->minSize;
+ }
+ if (i != last) {
+ stretchReserve -= sashWidth;
+ sashCount++;
+ }
+ }
+
+ /*
+ * Second pass; adjust/arrange panes.
+ */
+
+ for (i = 0; i < pwPtr->numSlaves; i++) {
+ slavePtr = pwPtr->slaves[i];
+
+ if (slavePtr->hide) {
+ Tk_UnmaintainGeometry(slavePtr->tkwin, pwPtr->tkwin);
+ Tk_UnmapWindow(slavePtr->tkwin);
+ continue;
+ }
+
+ /*
+ * Compute the size of this slave. The algorithm (assuming a
+ * horizontal paned window) is:
+ *
+ * 1. Get "base" dimensions. If a width or height is specified for
+ * this slave, use those values; else use the ReqWidth/ReqHeight.
+ * 2. Using base dimensions, pane dimensions, and sticky values,
+ * determine the x and y, and actual width and height of the
+ * widget.
+ */
+
+ doubleBw = 2 * Tk_Changes(slavePtr->tkwin)->border_width;
+ slaveWidth = (slavePtr->width > 0 ? slavePtr->width :
+ Tk_ReqWidth(slavePtr->tkwin) + doubleBw);
+ slaveHeight = (slavePtr->height > 0 ? slavePtr->height :
+ Tk_ReqHeight(slavePtr->tkwin) + doubleBw);
+ paneMinSize = slavePtr->minSize;
+
+ /*
+ * Calculate pane width and height.
+ */
+
+ if (horizontal) {
+ paneSize = slavePtr->paneWidth;
+ pwSize = pwWidth;
+ } else {
+ paneSize = slavePtr->paneHeight;
+ pwSize = pwHeight;
+ }
+ if (IsStretchable(slavePtr->stretch, i, first, last)) {
+ double frac;
+
+ if (paneDynSize > 0) {
+ frac = (double)paneSize / (double)paneDynSize;
+ } else {
+ frac = (double)paneSize / (double)pwSize;
+ }
+
+ paneDynSize -= paneSize;
+ paneDynMinSize -= slavePtr->minSize;
+ stretchAmount = (int) (frac * stretchReserve);
+ if (paneSize + stretchAmount >= paneMinSize) {
+ stretchReserve -= stretchAmount;
+ paneSize += stretchAmount;
+ } else {
+ stretchReserve += paneSize - paneMinSize;
+ paneSize = paneMinSize;
+ }
+ if (i == last && stretchReserve > 0) {
+ paneSize += stretchReserve;
+ stretchReserve = 0;
+ }
+ } else if (paneDynSize - paneDynMinSize + stretchReserve < 0) {
+ if (paneSize + paneDynSize - paneDynMinSize + stretchReserve
+ <= paneMinSize) {
+ stretchReserve += paneSize - paneMinSize;
+ paneSize = paneMinSize;
+ } else {
+ paneSize += paneDynSize - paneDynMinSize + stretchReserve;
+ stretchReserve = paneDynMinSize - paneDynSize;
+ }
+ }
+ if (horizontal) {
+ paneWidth = paneSize;
+ paneHeight = pwHeight - (2 * slavePtr->pady);
+ } else {
+ paneWidth = pwWidth - (2 * slavePtr->padx);
+ paneHeight = paneSize;
+ }
+
+ /*
+ * Adjust for area reserved for sashes.
+ */
+
+ if (sashCount) {
+ sashReserve = sashWidth * sashCount;
+ if (horizontal) {
+ sxReserve = sashReserve;
+ syReserve = 0;
+ } else {
+ sxReserve = 0;
+ syReserve = sashReserve;
+ }
+ } else {
+ sxReserve = syReserve = 0;
+ }
+
+ if (pwWidth - sxReserve < x + paneWidth - internalBW) {
+ paneWidth = pwWidth - sxReserve - x + internalBW;
+ }
+ if (pwHeight - syReserve < y + paneHeight - internalBW) {
+ paneHeight = pwHeight - syReserve - y + internalBW;
+ }
+
+ if (slaveWidth > paneWidth) {
+ slaveWidth = paneWidth;
+ }
+ if (slaveHeight > paneHeight) {
+ slaveHeight = paneHeight;
+ }
+
+ slavePtr->x = x;
+ slavePtr->y = y;
+
+ /*
+ * Compute the location of the sash at the right or bottom of the
+ * parcel and the location of the next parcel.
+ */
+
+ if (horizontal) {
+ x += paneWidth + (2 * slavePtr->padx);
+ if (x < internalBW) {
+ x = internalBW;
+ }
+ slavePtr->sashx = x + sashOffset;
+ slavePtr->sashy = y;
+ slavePtr->handlex = x + handleOffset;
+ slavePtr->handley = y + pwPtr->handlePad;
+ x += sashWidth;
+ } else {
+ y += paneHeight + (2 * slavePtr->pady);
+ if (y < internalBW) {
+ y = internalBW;
+ }
+ slavePtr->sashx = x;
+ slavePtr->sashy = y + sashOffset;
+ slavePtr->handlex = x + pwPtr->handlePad;
+ slavePtr->handley = y + handleOffset;
+ y += sashWidth;
+ }
+
+ /*
+ * Compute the actual dimensions of the slave in the pane.
+ */
+
+ slaveX = slavePtr->x;
+ slaveY = slavePtr->y;
+ AdjustForSticky(slavePtr->sticky, paneWidth, paneHeight,
+ &slaveX, &slaveY, &slaveWidth, &slaveHeight);
+
+ slaveX += slavePtr->padx;
+ slaveY += slavePtr->pady;
+
+ /*
+ * Now put the window in the proper spot.
+ */
+
+ if (slaveWidth <= 0 || slaveHeight <= 0 ||
+ (horizontal ? slaveX - internalBW > pwWidth :
+ slaveY - internalBW > pwHeight)) {
+ Tk_UnmaintainGeometry(slavePtr->tkwin, pwPtr->tkwin);
+ Tk_UnmapWindow(slavePtr->tkwin);
+ } else {
+ Tk_MaintainGeometry(slavePtr->tkwin, pwPtr->tkwin,
+ slaveX, slaveY, slaveWidth, slaveHeight);
+ }
+ sashCount--;
+ }
+ Tcl_Release(pwPtr);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Unlink --
+ *
+ * Remove a slave from a paned window.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The paned window will be scheduled for re-arranging and redrawing.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+Unlink(
+ register Slave *slavePtr) /* Window to unlink. */
+{
+ register PanedWindow *masterPtr;
+ int i, j;
+
+ masterPtr = slavePtr->masterPtr;
+ if (masterPtr == NULL) {
+ return;
+ }
+
+ /*
+ * Find the specified slave in the panedwindow's list of slaves, then
+ * remove it from that list.
+ */
+
+ for (i = 0; i < masterPtr->numSlaves; i++) {
+ if (masterPtr->slaves[i] == slavePtr) {
+ for (j = i; j < masterPtr->numSlaves - 1; j++) {
+ masterPtr->slaves[j] = masterPtr->slaves[j + 1];
+ }
+ break;
+ }
+ }
+
+ /*
+ * Clean out any -after or -before references to this slave
+ */
+
+ for (i = 0; i < masterPtr->numSlaves; i++) {
+ if (masterPtr->slaves[i]->before == slavePtr->tkwin) {
+ masterPtr->slaves[i]->before = None;
+ }
+ if (masterPtr->slaves[i]->after == slavePtr->tkwin) {
+ masterPtr->slaves[i]->after = None;
+ }
+ }
+
+ masterPtr->flags |= REQUESTED_RELAYOUT;
+ if (!(masterPtr->flags & REDRAW_PENDING)) {
+ masterPtr->flags |= REDRAW_PENDING;
+ Tcl_DoWhenIdle(DisplayPanedWindow, masterPtr);
+ }
+
+ /*
+ * Set the slave's masterPtr to NULL, so that we can tell that the slave
+ * is no longer attached to any panedwindow.
+ */
+
+ slavePtr->masterPtr = NULL;
+
+ masterPtr->numSlaves--;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * GetPane --
+ *
+ * Given a token to a Tk window, find the pane that corresponds to that
+ * token in a given paned window.
+ *
+ * Results:
+ * Pointer to the slave structure, or NULL if the window is not managed
+ * by this paned window.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static Slave *
+GetPane(
+ PanedWindow *pwPtr, /* Pointer to the paned window info. */
+ Tk_Window tkwin) /* Window to search for. */
+{
+ int i;
+
+ for (i = 0; i < pwPtr->numSlaves; i++) {
+ if (pwPtr->slaves[i]->tkwin == tkwin) {
+ return pwPtr->slaves[i];
+ }
+ }
+ return NULL;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * GetFirstLastVisiblePane --
+ *
+ * Given panedwindow, find the index of the first and last visible panes
+ * of that paned window.
+ *
+ * Results:
+ * Index of the first and last visible panes.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+GetFirstLastVisiblePane(
+ PanedWindow *pwPtr, /* Pointer to the paned window info. */
+ int *firstPtr, /* Returned index for first. */
+ int *lastPtr) /* Returned index for last. */
+{
+ int i;
+
+ for (i = 0, *lastPtr = 0, *firstPtr = -1; i < pwPtr->numSlaves; i++) {
+ if (pwPtr->slaves[i]->hide == 0) {
+ if (*firstPtr < 0) {
+ *firstPtr = i;
+ }
+ *lastPtr = i;
+ }
+ }
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * SlaveStructureProc --
+ *
+ * This function is invoked whenever StructureNotify events occur for a
+ * window that's managed by a paned window. This function's only purpose
+ * is to clean up when windows are deleted.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The paned window slave structure associated with the window
+ * is freed, and the slave is disassociated from the paned
+ * window which managed it.
+ *
+ *--------------------------------------------------------------
+ */
+
+static void
+SlaveStructureProc(
+ ClientData clientData, /* Pointer to record describing window item. */
+ XEvent *eventPtr) /* Describes what just happened. */
+{
+ Slave *slavePtr = clientData;
+ PanedWindow *pwPtr = slavePtr->masterPtr;
+
+ if (eventPtr->type == DestroyNotify) {
+ Unlink(slavePtr);
+ slavePtr->tkwin = NULL;
+ ckfree(slavePtr);
+ ComputeGeometry(pwPtr);
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ComputeGeometry --
+ *
+ * Compute geometry for the paned window, including coordinates of all
+ * slave windows and each sash.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Recomputes geometry information for a paned window.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+ComputeGeometry(
+ PanedWindow *pwPtr) /* Pointer to the Paned Window structure. */
+{
+ int i, x, y, doubleBw, internalBw;
+ int sashWidth, sashOffset, handleOffset;
+ int reqWidth, reqHeight, dim;
+ Slave *slavePtr;
+ const int horizontal = (pwPtr->orient == ORIENT_HORIZONTAL);
+
+ pwPtr->flags |= REQUESTED_RELAYOUT;
+
+ x = y = internalBw = Tk_InternalBorderWidth(pwPtr->tkwin);
+ reqWidth = reqHeight = 0;
+
+ /*
+ * Sashes and handles share space on the display. To simplify processing
+ * below, precompute the x and y offsets of the handles and sashes within
+ * the space occupied by their combination; later, just add those offsets
+ * blindly (avoiding the extra showHandle, etc, checks).
+ */
+
+ sashOffset = handleOffset = pwPtr->sashPad;
+ if (pwPtr->showHandle && pwPtr->handleSize > pwPtr->sashWidth) {
+ sashWidth = (2 * pwPtr->sashPad) + pwPtr->handleSize;
+ sashOffset = ((pwPtr->handleSize - pwPtr->sashWidth) / 2)
+ + pwPtr->sashPad;
+ } else {
+ sashWidth = (2 * pwPtr->sashPad) + pwPtr->sashWidth;
+ handleOffset = ((pwPtr->sashWidth - pwPtr->handleSize) / 2)
+ + pwPtr->sashPad;
+ }
+
+ for (i = 0; i < pwPtr->numSlaves; i++) {
+ slavePtr = pwPtr->slaves[i];
+
+ if (slavePtr->hide) {
+ continue;
+ }
+
+ /*
+ * First set the coordinates for the top left corner of the slave's
+ * parcel.
+ */
+
+ slavePtr->x = x;
+ slavePtr->y = y;
+
+ /*
+ * Make sure the pane's paned dimension is at least minsize. This
+ * check may be redundant, since the only way to change a pane's size
+ * is by moving a sash, and that code checks the minsize.
+ */
+
+ if (horizontal) {
+ if (slavePtr->paneWidth < slavePtr->minSize) {
+ slavePtr->paneWidth = slavePtr->minSize;
+ }
+ } else {
+ if (slavePtr->paneHeight < slavePtr->minSize) {
+ slavePtr->paneHeight = slavePtr->minSize;
+ }
+ }
+
+ /*
+ * Compute the location of the sash at the right or bottom of the
+ * parcel.
+ */
+
+ if (horizontal) {
+ x += slavePtr->paneWidth + (2 * slavePtr->padx);
+ slavePtr->sashx = x + sashOffset;
+ slavePtr->sashy = y;
+ slavePtr->handlex = x + handleOffset;
+ slavePtr->handley = y + pwPtr->handlePad;
+ x += sashWidth;
+ } else {
+ y += slavePtr->paneHeight + (2 * slavePtr->pady);
+ slavePtr->sashx = x;
+ slavePtr->sashy = y + sashOffset;
+ slavePtr->handlex = x + pwPtr->handlePad;
+ slavePtr->handley = y + handleOffset;
+ y += sashWidth;
+ }
+
+ /*
+ * Find the maximum height/width of the slaves, for computing the
+ * requested height/width of the paned window.
+ */
+
+ if (horizontal) {
+ /*
+ * If the slave has an explicit height set, use that; otherwise,
+ * use the slave's requested height.
+ */
+
+ if (slavePtr->height > 0) {
+ dim = slavePtr->height;
+ } else {
+ doubleBw = 2 * Tk_Changes(slavePtr->tkwin)->border_width;
+ dim = Tk_ReqHeight(slavePtr->tkwin) + doubleBw;
+ }
+ dim += 2 * slavePtr->pady;
+ if (dim > reqHeight) {
+ reqHeight = dim;
+ }
+ } else {
+ /*
+ * If the slave has an explicit width set use that; otherwise, use
+ * the slave's requested width.
+ */
+
+ if (slavePtr->width > 0) {
+ dim = slavePtr->width;
+ } else {
+ doubleBw = 2 * Tk_Changes(slavePtr->tkwin)->border_width;
+ dim = Tk_ReqWidth(slavePtr->tkwin) + doubleBw;
+ }
+ dim += 2 * slavePtr->padx;
+ if (dim > reqWidth) {
+ reqWidth = dim;
+ }
+ }
+ }
+
+ /*
+ * The loop above should have left x (or y) equal to the sum of the widths
+ * (or heights) of the widgets, plus the size of one sash and the sash
+ * padding for each widget, plus the width of the left (or top) border of
+ * the paned window.
+ *
+ * The requested width (or height) is therefore x (or y) minus the size of
+ * one sash and padding, plus the width of the right (or bottom) border of
+ * the paned window.
+ *
+ * The height (or width) is equal to the maximum height (or width) of the
+ * slaves, plus the width of the border of the top and bottom (or left and
+ * right) of the paned window.
+ *
+ * If the panedwindow has an explicit width/height set use that;
+ * otherwise, use the requested width/height.
+ */
+
+ if (horizontal) {
+ reqWidth = (pwPtr->width > 0 ?
+ pwPtr->width : x - sashWidth + internalBw);
+ reqHeight = (pwPtr->height > 0 ?
+ pwPtr->height : reqHeight + (2 * internalBw));
+ } else {
+ reqWidth = (pwPtr->width > 0 ?
+ pwPtr->width : reqWidth + (2 * internalBw));
+ reqHeight = (pwPtr->height > 0 ?
+ pwPtr->height : y - sashWidth + internalBw);
+ }
+ Tk_GeometryRequest(pwPtr->tkwin, reqWidth, reqHeight);
+ if (Tk_IsMapped(pwPtr->tkwin) && !(pwPtr->flags & REDRAW_PENDING)) {
+ pwPtr->flags |= REDRAW_PENDING;
+ Tcl_DoWhenIdle(DisplayPanedWindow, pwPtr);
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * DestroyOptionTables --
+ *
+ * This function is registered as an exit callback when the paned window
+ * command is first called. It cleans up the OptionTables structure
+ * allocated by that command.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Frees memory.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+DestroyOptionTables(
+ ClientData clientData, /* Pointer to the OptionTables struct */
+ Tcl_Interp *interp) /* Pointer to the calling interp */
+{
+ ckfree(clientData);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * GetSticky -
+ *
+ * Converts an internal boolean combination of "sticky" bits into a Tcl
+ * string obj containing zero or more of n, s, e, or w.
+ *
+ * Results:
+ * Tcl_Obj containing the string representation of the sticky value.
+ *
+ * Side effects:
+ * Creates a new Tcl_Obj.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static Tcl_Obj *
+GetSticky(
+ ClientData clientData,
+ Tk_Window tkwin,
+ char *recordPtr, /* Pointer to widget record. */
+ int internalOffset) /* Offset within *recordPtr containing the
+ * sticky value. */
+{
+ int sticky = *(int *)(recordPtr + internalOffset);
+ char buffer[5];
+ char *p = &buffer[0];
+
+ if (sticky & STICK_NORTH) {
+ *p++ = 'n';
+ }
+ if (sticky & STICK_EAST) {
+ *p++ = 'e';
+ }
+ if (sticky & STICK_SOUTH) {
+ *p++ = 's';
+ }
+ if (sticky & STICK_WEST) {
+ *p++ = 'w';
+ }
+ *p = '\0';
+
+ return Tcl_NewStringObj(buffer, -1);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * SetSticky --
+ *
+ * Converts a Tcl_Obj representing a widgets stickyness into an integer
+ * value.
+ *
+ * Results:
+ * Standard Tcl result.
+ *
+ * Side effects:
+ * May store the integer value into the internal representation pointer.
+ * May change the pointer to the Tcl_Obj to NULL to indicate that the
+ * specified string was empty and that is acceptable.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+SetSticky(
+ ClientData clientData,
+ Tcl_Interp *interp, /* Current interp; may be used for errors. */
+ Tk_Window tkwin, /* Window for which option is being set. */
+ Tcl_Obj **value, /* Pointer to the pointer to the value object.
+ * We use a pointer to the pointer because we
+ * may need to return a value (NULL). */
+ char *recordPtr, /* Pointer to storage for the widget record. */
+ int internalOffset, /* Offset within *recordPtr at which the
+ * internal value is to be stored. */
+ char *oldInternalPtr, /* Pointer to storage for the old value. */
+ int flags) /* Flags for the option, set Tk_SetOptions. */
+{
+ int sticky = 0;
+ char c, *internalPtr;
+ const char *string;
+
+ internalPtr = ComputeSlotAddress(recordPtr, internalOffset);
+
+ if (flags & TK_OPTION_NULL_OK && ObjectIsEmpty(*value)) {
+ *value = NULL;
+ } else {
+ /*
+ * Convert the sticky specifier into an integer value.
+ */
+
+ string = Tcl_GetString(*value);
+
+ while ((c = *string++) != '\0') {
+ switch (c) {
+ case 'n': case 'N':
+ sticky |= STICK_NORTH;
+ break;
+ case 'e': case 'E':
+ sticky |= STICK_EAST;
+ break;
+ case 's': case 'S':
+ sticky |= STICK_SOUTH;
+ break;
+ case 'w': case 'W':
+ sticky |= STICK_WEST;
+ break;
+ case ' ': case ',': case '\t': case '\r': case '\n':
+ break;
+ default:
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "bad stickyness value \"%s\": must be a string"
+ " containing zero or more of n, e, s, and w",
+ Tcl_GetString(*value)));
+ Tcl_SetErrorCode(interp, "TK", "VALUE", "STICKY", NULL);
+ return TCL_ERROR;
+ }
+ }
+ }
+
+ if (internalPtr != NULL) {
+ *((int *) oldInternalPtr) = *((int *) internalPtr);
+ *((int *) internalPtr) = sticky;
+ }
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * RestoreSticky --
+ *
+ * Restore a sticky option value from a saved value.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Restores the old value.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+RestoreSticky(
+ ClientData clientData,
+ Tk_Window tkwin,
+ char *internalPtr, /* Pointer to storage for value. */
+ char *oldInternalPtr) /* Pointer to old value. */
+{
+ *(int *)internalPtr = *(int *)oldInternalPtr;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * AdjustForSticky --
+ *
+ * Given the x,y coords of the top-left corner of a pane, the dimensions
+ * of that pane, and the dimensions of a slave, compute the x,y coords
+ * and actual dimensions of the slave based on the slave's sticky value.
+ *
+ * Results:
+ * No direct return; sets the x, y, slaveWidth and slaveHeight to correct
+ * values.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+AdjustForSticky(
+ int sticky, /* Sticky value; see top of file for
+ * definition. */
+ int cavityWidth, /* Width of the cavity. */
+ int cavityHeight, /* Height of the cavity. */
+ int *xPtr, int *yPtr, /* Initially, coordinates of the top-left
+ * corner of cavity; also return values for
+ * actual x, y coords of slave. */
+ int *slaveWidthPtr, /* Slave width. */
+ int *slaveHeightPtr) /* Slave height. */
+{
+ int diffx = 0; /* Cavity width - slave width. */
+ int diffy = 0; /* Cavity hight - slave height. */
+
+ if (cavityWidth > *slaveWidthPtr) {
+ diffx = cavityWidth - *slaveWidthPtr;
+ }
+
+ if (cavityHeight > *slaveHeightPtr) {
+ diffy = cavityHeight - *slaveHeightPtr;
+ }
+
+ if ((sticky & STICK_EAST) && (sticky & STICK_WEST)) {
+ *slaveWidthPtr += diffx;
+ }
+ if ((sticky & STICK_NORTH) && (sticky & STICK_SOUTH)) {
+ *slaveHeightPtr += diffy;
+ }
+ if (!(sticky & STICK_WEST)) {
+ *xPtr += (sticky & STICK_EAST) ? diffx : diffx/2;
+ }
+ if (!(sticky & STICK_NORTH)) {
+ *yPtr += (sticky & STICK_SOUTH) ? diffy : diffy/2;
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * MoveSash --
+ *
+ * Move the sash given by index the amount given.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Recomputes the sizes of the panes in a panedwindow.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+MoveSash(
+ PanedWindow *pwPtr,
+ int sash,
+ int diff)
+{
+ int i;
+ int expandPane, reduceFirst, reduceLast, reduceIncr, slaveSize, sashOffset;
+ Slave *slavePtr;
+ int stretchReserve = 0;
+ int nextSash = sash + 1;
+ const int horizontal = (pwPtr->orient == ORIENT_HORIZONTAL);
+
+ if (diff == 0)
+ return;
+
+ /*
+ * Update the slave sizes with their real sizes.
+ */
+
+ if (pwPtr->showHandle && pwPtr->handleSize > pwPtr->sashWidth) {
+ sashOffset = ((pwPtr->handleSize - pwPtr->sashWidth) / 2)
+ + pwPtr->sashPad;
+ } else {
+ sashOffset = pwPtr->sashPad;
+ }
+ for (i = 0; i < pwPtr->numSlaves; i++) {
+ slavePtr = pwPtr->slaves[i];
+ if (slavePtr->hide) {
+ continue;
+ }
+ if (horizontal) {
+ slavePtr->paneWidth = slavePtr->width = slavePtr->sashx
+ - sashOffset - slavePtr->x - (2 * slavePtr->padx);
+ } else {
+ slavePtr->paneHeight = slavePtr->height = slavePtr->sashy
+ - sashOffset - slavePtr->y - (2 * slavePtr->pady);
+ }
+ }
+
+ /*
+ * There must be a next sash since it is only possible to enter this
+ * routine when moving an actual sash which implies there exists a visible
+ * pane to either side of the sash.
+ */
+
+ while (nextSash < pwPtr->numSlaves-1 && pwPtr->slaves[nextSash]->hide) {
+ nextSash++;
+ }
+
+ /*
+ * Consolidate +/-diff variables to reduce duplicate code.
+ */
+
+ if (diff > 0) {
+ expandPane = sash;
+ reduceFirst = nextSash;
+ reduceLast = pwPtr->numSlaves;
+ reduceIncr = 1;
+ } else {
+ diff = abs(diff);
+ expandPane = nextSash;
+ reduceFirst = sash;
+ reduceLast = -1;
+ reduceIncr = -1;
+ }
+
+ /*
+ * Calculate how much room we have to stretch in and adjust diff value
+ * accordingly.
+ */
+
+ for (i = reduceFirst; i != reduceLast; i += reduceIncr) {
+ slavePtr = pwPtr->slaves[i];
+ if (slavePtr->hide) {
+ continue;
+ }
+ if (horizontal) {
+ stretchReserve += slavePtr->width - slavePtr->minSize;
+ } else {
+ stretchReserve += slavePtr->height - slavePtr->minSize;
+ }
+ }
+ if (stretchReserve <= 0) {
+ return;
+ }
+ if (diff > stretchReserve) {
+ diff = stretchReserve;
+ }
+
+ /*
+ * Expand pane by diff amount.
+ */
+
+ slavePtr = pwPtr->slaves[expandPane];
+ if (horizontal) {
+ slavePtr->paneWidth = slavePtr->width += diff;
+ } else {
+ slavePtr->paneHeight = slavePtr->height += diff;
+ }
+
+ /*
+ * Reduce panes, respecting minsize, until diff amount has been used.
+ */
+
+ for (i = reduceFirst; i != reduceLast; i += reduceIncr) {
+ slavePtr = pwPtr->slaves[i];
+ if (slavePtr->hide) {
+ continue;
+ }
+ if (horizontal) {
+ slaveSize = slavePtr->width;
+ } else {
+ slaveSize = slavePtr->height;
+ }
+ if (diff > (slaveSize - slavePtr->minSize)) {
+ diff -= slaveSize - slavePtr->minSize;
+ slaveSize = slavePtr->minSize;
+ } else {
+ slaveSize -= diff;
+ i = reduceLast - reduceIncr;
+ }
+ if (horizontal) {
+ slavePtr->paneWidth = slavePtr->width = slaveSize;
+ } else {
+ slavePtr->paneHeight = slavePtr->height = slaveSize;
+ }
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ProxyWindowEventProc --
+ *
+ * This function is invoked by the Tk dispatcher for various events on
+ * paned window proxy windows.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * When the window gets deleted, internal structures get cleaned up. When
+ * it gets exposed, it is redisplayed.
+ *
+ *--------------------------------------------------------------
+ */
+
+static void
+ProxyWindowEventProc(
+ ClientData clientData, /* Information about window. */
+ XEvent *eventPtr) /* Information about event. */
+{
+ PanedWindow *pwPtr = clientData;
+
+ if (eventPtr->type == Expose) {
+ if (pwPtr->proxywin != NULL &&!(pwPtr->flags & PROXY_REDRAW_PENDING)) {
+ Tcl_DoWhenIdle(DisplayProxyWindow, pwPtr);
+ pwPtr->flags |= PROXY_REDRAW_PENDING;
+ }
+ }
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * DisplayProxyWindow --
+ *
+ * This function redraws a paned window proxy window. It is invoked as a
+ * do-when-idle handler, so it only runs when there's nothing else for
+ * the application to do.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Information appears on the screen.
+ *
+ *--------------------------------------------------------------
+ */
+
+static void
+DisplayProxyWindow(
+ ClientData clientData) /* Information about window. */
+{
+ PanedWindow *pwPtr = clientData;
+ Pixmap pixmap;
+ Tk_Window tkwin = pwPtr->proxywin;
+ pwPtr->flags &= ~PROXY_REDRAW_PENDING;
+ if ((tkwin == NULL) || !Tk_IsMapped(tkwin)) {
+ return;
+ }
+
+#ifndef TK_NO_DOUBLE_BUFFERING
+ /*
+ * Create a pixmap for double-buffering, if necessary.
+ */
+
+ pixmap = Tk_GetPixmap(Tk_Display(tkwin), Tk_WindowId(tkwin),
+ Tk_Width(tkwin), Tk_Height(tkwin), Tk_Depth(tkwin));
+#else
+ pixmap = Tk_WindowId(tkwin);
+#endif /* TK_NO_DOUBLE_BUFFERING */
+
+ /*
+ * Redraw the widget's background and border.
+ */
+
+ Tk_Fill3DRectangle(tkwin, pixmap,
+ pwPtr->proxyBackground ? pwPtr->proxyBackground : pwPtr->background,
+ 0, 0, Tk_Width(tkwin), Tk_Height(tkwin), pwPtr->proxyBorderWidth,
+ (pwPtr->proxyRelief != TK_RELIEF_NULL) ? pwPtr->proxyRelief : pwPtr->sashRelief);
+
+#ifndef TK_NO_DOUBLE_BUFFERING
+ /*
+ * Copy the pixmap to the display.
+ */
+
+ XCopyArea(Tk_Display(tkwin), pixmap, Tk_WindowId(tkwin), pwPtr->gc, 0, 0,
+ (unsigned) Tk_Width(tkwin), (unsigned) Tk_Height(tkwin), 0, 0);
+ Tk_FreePixmap(Tk_Display(tkwin), pixmap);
+#endif /* TK_NO_DOUBLE_BUFFERING */
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * PanedWindowProxyCommand --
+ *
+ * Handles the panedwindow proxy subcommand. See the user documentation
+ * for details.
+ *
+ * Results:
+ * Standard Tcl result.
+ *
+ * Side effects:
+ * May map or unmap the proxy sash.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+PanedWindowProxyCommand(
+ PanedWindow *pwPtr, /* Pointer to paned window information. */
+ Tcl_Interp *interp, /* Current interpreter. */
+ int objc, /* Number of arguments. */
+ Tcl_Obj *const objv[]) /* Argument objects. */
+{
+ static const char *const optionStrings[] = {
+ "coord", "forget", "place", NULL
+ };
+ enum options {
+ PROXY_COORD, PROXY_FORGET, PROXY_PLACE
+ };
+ int index, x, y, sashWidth, sashHeight;
+ int internalBW, pwWidth, pwHeight;
+ Tcl_Obj *coords[2];
+
+ if (objc < 3) {
+ Tcl_WrongNumArgs(interp, 2, objv, "option ?arg ...?");
+ return TCL_ERROR;
+ }
+
+ if (Tcl_GetIndexFromObj(interp, objv[2], optionStrings, "option", 0,
+ &index) != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ switch ((enum options) index) {
+ case PROXY_COORD:
+ if (objc != 3) {
+ Tcl_WrongNumArgs(interp, 3, objv, NULL);
+ return TCL_ERROR;
+ }
+
+ coords[0] = Tcl_NewIntObj(pwPtr->proxyx);
+ coords[1] = Tcl_NewIntObj(pwPtr->proxyy);
+ Tcl_SetObjResult(interp, Tcl_NewListObj(2, coords));
+ break;
+
+ case PROXY_FORGET:
+ if (objc != 3) {
+ Tcl_WrongNumArgs(interp, 3, objv, NULL);
+ return TCL_ERROR;
+ }
+ if (Tk_IsMapped(pwPtr->proxywin)) {
+ Tk_UnmapWindow(pwPtr->proxywin);
+ Tk_UnmaintainGeometry(pwPtr->proxywin, pwPtr->tkwin);
+ }
+ break;
+
+ case PROXY_PLACE:
+ if (objc != 5) {
+ Tcl_WrongNumArgs(interp, 3, objv, "x y");
+ return TCL_ERROR;
+ }
+
+ if (Tcl_GetIntFromObj(interp, objv[3], &x) != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ if (Tcl_GetIntFromObj(interp, objv[4], &y) != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ internalBW = Tk_InternalBorderWidth(pwPtr->tkwin);
+ if (pwPtr->orient == ORIENT_HORIZONTAL) {
+ if (x < 0) {
+ x = 0;
+ }
+ pwWidth = Tk_Width(pwPtr->tkwin) - (2 * internalBW);
+ if (x > pwWidth) {
+ x = pwWidth;
+ }
+ y = Tk_InternalBorderWidth(pwPtr->tkwin);
+ sashWidth = pwPtr->sashWidth;
+ sashHeight = Tk_Height(pwPtr->tkwin) -
+ (2 * Tk_InternalBorderWidth(pwPtr->tkwin));
+ } else {
+ if (y < 0) {
+ y = 0;
+ }
+ pwHeight = Tk_Height(pwPtr->tkwin) - (2 * internalBW);
+ if (y > pwHeight) {
+ y = pwHeight;
+ }
+ x = Tk_InternalBorderWidth(pwPtr->tkwin);
+ sashHeight = pwPtr->sashWidth;
+ sashWidth = Tk_Width(pwPtr->tkwin) -
+ (2 * Tk_InternalBorderWidth(pwPtr->tkwin));
+ }
+
+ if (sashWidth < 1) {
+ sashWidth = 1;
+ }
+ if (sashHeight < 1) {
+ sashHeight = 1;
+ }
+
+ /*
+ * Stash the proxy coordinates for future "proxy coord" calls.
+ */
+
+ pwPtr->proxyx = x;
+ pwPtr->proxyy = y;
+
+ /*
+ * Make sure the proxy window is higher in the stacking order than the
+ * slaves, so that it will be visible when drawn. It would be more
+ * correct to push the proxy window just high enough to appear above
+ * the highest slave, but it's much easier to just force it all the
+ * way to the top of the stacking order.
+ */
+
+ Tk_RestackWindow(pwPtr->proxywin, Above, NULL);
+
+ /*
+ * Let Tk_MaintainGeometry take care of placing the window at the
+ * right coordinates.
+ */
+
+ Tk_MaintainGeometry(pwPtr->proxywin, pwPtr->tkwin, x, y,
+ sashWidth, sashHeight);
+ break;
+ }
+
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ObjectIsEmpty --
+ *
+ * This function tests whether the string value of an object is empty.
+ *
+ * Results:
+ * The return value is 1 if the string value of objPtr has length zero,
+ * and 0 otherwise.
+ *
+ * Side effects:
+ * May cause object shimmering, since this function can force a
+ * conversion to a string object.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+ObjectIsEmpty(
+ Tcl_Obj *objPtr) /* Object to test. May be NULL. */
+{
+ int length;
+
+ if (objPtr == NULL) {
+ return 1;
+ }
+ if (objPtr->bytes != NULL) {
+ return (objPtr->length == 0);
+ }
+ (void)Tcl_GetStringFromObj(objPtr, &length);
+ return (length == 0);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ComputeInternalPointer --
+ *
+ * Given a pointer to the start of a record and the offset of a slot
+ * within that record, compute the address of that slot.
+ *
+ * Results:
+ * If offset is non-negative, returns the computed address; else, returns
+ * NULL.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static char *
+ComputeSlotAddress(
+ char *recordPtr, /* Pointer to the start of a record. */
+ int offset) /* Offset of a slot within that record; may be < 0. */
+{
+ if (offset >= 0) {
+ return recordPtr + offset;
+ } else {
+ return NULL;
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * PanedWindowIdentifyCoords --
+ *
+ * Given a pair of x,y coordinates, identify the panedwindow component at
+ * that point, if any.
+ *
+ * Results:
+ * Standard Tcl result.
+ *
+ * Side effects:
+ * Modifies the interpreter's result to contain either an empty list, or
+ * a two element list of the form {sash n} or {handle n} to indicate that
+ * the point lies within the n'th sash or handle.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+PanedWindowIdentifyCoords(
+ PanedWindow *pwPtr, /* Information about the widget. */
+ Tcl_Interp *interp, /* Interpreter in which to store result. */
+ int x, int y) /* Coordinates of the point to identify. */
+{
+ int i, sashHeight, sashWidth, thisx, thisy;
+ int found, isHandle, lpad, rpad, tpad, bpad;
+ int first, last;
+
+ if (pwPtr->orient == ORIENT_HORIZONTAL) {
+ if (Tk_IsMapped(pwPtr->tkwin)) {
+ sashHeight = Tk_Height(pwPtr->tkwin);
+ } else {
+ sashHeight = Tk_ReqHeight(pwPtr->tkwin);
+ }
+ sashHeight -= 2 * Tk_InternalBorderWidth(pwPtr->tkwin);
+ if (pwPtr->showHandle && pwPtr->handleSize > pwPtr->sashWidth) {
+ sashWidth = pwPtr->handleSize;
+ lpad = (pwPtr->handleSize - pwPtr->sashWidth) / 2;
+ rpad = pwPtr->handleSize - lpad;
+ lpad += pwPtr->sashPad;
+ rpad += pwPtr->sashPad;
+ } else {
+ sashWidth = pwPtr->sashWidth;
+ lpad = rpad = pwPtr->sashPad;
+ }
+ tpad = bpad = 0;
+ } else {
+ if (pwPtr->showHandle && pwPtr->handleSize > pwPtr->sashWidth) {
+ sashHeight = pwPtr->handleSize;
+ tpad = (pwPtr->handleSize - pwPtr->sashWidth) / 2;
+ bpad = pwPtr->handleSize - tpad;
+ tpad += pwPtr->sashPad;
+ bpad += pwPtr->sashPad;
+ } else {
+ sashHeight = pwPtr->sashWidth;
+ tpad = bpad = pwPtr->sashPad;
+ }
+ if (Tk_IsMapped(pwPtr->tkwin)) {
+ sashWidth = Tk_Width(pwPtr->tkwin);
+ } else {
+ sashWidth = Tk_ReqWidth(pwPtr->tkwin);
+ }
+ sashWidth -= 2 * Tk_InternalBorderWidth(pwPtr->tkwin);
+ lpad = rpad = 0;
+ }
+
+ GetFirstLastVisiblePane(pwPtr, &first, &last);
+ isHandle = 0;
+ found = -1;
+ for (i = 0; i < pwPtr->numSlaves - 1; i++) {
+ if (pwPtr->slaves[i]->hide || i == last) {
+ continue;
+ }
+ thisx = pwPtr->slaves[i]->sashx;
+ thisy = pwPtr->slaves[i]->sashy;
+
+ if (((thisx - lpad) <= x && x <= (thisx + rpad + sashWidth)) &&
+ ((thisy - tpad) <= y && y <= (thisy + bpad + sashHeight))) {
+ found = i;
+
+ /*
+ * Determine if the point is over the handle or the sash.
+ */
+
+ if (pwPtr->showHandle) {
+ thisx = pwPtr->slaves[i]->handlex;
+ thisy = pwPtr->slaves[i]->handley;
+ if (pwPtr->orient == ORIENT_HORIZONTAL) {
+ if (thisy <= y && y <= (thisy + pwPtr->handleSize)) {
+ isHandle = 1;
+ }
+ } else {
+ if (thisx <= x && x <= (thisx + pwPtr->handleSize)) {
+ isHandle = 1;
+ }
+ }
+ }
+ break;
+ }
+ }
+
+ /*
+ * Set results. Note that the empty string is the default (this function
+ * is called inside the implementation of a command).
+ */
+
+ if (found != -1) {
+ Tcl_Obj *list[2];
+
+ list[0] = Tcl_NewIntObj(found);
+ list[1] = Tcl_NewStringObj((isHandle ? "handle" : "sash"), -1);
+ Tcl_SetObjResult(interp, Tcl_NewListObj(2, list));
+ }
+ return TCL_OK;
+}
+
+/*
+ * Local Variables:
+ * mode: c
+ * c-basic-offset: 4
+ * fill-column: 78
+ * End:
+ */
diff --git a/tk8.6/generic/tkPlace.c b/tk8.6/generic/tkPlace.c
new file mode 100644
index 0000000..9fa406a
--- /dev/null
+++ b/tk8.6/generic/tkPlace.c
@@ -0,0 +1,1245 @@
+/*
+ * tkPlace.c --
+ *
+ * This file contains code to implement a simple geometry manager for Tk
+ * based on absolute placement or "rubber-sheet" placement.
+ *
+ * Copyright (c) 1992-1994 The Regents of the University of California.
+ * Copyright (c) 1994-1997 Sun Microsystems, Inc.
+ *
+ * See the file "license.terms" for information on usage and redistribution of
+ * this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ */
+
+#include "tkInt.h"
+
+/*
+ * Border modes for relative placement:
+ *
+ * BM_INSIDE: relative distances computed using area inside all
+ * borders of master window.
+ * BM_OUTSIDE: relative distances computed using outside area that
+ * includes all borders of master.
+ * BM_IGNORE: border issues are ignored: place relative to master's
+ * actual window size.
+ */
+
+static const char *const borderModeStrings[] = {
+ "inside", "outside", "ignore", NULL
+};
+
+typedef enum {BM_INSIDE, BM_OUTSIDE, BM_IGNORE} BorderMode;
+
+/*
+ * For each window whose geometry is managed by the placer there is a
+ * structure of the following type:
+ */
+
+typedef struct Slave {
+ Tk_Window tkwin; /* Tk's token for window. */
+ Tk_Window inTkwin; /* Token for the -in window. */
+ struct Master *masterPtr; /* Pointer to information for window relative
+ * to which tkwin is placed. This isn't
+ * necessarily the logical parent of tkwin.
+ * NULL means the master was deleted or never
+ * assigned. */
+ struct Slave *nextPtr; /* Next in list of windows placed relative to
+ * same master (NULL for end of list). */
+ Tk_OptionTable optionTable; /* Table that defines configuration options
+ * available for this command. */
+ /*
+ * Geometry information for window; where there are both relative and
+ * absolute values for the same attribute (e.g. x and relX) only one of
+ * them is actually used, depending on flags.
+ */
+
+ int x, y; /* X and Y pixel coordinates for tkwin. */
+ Tcl_Obj *xPtr, *yPtr; /* Tcl_Obj rep's of x, y coords, to keep pixel
+ * spec. information. */
+ double relX, relY; /* X and Y coordinates relative to size of
+ * master. */
+ int width, height; /* Absolute dimensions for tkwin. */
+ Tcl_Obj *widthPtr; /* Tcl_Obj rep of width, to keep pixel
+ * spec. */
+ Tcl_Obj *heightPtr; /* Tcl_Obj rep of height, to keep pixel
+ * spec. */
+ double relWidth, relHeight; /* Dimensions for tkwin relative to size of
+ * master. */
+ Tcl_Obj *relWidthPtr;
+ Tcl_Obj *relHeightPtr;
+ Tk_Anchor anchor; /* Which point on tkwin is placed at the given
+ * position. */
+ BorderMode borderMode; /* How to treat borders of master window. */
+ int flags; /* Various flags; see below for bit
+ * definitions. */
+} Slave;
+
+/*
+ * Type masks for options:
+ */
+
+#define IN_MASK 1
+
+static const Tk_OptionSpec optionSpecs[] = {
+ {TK_OPTION_ANCHOR, "-anchor", NULL, NULL, "nw", -1,
+ Tk_Offset(Slave, anchor), 0, 0, 0},
+ {TK_OPTION_STRING_TABLE, "-bordermode", NULL, NULL, "inside", -1,
+ Tk_Offset(Slave, borderMode), 0, borderModeStrings, 0},
+ {TK_OPTION_PIXELS, "-height", NULL, NULL, "", Tk_Offset(Slave, heightPtr),
+ Tk_Offset(Slave, height), TK_OPTION_NULL_OK, 0, 0},
+ {TK_OPTION_WINDOW, "-in", NULL, NULL, "", -1, Tk_Offset(Slave, inTkwin),
+ 0, 0, IN_MASK},
+ {TK_OPTION_DOUBLE, "-relheight", NULL, NULL, "",
+ Tk_Offset(Slave, relHeightPtr), Tk_Offset(Slave, relHeight),
+ TK_OPTION_NULL_OK, 0, 0},
+ {TK_OPTION_DOUBLE, "-relwidth", NULL, NULL, "",
+ Tk_Offset(Slave, relWidthPtr), Tk_Offset(Slave, relWidth),
+ TK_OPTION_NULL_OK, 0, 0},
+ {TK_OPTION_DOUBLE, "-relx", NULL, NULL, "0", -1,
+ Tk_Offset(Slave, relX), 0, 0, 0},
+ {TK_OPTION_DOUBLE, "-rely", NULL, NULL, "0", -1,
+ Tk_Offset(Slave, relY), 0, 0, 0},
+ {TK_OPTION_PIXELS, "-width", NULL, NULL, "", Tk_Offset(Slave, widthPtr),
+ Tk_Offset(Slave, width), TK_OPTION_NULL_OK, 0, 0},
+ {TK_OPTION_PIXELS, "-x", NULL, NULL, "0", Tk_Offset(Slave, xPtr),
+ Tk_Offset(Slave, x), TK_OPTION_NULL_OK, 0, 0},
+ {TK_OPTION_PIXELS, "-y", NULL, NULL, "0", Tk_Offset(Slave, yPtr),
+ Tk_Offset(Slave, y), TK_OPTION_NULL_OK, 0, 0},
+ {TK_OPTION_END, NULL, NULL, NULL, NULL, 0, -1, 0, 0, 0}
+};
+
+/*
+ * Flag definitions for Slave structures:
+ *
+ * CHILD_WIDTH - 1 means -width was specified;
+ * CHILD_REL_WIDTH - 1 means -relwidth was specified.
+ * CHILD_HEIGHT - 1 means -height was specified;
+ * CHILD_REL_HEIGHT - 1 means -relheight was specified.
+ */
+
+#define CHILD_WIDTH 1
+#define CHILD_REL_WIDTH 2
+#define CHILD_HEIGHT 4
+#define CHILD_REL_HEIGHT 8
+
+/*
+ * For each master window that has a slave managed by the placer there is a
+ * structure of the following form:
+ */
+
+typedef struct Master {
+ Tk_Window tkwin; /* Tk's token for master window. */
+ struct Slave *slavePtr; /* First in linked list of slaves placed
+ * relative to this master. */
+ int *abortPtr; /* If non-NULL, it means that there is a nested
+ * call to RecomputePlacement already working on
+ * this window. *abortPtr may be set to 1 to
+ * abort that nested call. This happens, for
+ * example, if tkwin or any of its slaves
+ * is deleted. */
+ int flags; /* See below for bit definitions. */
+} Master;
+
+/*
+ * Flag definitions for masters:
+ *
+ * PARENT_RECONFIG_PENDING - 1 means that a call to RecomputePlacement is
+ * already pending via a Do_When_Idle handler.
+ */
+
+#define PARENT_RECONFIG_PENDING 1
+
+/*
+ * The following structure is the official type record for the placer:
+ */
+
+static void PlaceRequestProc(ClientData clientData,
+ Tk_Window tkwin);
+static void PlaceLostSlaveProc(ClientData clientData,
+ Tk_Window tkwin);
+
+static const Tk_GeomMgr placerType = {
+ "place", /* name */
+ PlaceRequestProc, /* requestProc */
+ PlaceLostSlaveProc, /* lostSlaveProc */
+};
+
+/*
+ * Forward declarations for functions defined later in this file:
+ */
+
+static void SlaveStructureProc(ClientData clientData,
+ XEvent *eventPtr);
+static int ConfigureSlave(Tcl_Interp *interp, Tk_Window tkwin,
+ Tk_OptionTable table, int objc,
+ Tcl_Obj *const objv[]);
+static int PlaceInfoCommand(Tcl_Interp *interp, Tk_Window tkwin);
+static Slave * CreateSlave(Tk_Window tkwin, Tk_OptionTable table);
+static void FreeSlave(Slave *slavePtr);
+static Slave * FindSlave(Tk_Window tkwin);
+static Master * CreateMaster(Tk_Window tkwin);
+static Master * FindMaster(Tk_Window tkwin);
+static void MasterStructureProc(ClientData clientData,
+ XEvent *eventPtr);
+static void RecomputePlacement(ClientData clientData);
+static void UnlinkSlave(Slave *slavePtr);
+
+/*
+ *--------------------------------------------------------------
+ *
+ * Tk_PlaceObjCmd --
+ *
+ * This function is invoked to process the "place" Tcl commands. See the
+ * user documentation for details on what it does.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * See the user documentation.
+ *
+ *--------------------------------------------------------------
+ */
+
+int
+Tk_PlaceObjCmd(
+ ClientData clientData, /* Interpreter main window. */
+ Tcl_Interp *interp, /* Current interpreter. */
+ int objc, /* Number of arguments. */
+ Tcl_Obj *const objv[]) /* Argument objects. */
+{
+ Tk_Window main_win = clientData;
+ Tk_Window tkwin;
+ Slave *slavePtr;
+ TkDisplay *dispPtr;
+ Tk_OptionTable optionTable;
+ static const char *const optionStrings[] = {
+ "configure", "forget", "info", "slaves", NULL
+ };
+ enum options { PLACE_CONFIGURE, PLACE_FORGET, PLACE_INFO, PLACE_SLAVES };
+ int index;
+
+ if (objc < 3) {
+ Tcl_WrongNumArgs(interp, 1, objv, "option|pathName args");
+ return TCL_ERROR;
+ }
+
+ /*
+ * Create the option table for this widget class. If it has already been
+ * created, the cached pointer will be returned.
+ */
+
+ optionTable = Tk_CreateOptionTable(interp, optionSpecs);
+
+ /*
+ * Handle special shortcut where window name is first argument.
+ */
+
+ if (Tcl_GetString(objv[1])[0] == '.') {
+ if (TkGetWindowFromObj(interp, main_win, objv[1],
+ &tkwin) != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ /*
+ * Initialize, if that hasn't been done yet.
+ */
+
+ dispPtr = ((TkWindow *) tkwin)->dispPtr;
+ if (!dispPtr->placeInit) {
+ Tcl_InitHashTable(&dispPtr->masterTable, TCL_ONE_WORD_KEYS);
+ Tcl_InitHashTable(&dispPtr->slaveTable, TCL_ONE_WORD_KEYS);
+ dispPtr->placeInit = 1;
+ }
+
+ return ConfigureSlave(interp, tkwin, optionTable, objc-2, objv+2);
+ }
+
+ /*
+ * Handle more general case of option followed by window name followed by
+ * possible additional arguments.
+ */
+
+ if (TkGetWindowFromObj(interp, main_win, objv[2],
+ &tkwin) != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ /*
+ * Initialize, if that hasn't been done yet.
+ */
+
+ dispPtr = ((TkWindow *) tkwin)->dispPtr;
+ if (!dispPtr->placeInit) {
+ Tcl_InitHashTable(&dispPtr->masterTable, TCL_ONE_WORD_KEYS);
+ Tcl_InitHashTable(&dispPtr->slaveTable, TCL_ONE_WORD_KEYS);
+ dispPtr->placeInit = 1;
+ }
+
+ if (Tcl_GetIndexFromObjStruct(interp, objv[1], optionStrings,
+ sizeof(char *), "option", 0, &index) != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ switch ((enum options) index) {
+ case PLACE_CONFIGURE:
+ if (objc == 3 || objc == 4) {
+ Tcl_Obj *objPtr;
+
+ slavePtr = FindSlave(tkwin);
+ if (slavePtr == NULL) {
+ return TCL_OK;
+ }
+ objPtr = Tk_GetOptionInfo(interp, (char *) slavePtr, optionTable,
+ (objc == 4) ? objv[3] : NULL, tkwin);
+ if (objPtr == NULL) {
+ return TCL_ERROR;
+ }
+ Tcl_SetObjResult(interp, objPtr);
+ return TCL_OK;
+ }
+ return ConfigureSlave(interp, tkwin, optionTable, objc-3, objv+3);
+
+ case PLACE_FORGET:
+ if (objc != 3) {
+ Tcl_WrongNumArgs(interp, 2, objv, "pathName");
+ return TCL_ERROR;
+ }
+ slavePtr = FindSlave(tkwin);
+ if (slavePtr == NULL) {
+ return TCL_OK;
+ }
+ if ((slavePtr->masterPtr != NULL) &&
+ (slavePtr->masterPtr->tkwin != Tk_Parent(slavePtr->tkwin))) {
+ Tk_UnmaintainGeometry(slavePtr->tkwin, slavePtr->masterPtr->tkwin);
+ }
+ UnlinkSlave(slavePtr);
+ Tcl_DeleteHashEntry(Tcl_FindHashEntry(&dispPtr->slaveTable,
+ (char *) tkwin));
+ Tk_DeleteEventHandler(tkwin, StructureNotifyMask, SlaveStructureProc,
+ slavePtr);
+ Tk_ManageGeometry(tkwin, NULL, NULL);
+ Tk_UnmapWindow(tkwin);
+ FreeSlave(slavePtr);
+ break;
+
+ case PLACE_INFO:
+ if (objc != 3) {
+ Tcl_WrongNumArgs(interp, 2, objv, "pathName");
+ return TCL_ERROR;
+ }
+ return PlaceInfoCommand(interp, tkwin);
+
+ case PLACE_SLAVES: {
+ Master *masterPtr;
+
+ if (objc != 3) {
+ Tcl_WrongNumArgs(interp, 2, objv, "pathName");
+ return TCL_ERROR;
+ }
+ masterPtr = FindMaster(tkwin);
+ if (masterPtr != NULL) {
+ Tcl_Obj *listPtr = Tcl_NewObj();
+
+ for (slavePtr = masterPtr->slavePtr; slavePtr != NULL;
+ slavePtr = slavePtr->nextPtr) {
+ Tcl_ListObjAppendElement(NULL, listPtr,
+ TkNewWindowObj(slavePtr->tkwin));
+ }
+ Tcl_SetObjResult(interp, listPtr);
+ }
+ break;
+ }
+ }
+
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * CreateSlave --
+ *
+ * Given a Tk_Window token, find the Slave structure corresponding to
+ * that token, creating a new one if necessary.
+ *
+ * Results:
+ * Pointer to the Slave structure.
+ *
+ * Side effects:
+ * A new Slave structure may be created.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static Slave *
+CreateSlave(
+ Tk_Window tkwin, /* Token for desired slave. */
+ Tk_OptionTable table)
+{
+ Tcl_HashEntry *hPtr;
+ register Slave *slavePtr;
+ int isNew;
+ TkDisplay *dispPtr = ((TkWindow *) tkwin)->dispPtr;
+
+ hPtr = Tcl_CreateHashEntry(&dispPtr->slaveTable, (char *) tkwin, &isNew);
+ if (!isNew) {
+ return Tcl_GetHashValue(hPtr);
+ }
+
+ /*
+ * No preexisting slave structure for that window, so make a new one and
+ * populate it with some default values.
+ */
+
+ slavePtr = ckalloc(sizeof(Slave));
+ memset(slavePtr, 0, sizeof(Slave));
+ slavePtr->tkwin = tkwin;
+ slavePtr->inTkwin = None;
+ slavePtr->anchor = TK_ANCHOR_NW;
+ slavePtr->borderMode = BM_INSIDE;
+ slavePtr->optionTable = table;
+ Tcl_SetHashValue(hPtr, slavePtr);
+ Tk_CreateEventHandler(tkwin, StructureNotifyMask, SlaveStructureProc,
+ slavePtr);
+ return slavePtr;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * FreeSlave --
+ *
+ * Frees the resources held by a Slave structure.
+ *
+ * Results:
+ * None
+ *
+ * Side effects:
+ * Memory are freed.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+FreeSlave(
+ Slave *slavePtr)
+{
+ Tk_FreeConfigOptions((char *) slavePtr, slavePtr->optionTable,
+ slavePtr->tkwin);
+ ckfree(slavePtr);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * FindSlave --
+ *
+ * Given a Tk_Window token, find the Slave structure corresponding to
+ * that token. This is purely a lookup function; it will not create a
+ * record if one does not yet exist.
+ *
+ * Results:
+ * Pointer to Slave structure; NULL if none exists.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static Slave *
+FindSlave(
+ Tk_Window tkwin) /* Token for desired slave. */
+{
+ register Tcl_HashEntry *hPtr;
+ TkDisplay *dispPtr = ((TkWindow *) tkwin)->dispPtr;
+
+ hPtr = Tcl_FindHashEntry(&dispPtr->slaveTable, (char *) tkwin);
+ if (hPtr == NULL) {
+ return NULL;
+ }
+ return Tcl_GetHashValue(hPtr);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * UnlinkSlave --
+ *
+ * This function removes a slave window from the chain of slaves in its
+ * master.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The slave list of slavePtr's master changes.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+UnlinkSlave(
+ Slave *slavePtr) /* Slave structure to be unlinked. */
+{
+ register Master *masterPtr;
+ register Slave *prevPtr;
+
+ masterPtr = slavePtr->masterPtr;
+ if (masterPtr == NULL) {
+ return;
+ }
+ if (masterPtr->slavePtr == slavePtr) {
+ masterPtr->slavePtr = slavePtr->nextPtr;
+ } else {
+ for (prevPtr = masterPtr->slavePtr; ; prevPtr = prevPtr->nextPtr) {
+ if (prevPtr == NULL) {
+ Tcl_Panic("UnlinkSlave couldn't find slave to unlink");
+ }
+ if (prevPtr->nextPtr == slavePtr) {
+ prevPtr->nextPtr = slavePtr->nextPtr;
+ break;
+ }
+ }
+ }
+
+ if (masterPtr->abortPtr != NULL) {
+ *masterPtr->abortPtr = 1;
+ }
+ slavePtr->masterPtr = NULL;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * CreateMaster --
+ *
+ * Given a Tk_Window token, find the Master structure corresponding to
+ * that token, creating a new one if necessary.
+ *
+ * Results:
+ * Pointer to the Master structure.
+ *
+ * Side effects:
+ * A new Master structure may be created.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static Master *
+CreateMaster(
+ Tk_Window tkwin) /* Token for desired master. */
+{
+ Tcl_HashEntry *hPtr;
+ register Master *masterPtr;
+ int isNew;
+ TkDisplay *dispPtr = ((TkWindow *) tkwin)->dispPtr;
+
+ hPtr = Tcl_CreateHashEntry(&dispPtr->masterTable, (char *) tkwin, &isNew);
+ if (isNew) {
+ masterPtr = ckalloc(sizeof(Master));
+ masterPtr->tkwin = tkwin;
+ masterPtr->slavePtr = NULL;
+ masterPtr->abortPtr = NULL;
+ masterPtr->flags = 0;
+ Tcl_SetHashValue(hPtr, masterPtr);
+ Tk_CreateEventHandler(masterPtr->tkwin, StructureNotifyMask,
+ MasterStructureProc, masterPtr);
+ } else {
+ masterPtr = Tcl_GetHashValue(hPtr);
+ }
+ return masterPtr;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * FindMaster --
+ *
+ * Given a Tk_Window token, find the Master structure corresponding to
+ * that token. This is simply a lookup function; a new record will not be
+ * created if one does not already exist.
+ *
+ * Results:
+ * Pointer to the Master structure; NULL if one does not exist for the
+ * given Tk_Window token.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static Master *
+FindMaster(
+ Tk_Window tkwin) /* Token for desired master. */
+{
+ register Tcl_HashEntry *hPtr;
+ TkDisplay *dispPtr = ((TkWindow *) tkwin)->dispPtr;
+
+ hPtr = Tcl_FindHashEntry(&dispPtr->masterTable, (char *) tkwin);
+ if (hPtr == NULL) {
+ return NULL;
+ }
+ return Tcl_GetHashValue(hPtr);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ConfigureSlave --
+ *
+ * This function is called to process an argv/argc list to reconfigure
+ * the placement of a window.
+ *
+ * Results:
+ * A standard Tcl result. If an error occurs then a message is left in
+ * the interp's result.
+ *
+ * Side effects:
+ * Information in slavePtr may change, and slavePtr's master is scheduled
+ * for reconfiguration.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+ConfigureSlave(
+ Tcl_Interp *interp, /* Used for error reporting. */
+ Tk_Window tkwin, /* Token for the window to manipulate. */
+ Tk_OptionTable table, /* Token for option table. */
+ int objc, /* Number of config arguments. */
+ Tcl_Obj *const objv[]) /* Object values for arguments. */
+{
+ register Master *masterPtr;
+ Tk_SavedOptions savedOptions;
+ int mask;
+ Slave *slavePtr;
+ Tk_Window masterWin = (Tk_Window) NULL;
+
+ if (Tk_TopWinHierarchy(tkwin)) {
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "can't use placer on top-level window \"%s\"; use "
+ "wm command instead", Tk_PathName(tkwin)));
+ Tcl_SetErrorCode(interp, "TK", "GEOMETRY", "TOPLEVEL", NULL);
+ return TCL_ERROR;
+ }
+
+ slavePtr = CreateSlave(tkwin, table);
+
+ if (Tk_SetOptions(interp, (char *) slavePtr, table, objc, objv,
+ slavePtr->tkwin, &savedOptions, &mask) != TCL_OK) {
+ goto error;
+ }
+
+ /*
+ * Set slave flags. First clear the field, then add bits as needed.
+ */
+
+ slavePtr->flags = 0;
+ if (slavePtr->heightPtr) {
+ slavePtr->flags |= CHILD_HEIGHT;
+ }
+
+ if (slavePtr->relHeightPtr) {
+ slavePtr->flags |= CHILD_REL_HEIGHT;
+ }
+
+ if (slavePtr->relWidthPtr) {
+ slavePtr->flags |= CHILD_REL_WIDTH;
+ }
+
+ if (slavePtr->widthPtr) {
+ slavePtr->flags |= CHILD_WIDTH;
+ }
+
+ if (!(mask & IN_MASK) && (slavePtr->masterPtr != NULL)) {
+ /*
+ * If no -in option was passed and the slave is already placed then
+ * just recompute the placement.
+ */
+
+ masterPtr = slavePtr->masterPtr;
+ goto scheduleLayout;
+ } else if (mask & IN_MASK) {
+ /* -in changed */
+ Tk_Window tkwin;
+ Tk_Window ancestor;
+
+ tkwin = slavePtr->inTkwin;
+
+ /*
+ * Make sure that the new master is either the logical parent of the
+ * slave or a descendant of that window, and that the master and slave
+ * aren't the same.
+ */
+
+ for (ancestor = tkwin; ; ancestor = Tk_Parent(ancestor)) {
+ if (ancestor == Tk_Parent(slavePtr->tkwin)) {
+ break;
+ }
+ if (Tk_TopWinHierarchy(ancestor)) {
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "can't place %s relative to %s",
+ Tk_PathName(slavePtr->tkwin), Tk_PathName(tkwin)));
+ Tcl_SetErrorCode(interp, "TK", "GEOMETRY", "HIERARCHY", NULL);
+ goto error;
+ }
+ }
+ if (slavePtr->tkwin == tkwin) {
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "can't place %s relative to itself",
+ Tk_PathName(slavePtr->tkwin)));
+ Tcl_SetErrorCode(interp, "TK", "GEOMETRY", "LOOP", NULL);
+ goto error;
+ }
+ if ((slavePtr->masterPtr != NULL)
+ && (slavePtr->masterPtr->tkwin == tkwin)) {
+ /*
+ * Re-using same old master. Nothing to do.
+ */
+
+ masterPtr = slavePtr->masterPtr;
+ goto scheduleLayout;
+ }
+ if ((slavePtr->masterPtr != NULL) &&
+ (slavePtr->masterPtr->tkwin != Tk_Parent(slavePtr->tkwin))) {
+ Tk_UnmaintainGeometry(slavePtr->tkwin, slavePtr->masterPtr->tkwin);
+ }
+ UnlinkSlave(slavePtr);
+ masterWin = tkwin;
+ }
+
+ /*
+ * If there's no master specified for this slave, use its Tk_Parent.
+ */
+
+ if (masterWin == NULL) {
+ masterWin = Tk_Parent(slavePtr->tkwin);
+ slavePtr->inTkwin = masterWin;
+ }
+
+ /*
+ * Manage the slave window in this master.
+ */
+
+ masterPtr = CreateMaster(masterWin);
+ slavePtr->masterPtr = masterPtr;
+ slavePtr->nextPtr = masterPtr->slavePtr;
+ masterPtr->slavePtr = slavePtr;
+ Tk_ManageGeometry(slavePtr->tkwin, &placerType, slavePtr);
+
+ /*
+ * Arrange for the master to be re-arranged at the first idle moment.
+ */
+
+ scheduleLayout:
+ Tk_FreeSavedOptions(&savedOptions);
+
+ if (!(masterPtr->flags & PARENT_RECONFIG_PENDING)) {
+ masterPtr->flags |= PARENT_RECONFIG_PENDING;
+ Tcl_DoWhenIdle(RecomputePlacement, masterPtr);
+ }
+ return TCL_OK;
+
+ /*
+ * Error while processing some option, cleanup and return.
+ */
+
+ error:
+ Tk_RestoreSavedOptions(&savedOptions);
+ return TCL_ERROR;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * PlaceInfoCommand --
+ *
+ * Implementation of the [place info] subcommand. See the user
+ * documentation for information on what it does.
+ *
+ * Results:
+ * Standard Tcl result.
+ *
+ * Side effects:
+ * If the given tkwin is managed by the placer, this function will put
+ * information about that placement in the interp's result.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+PlaceInfoCommand(
+ Tcl_Interp *interp, /* Interp into which to place result. */
+ Tk_Window tkwin) /* Token for the window to get info on. */
+{
+ Slave *slavePtr;
+ Tcl_Obj *infoObj;
+
+ slavePtr = FindSlave(tkwin);
+ if (slavePtr == NULL) {
+ return TCL_OK;
+ }
+ infoObj = Tcl_NewObj();
+ if (slavePtr->masterPtr != NULL) {
+ Tcl_AppendToObj(infoObj, "-in", -1);
+ Tcl_ListObjAppendElement(NULL, infoObj,
+ TkNewWindowObj(slavePtr->masterPtr->tkwin));
+ Tcl_AppendToObj(infoObj, " ", -1);
+ }
+ Tcl_AppendPrintfToObj(infoObj,
+ "-x %d -relx %.4g -y %d -rely %.4g",
+ slavePtr->x, slavePtr->relX, slavePtr->y, slavePtr->relY);
+ if (slavePtr->flags & CHILD_WIDTH) {
+ Tcl_AppendPrintfToObj(infoObj, " -width %d", slavePtr->width);
+ } else {
+ Tcl_AppendToObj(infoObj, " -width {}", -1);
+ }
+ if (slavePtr->flags & CHILD_REL_WIDTH) {
+ Tcl_AppendPrintfToObj(infoObj,
+ " -relwidth %.4g", slavePtr->relWidth);
+ } else {
+ Tcl_AppendToObj(infoObj, " -relwidth {}", -1);
+ }
+ if (slavePtr->flags & CHILD_HEIGHT) {
+ Tcl_AppendPrintfToObj(infoObj, " -height %d", slavePtr->height);
+ } else {
+ Tcl_AppendToObj(infoObj, " -height {}", -1);
+ }
+ if (slavePtr->flags & CHILD_REL_HEIGHT) {
+ Tcl_AppendPrintfToObj(infoObj,
+ " -relheight %.4g", slavePtr->relHeight);
+ } else {
+ Tcl_AppendToObj(infoObj, " -relheight {}", -1);
+ }
+
+ Tcl_AppendPrintfToObj(infoObj, " -anchor %s -bordermode %s",
+ Tk_NameOfAnchor(slavePtr->anchor),
+ borderModeStrings[slavePtr->borderMode]);
+ Tcl_SetObjResult(interp, infoObj);
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * RecomputePlacement --
+ *
+ * This function is called as a when-idle handler. It recomputes the
+ * geometries of all the slaves of a given master.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Windows may change size or shape.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+RecomputePlacement(
+ ClientData clientData) /* Pointer to Master record. */
+{
+ register Master *masterPtr = clientData;
+ register Slave *slavePtr;
+ int x, y, width, height, tmp;
+ int masterWidth, masterHeight, masterX, masterY;
+ double x1, y1, x2, y2;
+ int abort; /* May get set to non-zero to abort this
+ * placement operation. */
+
+ masterPtr->flags &= ~PARENT_RECONFIG_PENDING;
+
+ /*
+ * Abort any nested call to RecomputePlacement for this window, since
+ * we'll do everything necessary here, and set up so this call can be
+ * aborted if necessary.
+ */
+
+ if (masterPtr->abortPtr != NULL) {
+ *masterPtr->abortPtr = 1;
+ }
+ masterPtr->abortPtr = &abort;
+ abort = 0;
+ Tcl_Preserve(masterPtr);
+
+ /*
+ * Iterate over all the slaves for the master. Each slave's geometry can
+ * be computed independently of the other slaves. Changes to the window's
+ * structure could cause almost anything to happen, including deleting the
+ * parent or child. If this happens, we'll be told to abort.
+ */
+
+ for (slavePtr = masterPtr->slavePtr; slavePtr != NULL && !abort;
+ slavePtr = slavePtr->nextPtr) {
+ /*
+ * Step 1: compute size and borderwidth of master, taking into account
+ * desired border mode.
+ */
+
+ masterX = masterY = 0;
+ masterWidth = Tk_Width(masterPtr->tkwin);
+ masterHeight = Tk_Height(masterPtr->tkwin);
+ if (slavePtr->borderMode == BM_INSIDE) {
+ masterX = Tk_InternalBorderLeft(masterPtr->tkwin);
+ masterY = Tk_InternalBorderTop(masterPtr->tkwin);
+ masterWidth -= masterX + Tk_InternalBorderRight(masterPtr->tkwin);
+ masterHeight -= masterY +
+ Tk_InternalBorderBottom(masterPtr->tkwin);
+ } else if (slavePtr->borderMode == BM_OUTSIDE) {
+ masterX = masterY = -Tk_Changes(masterPtr->tkwin)->border_width;
+ masterWidth -= 2 * masterX;
+ masterHeight -= 2 * masterY;
+ }
+
+ /*
+ * Step 2: compute size of slave (outside dimensions including border)
+ * and location of anchor point within master.
+ */
+
+ x1 = slavePtr->x + masterX + (slavePtr->relX*masterWidth);
+ x = (int) (x1 + ((x1 > 0) ? 0.5 : -0.5));
+ y1 = slavePtr->y + masterY + (slavePtr->relY*masterHeight);
+ y = (int) (y1 + ((y1 > 0) ? 0.5 : -0.5));
+ if (slavePtr->flags & (CHILD_WIDTH|CHILD_REL_WIDTH)) {
+ width = 0;
+ if (slavePtr->flags & CHILD_WIDTH) {
+ width += slavePtr->width;
+ }
+ if (slavePtr->flags & CHILD_REL_WIDTH) {
+ /*
+ * The code below is a bit tricky. In order to round correctly
+ * when both relX and relWidth are specified, compute the
+ * location of the right edge and round that, then compute
+ * width. If we compute the width and round it, rounding
+ * errors in relX and relWidth accumulate.
+ */
+
+ x2 = x1 + (slavePtr->relWidth*masterWidth);
+ tmp = (int) (x2 + ((x2 > 0) ? 0.5 : -0.5));
+ width += tmp - x;
+ }
+ } else {
+ width = Tk_ReqWidth(slavePtr->tkwin)
+ + 2*Tk_Changes(slavePtr->tkwin)->border_width;
+ }
+ if (slavePtr->flags & (CHILD_HEIGHT|CHILD_REL_HEIGHT)) {
+ height = 0;
+ if (slavePtr->flags & CHILD_HEIGHT) {
+ height += slavePtr->height;
+ }
+ if (slavePtr->flags & CHILD_REL_HEIGHT) {
+ /*
+ * See note above for rounding errors in width computation.
+ */
+
+ y2 = y1 + (slavePtr->relHeight*masterHeight);
+ tmp = (int) (y2 + ((y2 > 0) ? 0.5 : -0.5));
+ height += tmp - y;
+ }
+ } else {
+ height = Tk_ReqHeight(slavePtr->tkwin)
+ + 2*Tk_Changes(slavePtr->tkwin)->border_width;
+ }
+
+ /*
+ * Step 3: adjust the x and y positions so that the desired anchor
+ * point on the slave appears at that position. Also adjust for the
+ * border mode and master's border.
+ */
+
+ switch (slavePtr->anchor) {
+ case TK_ANCHOR_N:
+ x -= width/2;
+ break;
+ case TK_ANCHOR_NE:
+ x -= width;
+ break;
+ case TK_ANCHOR_E:
+ x -= width;
+ y -= height/2;
+ break;
+ case TK_ANCHOR_SE:
+ x -= width;
+ y -= height;
+ break;
+ case TK_ANCHOR_S:
+ x -= width/2;
+ y -= height;
+ break;
+ case TK_ANCHOR_SW:
+ y -= height;
+ break;
+ case TK_ANCHOR_W:
+ y -= height/2;
+ break;
+ case TK_ANCHOR_NW:
+ break;
+ case TK_ANCHOR_CENTER:
+ x -= width/2;
+ y -= height/2;
+ break;
+ }
+
+ /*
+ * Step 4: adjust width and height again to reflect inside dimensions
+ * of window rather than outside. Also make sure that the width and
+ * height aren't zero.
+ */
+
+ width -= 2*Tk_Changes(slavePtr->tkwin)->border_width;
+ height -= 2*Tk_Changes(slavePtr->tkwin)->border_width;
+ if (width <= 0) {
+ width = 1;
+ }
+ if (height <= 0) {
+ height = 1;
+ }
+
+ /*
+ * Step 5: reconfigure the window and map it if needed. If the slave
+ * is a child of the master, we do this ourselves. If the slave isn't
+ * a child of the master, let Tk_MaintainGeometry do the work (it will
+ * re-adjust things as relevant windows map, unmap, and move).
+ */
+
+ if (masterPtr->tkwin == Tk_Parent(slavePtr->tkwin)) {
+ if ((x != Tk_X(slavePtr->tkwin))
+ || (y != Tk_Y(slavePtr->tkwin))
+ || (width != Tk_Width(slavePtr->tkwin))
+ || (height != Tk_Height(slavePtr->tkwin))) {
+ Tk_MoveResizeWindow(slavePtr->tkwin, x, y, width, height);
+ }
+ if (abort) {
+ break;
+ }
+
+ /*
+ * Don't map the slave unless the master is mapped: the slave will
+ * get mapped later, when the master is mapped.
+ */
+
+ if (Tk_IsMapped(masterPtr->tkwin)) {
+ Tk_MapWindow(slavePtr->tkwin);
+ }
+ } else {
+ if ((width <= 0) || (height <= 0)) {
+ Tk_UnmaintainGeometry(slavePtr->tkwin, masterPtr->tkwin);
+ Tk_UnmapWindow(slavePtr->tkwin);
+ } else {
+ Tk_MaintainGeometry(slavePtr->tkwin, masterPtr->tkwin,
+ x, y, width, height);
+ }
+ }
+ }
+
+ masterPtr->abortPtr = NULL;
+ Tcl_Release(masterPtr);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * MasterStructureProc --
+ *
+ * This function is invoked by the Tk event handler when StructureNotify
+ * events occur for a master window.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Structures get cleaned up if the window was deleted. If the window was
+ * resized then slave geometries get recomputed.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+MasterStructureProc(
+ ClientData clientData, /* Pointer to Master structure for window
+ * referred to by eventPtr. */
+ XEvent *eventPtr) /* Describes what just happened. */
+{
+ register Master *masterPtr = clientData;
+ register Slave *slavePtr, *nextPtr;
+ TkDisplay *dispPtr = ((TkWindow *) masterPtr->tkwin)->dispPtr;
+
+ switch (eventPtr->type) {
+ case ConfigureNotify:
+ if ((masterPtr->slavePtr != NULL)
+ && !(masterPtr->flags & PARENT_RECONFIG_PENDING)) {
+ masterPtr->flags |= PARENT_RECONFIG_PENDING;
+ Tcl_DoWhenIdle(RecomputePlacement, masterPtr);
+ }
+ return;
+ case DestroyNotify:
+ for (slavePtr = masterPtr->slavePtr; slavePtr != NULL;
+ slavePtr = nextPtr) {
+ slavePtr->masterPtr = NULL;
+ nextPtr = slavePtr->nextPtr;
+ slavePtr->nextPtr = NULL;
+ }
+ Tcl_DeleteHashEntry(Tcl_FindHashEntry(&dispPtr->masterTable,
+ (char *) masterPtr->tkwin));
+ if (masterPtr->flags & PARENT_RECONFIG_PENDING) {
+ Tcl_CancelIdleCall(RecomputePlacement, masterPtr);
+ }
+ masterPtr->tkwin = NULL;
+ if (masterPtr->abortPtr != NULL) {
+ *masterPtr->abortPtr = 1;
+ }
+ Tcl_EventuallyFree(masterPtr, TCL_DYNAMIC);
+ return;
+ case MapNotify:
+ /*
+ * When a master gets mapped, must redo the geometry computation so
+ * that all of its slaves get remapped.
+ */
+
+ if ((masterPtr->slavePtr != NULL)
+ && !(masterPtr->flags & PARENT_RECONFIG_PENDING)) {
+ masterPtr->flags |= PARENT_RECONFIG_PENDING;
+ Tcl_DoWhenIdle(RecomputePlacement, masterPtr);
+ }
+ return;
+ case UnmapNotify:
+ /*
+ * Unmap all of the slaves when the master gets unmapped, so that they
+ * don't keep redisplaying themselves.
+ */
+
+ for (slavePtr = masterPtr->slavePtr; slavePtr != NULL;
+ slavePtr = slavePtr->nextPtr) {
+ Tk_UnmapWindow(slavePtr->tkwin);
+ }
+ return;
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * SlaveStructureProc --
+ *
+ * This function is invoked by the Tk event handler when StructureNotify
+ * events occur for a slave window.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Structures get cleaned up if the window was deleted.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+SlaveStructureProc(
+ ClientData clientData, /* Pointer to Slave structure for window
+ * referred to by eventPtr. */
+ XEvent *eventPtr) /* Describes what just happened. */
+{
+ register Slave *slavePtr = clientData;
+ TkDisplay *dispPtr = ((TkWindow *) slavePtr->tkwin)->dispPtr;
+
+ if (eventPtr->type == DestroyNotify) {
+ if (slavePtr->masterPtr != NULL) {
+ UnlinkSlave(slavePtr);
+ }
+ Tcl_DeleteHashEntry(Tcl_FindHashEntry(&dispPtr->slaveTable,
+ (char *) slavePtr->tkwin));
+ FreeSlave(slavePtr);
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * PlaceRequestProc --
+ *
+ * This function is invoked by Tk whenever a slave managed by us changes
+ * its requested geometry.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The window will get relayed out, if its requested size has anything to
+ * do with its actual size.
+ *
+ *----------------------------------------------------------------------
+ */
+
+ /* ARGSUSED */
+static void
+PlaceRequestProc(
+ ClientData clientData, /* Pointer to our record for slave. */
+ Tk_Window tkwin) /* Window that changed its desired size. */
+{
+ Slave *slavePtr = clientData;
+ Master *masterPtr;
+
+ if ((slavePtr->flags & (CHILD_WIDTH|CHILD_REL_WIDTH))
+ && (slavePtr->flags & (CHILD_HEIGHT|CHILD_REL_HEIGHT))) {
+ return;
+ }
+ masterPtr = slavePtr->masterPtr;
+ if (masterPtr == NULL) {
+ return;
+ }
+ if (!(masterPtr->flags & PARENT_RECONFIG_PENDING)) {
+ masterPtr->flags |= PARENT_RECONFIG_PENDING;
+ Tcl_DoWhenIdle(RecomputePlacement, masterPtr);
+ }
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * PlaceLostSlaveProc --
+ *
+ * This function is invoked by Tk whenever some other geometry claims
+ * control over a slave that used to be managed by us.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Forgets all placer-related information about the slave.
+ *
+ *--------------------------------------------------------------
+ */
+
+ /* ARGSUSED */
+static void
+PlaceLostSlaveProc(
+ ClientData clientData, /* Slave structure for slave window that was
+ * stolen away. */
+ Tk_Window tkwin) /* Tk's handle for the slave window. */
+{
+ register Slave *slavePtr = clientData;
+ TkDisplay *dispPtr = ((TkWindow *) slavePtr->tkwin)->dispPtr;
+
+ if (slavePtr->masterPtr->tkwin != Tk_Parent(slavePtr->tkwin)) {
+ Tk_UnmaintainGeometry(slavePtr->tkwin, slavePtr->masterPtr->tkwin);
+ }
+ Tk_UnmapWindow(tkwin);
+ UnlinkSlave(slavePtr);
+ Tcl_DeleteHashEntry(Tcl_FindHashEntry(&dispPtr->slaveTable,
+ (char *) tkwin));
+ Tk_DeleteEventHandler(tkwin, StructureNotifyMask, SlaveStructureProc,
+ slavePtr);
+ FreeSlave(slavePtr);
+}
+
+/*
+ * Local Variables:
+ * mode: c
+ * c-basic-offset: 4
+ * fill-column: 78
+ * End:
+ */
diff --git a/tk8.6/generic/tkPlatDecls.h b/tk8.6/generic/tkPlatDecls.h
new file mode 100644
index 0000000..1e69c88
--- /dev/null
+++ b/tk8.6/generic/tkPlatDecls.h
@@ -0,0 +1,176 @@
+/*
+ * 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.
+ */
+
+#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.
+ */
+
+#ifdef __cplusplus
+extern "C" {
+#endif
+
+/* !BEGIN!: Do not edit below this line. */
+
+#ifdef __cplusplus
+extern "C" {
+#endif
+
+/*
+ * Exported function declarations:
+ */
+
+#if defined(_WIN32) || defined(__CYGWIN__) /* WIN */
+/* 0 */
+EXTERN Window Tk_AttachHWND(Tk_Window tkwin, HWND hwnd);
+/* 1 */
+EXTERN HINSTANCE Tk_GetHINSTANCE(void);
+/* 2 */
+EXTERN HWND Tk_GetHWND(Window window);
+/* 3 */
+EXTERN Tk_Window Tk_HWNDToWindow(HWND hwnd);
+/* 4 */
+EXTERN void Tk_PointerEvent(HWND hwnd, int x, int y);
+/* 5 */
+EXTERN int Tk_TranslateWinEvent(HWND hwnd, UINT message,
+ WPARAM wParam, LPARAM lParam,
+ LRESULT *result);
+#endif /* WIN */
+#ifdef MAC_OSX_TK /* AQUA */
+/* 0 */
+EXTERN void Tk_MacOSXSetEmbedHandler(
+ Tk_MacOSXEmbedRegisterWinProc *registerWinProcPtr,
+ Tk_MacOSXEmbedGetGrafPortProc *getPortProcPtr,
+ Tk_MacOSXEmbedMakeContainerExistProc *containerExistProcPtr,
+ Tk_MacOSXEmbedGetClipProc *getClipProc,
+ Tk_MacOSXEmbedGetOffsetInParentProc *getOffsetProc);
+/* 1 */
+EXTERN void Tk_MacOSXTurnOffMenus(void);
+/* 2 */
+EXTERN void Tk_MacOSXTkOwnsCursor(int tkOwnsIt);
+/* 3 */
+EXTERN void TkMacOSXInitMenus(Tcl_Interp *interp);
+/* 4 */
+EXTERN void TkMacOSXInitAppleEvents(Tcl_Interp *interp);
+/* 5 */
+EXTERN void TkGenWMConfigureEvent(Tk_Window tkwin, int x, int y,
+ int width, int height, int flags);
+/* 6 */
+EXTERN void TkMacOSXInvalClipRgns(Tk_Window tkwin);
+/* 7 */
+EXTERN void * TkMacOSXGetDrawablePort(Drawable drawable);
+/* 8 */
+EXTERN void * TkMacOSXGetRootControl(Drawable drawable);
+/* 9 */
+EXTERN void Tk_MacOSXSetupTkNotifier(void);
+/* 10 */
+EXTERN int Tk_MacOSXIsAppInFront(void);
+#endif /* AQUA */
+
+typedef struct TkPlatStubs {
+ int magic;
+ void *hooks;
+
+#if defined(_WIN32) || defined(__CYGWIN__) /* WIN */
+ Window (*tk_AttachHWND) (Tk_Window tkwin, HWND hwnd); /* 0 */
+ HINSTANCE (*tk_GetHINSTANCE) (void); /* 1 */
+ HWND (*tk_GetHWND) (Window window); /* 2 */
+ Tk_Window (*tk_HWNDToWindow) (HWND hwnd); /* 3 */
+ void (*tk_PointerEvent) (HWND hwnd, int x, int y); /* 4 */
+ int (*tk_TranslateWinEvent) (HWND hwnd, UINT message, WPARAM wParam, LPARAM lParam, LRESULT *result); /* 5 */
+#endif /* WIN */
+#ifdef MAC_OSX_TK /* AQUA */
+ void (*tk_MacOSXSetEmbedHandler) (Tk_MacOSXEmbedRegisterWinProc *registerWinProcPtr, Tk_MacOSXEmbedGetGrafPortProc *getPortProcPtr, Tk_MacOSXEmbedMakeContainerExistProc *containerExistProcPtr, Tk_MacOSXEmbedGetClipProc *getClipProc, Tk_MacOSXEmbedGetOffsetInParentProc *getOffsetProc); /* 0 */
+ void (*tk_MacOSXTurnOffMenus) (void); /* 1 */
+ void (*tk_MacOSXTkOwnsCursor) (int tkOwnsIt); /* 2 */
+ void (*tkMacOSXInitMenus) (Tcl_Interp *interp); /* 3 */
+ void (*tkMacOSXInitAppleEvents) (Tcl_Interp *interp); /* 4 */
+ void (*tkGenWMConfigureEvent) (Tk_Window tkwin, int x, int y, int width, int height, int flags); /* 5 */
+ void (*tkMacOSXInvalClipRgns) (Tk_Window tkwin); /* 6 */
+ void * (*tkMacOSXGetDrawablePort) (Drawable drawable); /* 7 */
+ void * (*tkMacOSXGetRootControl) (Drawable drawable); /* 8 */
+ void (*tk_MacOSXSetupTkNotifier) (void); /* 9 */
+ int (*tk_MacOSXIsAppInFront) (void); /* 10 */
+#endif /* AQUA */
+} TkPlatStubs;
+
+extern const TkPlatStubs *tkPlatStubsPtr;
+
+#ifdef __cplusplus
+}
+#endif
+
+#if defined(USE_TK_STUBS)
+
+/*
+ * Inline function declarations:
+ */
+
+#if defined(_WIN32) || defined(__CYGWIN__) /* WIN */
+#define Tk_AttachHWND \
+ (tkPlatStubsPtr->tk_AttachHWND) /* 0 */
+#define Tk_GetHINSTANCE \
+ (tkPlatStubsPtr->tk_GetHINSTANCE) /* 1 */
+#define Tk_GetHWND \
+ (tkPlatStubsPtr->tk_GetHWND) /* 2 */
+#define Tk_HWNDToWindow \
+ (tkPlatStubsPtr->tk_HWNDToWindow) /* 3 */
+#define Tk_PointerEvent \
+ (tkPlatStubsPtr->tk_PointerEvent) /* 4 */
+#define Tk_TranslateWinEvent \
+ (tkPlatStubsPtr->tk_TranslateWinEvent) /* 5 */
+#endif /* WIN */
+#ifdef MAC_OSX_TK /* AQUA */
+#define Tk_MacOSXSetEmbedHandler \
+ (tkPlatStubsPtr->tk_MacOSXSetEmbedHandler) /* 0 */
+#define Tk_MacOSXTurnOffMenus \
+ (tkPlatStubsPtr->tk_MacOSXTurnOffMenus) /* 1 */
+#define Tk_MacOSXTkOwnsCursor \
+ (tkPlatStubsPtr->tk_MacOSXTkOwnsCursor) /* 2 */
+#define TkMacOSXInitMenus \
+ (tkPlatStubsPtr->tkMacOSXInitMenus) /* 3 */
+#define TkMacOSXInitAppleEvents \
+ (tkPlatStubsPtr->tkMacOSXInitAppleEvents) /* 4 */
+#define TkGenWMConfigureEvent \
+ (tkPlatStubsPtr->tkGenWMConfigureEvent) /* 5 */
+#define TkMacOSXInvalClipRgns \
+ (tkPlatStubsPtr->tkMacOSXInvalClipRgns) /* 6 */
+#define TkMacOSXGetDrawablePort \
+ (tkPlatStubsPtr->tkMacOSXGetDrawablePort) /* 7 */
+#define TkMacOSXGetRootControl \
+ (tkPlatStubsPtr->tkMacOSXGetRootControl) /* 8 */
+#define Tk_MacOSXSetupTkNotifier \
+ (tkPlatStubsPtr->tk_MacOSXSetupTkNotifier) /* 9 */
+#define Tk_MacOSXIsAppInFront \
+ (tkPlatStubsPtr->tk_MacOSXIsAppInFront) /* 10 */
+#endif /* AQUA */
+
+#endif /* defined(USE_TK_STUBS) */
+
+/* !END!: Do not edit above this line. */
+
+#ifdef __cplusplus
+}
+#endif
+
+#undef TCL_STORAGE_CLASS
+#define TCL_STORAGE_CLASS DLLIMPORT
+
+#endif /* _TKPLATDECLS */
diff --git a/tk8.6/generic/tkPointer.c b/tk8.6/generic/tkPointer.c
new file mode 100644
index 0000000..0141b64
--- /dev/null
+++ b/tk8.6/generic/tkPointer.c
@@ -0,0 +1,647 @@
+/*
+ * tkPointer.c --
+ *
+ * This file contains functions for emulating the X server pointer and
+ * grab state machine. This file is used by the Mac and Windows platforms
+ * to generate appropriate enter/leave events, and to update the global
+ * grab window information.
+ *
+ * Copyright (c) 1996 by Sun Microsystems, Inc.
+ *
+ * See the file "license.terms" for information on usage and redistribution of
+ * this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ */
+
+#include "tkInt.h"
+
+#ifdef _WIN32
+#include "tkWinInt.h"
+#endif
+
+#if defined(MAC_OSX_TK)
+#include "tkMacOSXInt.h"
+#define Cursor XCursor
+#endif
+
+/*
+ * Mask that selects any of the state bits corresponding to buttons, plus
+ * masks that select individual buttons' bits:
+ */
+
+#define ALL_BUTTONS \
+ (Button1Mask|Button2Mask|Button3Mask|Button4Mask|Button5Mask)
+static const unsigned int buttonMasks[] = {
+ Button1Mask, Button2Mask, Button3Mask, Button4Mask, Button5Mask
+};
+#define ButtonMask(b) (buttonMasks[(b)-Button1])
+
+typedef struct ThreadSpecificData {
+ TkWindow *grabWinPtr; /* Window that defines the top of the grab
+ * tree in a global grab. */
+ int lastState; /* Last known state flags. */
+ XPoint lastPos; /* Last reported mouse position. */
+ TkWindow *lastWinPtr; /* Last reported mouse window. */
+ TkWindow *restrictWinPtr; /* Window to which all mouse events will be
+ * reported. */
+ TkWindow *cursorWinPtr; /* Window that is currently controlling the
+ * global cursor. */
+} ThreadSpecificData;
+static Tcl_ThreadDataKey dataKey;
+
+/*
+ * Forward declarations of procedures used in this file.
+ */
+
+static int GenerateEnterLeave(TkWindow *winPtr, int x, int y,
+ int state);
+static void InitializeEvent(XEvent *eventPtr, TkWindow *winPtr,
+ int type, int x, int y, int state, int detail);
+static void UpdateCursor(TkWindow *winPtr);
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * InitializeEvent --
+ *
+ * Initializes the common fields for several X events.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Fills in the specified event structure.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+InitializeEvent(
+ XEvent *eventPtr, /* Event structure to initialize. */
+ TkWindow *winPtr, /* Window to make event relative to. */
+ int type, /* Message type. */
+ int x, int y, /* Root coords of event. */
+ int state, /* State flags. */
+ int detail) /* Detail value. */
+{
+ eventPtr->type = type;
+ eventPtr->xany.serial = LastKnownRequestProcessed(winPtr->display);
+ eventPtr->xany.send_event = False;
+ eventPtr->xany.display = winPtr->display;
+
+ eventPtr->xcrossing.root = RootWindow(winPtr->display, winPtr->screenNum);
+ eventPtr->xcrossing.time = TkpGetMS();
+ eventPtr->xcrossing.x_root = x;
+ eventPtr->xcrossing.y_root = y;
+
+ switch (type) {
+ case EnterNotify:
+ case LeaveNotify:
+ eventPtr->xcrossing.mode = NotifyNormal;
+ eventPtr->xcrossing.state = state;
+ eventPtr->xcrossing.detail = detail;
+ eventPtr->xcrossing.focus = False;
+ break;
+ case MotionNotify:
+ eventPtr->xmotion.state = state;
+ eventPtr->xmotion.is_hint = detail;
+ break;
+ case ButtonPress:
+ case ButtonRelease:
+ eventPtr->xbutton.state = state;
+ eventPtr->xbutton.button = detail;
+ break;
+ }
+ TkChangeEventWindow(eventPtr, winPtr);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * GenerateEnterLeave --
+ *
+ * Update the current mouse window and position, and generate any
+ * enter/leave events that are needed.
+ *
+ * Results:
+ * Returns 1 if enter/leave events were generated.
+ *
+ * Side effects:
+ * May insert events into the Tk event queue.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+GenerateEnterLeave(
+ TkWindow *winPtr, /* Current Tk window (or NULL). */
+ int x, int y, /* Current mouse position in root coords. */
+ int state) /* State flags. */
+{
+ int crossed = 0; /* 1 if mouse crossed a window boundary */
+ ThreadSpecificData *tsdPtr =
+ Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
+ TkWindow *restrictWinPtr = tsdPtr->restrictWinPtr;
+ TkWindow *lastWinPtr = tsdPtr->lastWinPtr;
+
+ if (winPtr != tsdPtr->lastWinPtr) {
+ if (restrictWinPtr) {
+ int newPos, oldPos;
+
+ newPos = TkPositionInTree(winPtr, restrictWinPtr);
+ oldPos = TkPositionInTree(lastWinPtr, restrictWinPtr);
+
+ /*
+ * Check if the mouse crossed into or out of the restrict window.
+ * If so, we need to generate an Enter or Leave event.
+ */
+
+ if ((newPos != oldPos) && ((newPos == TK_GRAB_IN_TREE)
+ || (oldPos == TK_GRAB_IN_TREE))) {
+ XEvent event;
+ int type, detail;
+
+ if (newPos == TK_GRAB_IN_TREE) {
+ type = EnterNotify;
+ } else {
+ type = LeaveNotify;
+ }
+ if ((oldPos == TK_GRAB_ANCESTOR)
+ || (newPos == TK_GRAB_ANCESTOR)) {
+ detail = NotifyAncestor;
+ } else {
+ detail = NotifyVirtual;
+ }
+ InitializeEvent(&event, restrictWinPtr, type, x, y,
+ state, detail);
+ Tk_QueueWindowEvent(&event, TCL_QUEUE_TAIL);
+ }
+
+ } else {
+ TkWindow *targetPtr;
+
+ if ((lastWinPtr == NULL)
+ || (lastWinPtr->window == None)) {
+ targetPtr = winPtr;
+ } else {
+ targetPtr = lastWinPtr;
+ }
+
+ if (targetPtr && (targetPtr->window != None)) {
+ XEvent event;
+
+ /*
+ * Generate appropriate Enter/Leave events.
+ */
+
+ InitializeEvent(&event, targetPtr, LeaveNotify, x, y, state,
+ NotifyNormal);
+
+ TkInOutEvents(&event, lastWinPtr, winPtr, LeaveNotify,
+ EnterNotify, TCL_QUEUE_TAIL);
+ crossed = 1;
+ }
+ }
+ tsdPtr->lastWinPtr = winPtr;
+ }
+
+ return crossed;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_UpdatePointer --
+ *
+ * This function updates the pointer state machine given an the current
+ * window, position and modifier state.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * May queue new events and update the grab state.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tk_UpdatePointer(
+ Tk_Window tkwin, /* Window to which pointer event is reported.
+ * May be NULL. */
+ int x, int y, /* Pointer location in root coords. */
+ int state) /* Modifier state mask. */
+{
+ ThreadSpecificData *tsdPtr =
+ Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
+ TkWindow *winPtr = (TkWindow *)tkwin;
+ TkWindow *targetWinPtr;
+ XPoint pos;
+ XEvent event;
+ int changes = (state ^ tsdPtr->lastState) & ALL_BUTTONS;
+ int type, b, mask;
+
+ pos.x = x;
+ pos.y = y;
+
+ /*
+ * Use the current keyboard state, but the old mouse button state since we
+ * haven't generated the button events yet.
+ */
+
+ tsdPtr->lastState = (state & ~ALL_BUTTONS) | (tsdPtr->lastState
+ & ALL_BUTTONS);
+
+ /*
+ * Generate Enter/Leave events. If the pointer has crossed window
+ * boundaries, update the current mouse position so we don't generate
+ * redundant motion events.
+ */
+
+ if (GenerateEnterLeave(winPtr, x, y, tsdPtr->lastState)) {
+ tsdPtr->lastPos = pos;
+ }
+
+ /*
+ * Generate ButtonPress/ButtonRelease events based on the differences
+ * between the current button state and the last known button state.
+ */
+
+ for (b = Button1; b <= Button5; b++) {
+ mask = ButtonMask(b);
+ if (changes & mask) {
+ if (state & mask) {
+ type = ButtonPress;
+
+ /*
+ * ButtonPress - Set restrict window if we aren't grabbed, or
+ * if this is the first button down.
+ */
+
+ if (!tsdPtr->restrictWinPtr) {
+ if (!tsdPtr->grabWinPtr) {
+ /*
+ * Mouse is not grabbed, so set a button grab.
+ */
+
+ tsdPtr->restrictWinPtr = winPtr;
+ TkpSetCapture(tsdPtr->restrictWinPtr);
+
+ } else if (!(tsdPtr->lastState & ALL_BUTTONS)) {
+ /*
+ * Mouse is in a non-button grab, so ensure the button
+ * grab is inside the grab tree.
+ */
+
+ if (TkPositionInTree(winPtr, tsdPtr->grabWinPtr)
+ == TK_GRAB_IN_TREE) {
+ tsdPtr->restrictWinPtr = winPtr;
+ } else {
+ tsdPtr->restrictWinPtr = tsdPtr->grabWinPtr;
+ }
+ TkpSetCapture(tsdPtr->restrictWinPtr);
+ }
+ }
+
+ } else {
+ type = ButtonRelease;
+
+ /*
+ * ButtonRelease - Release the mouse capture and clear the
+ * restrict window when the last button is released. If we
+ * are in a global grab, restore the grab window capture.
+ */
+
+ if ((tsdPtr->lastState & ALL_BUTTONS) == mask) {
+ TkpSetCapture(tsdPtr->grabWinPtr);
+ }
+
+ /*
+ * If we are releasing a restrict window, then we need to send
+ * the button event followed by mouse motion from the restrict
+ * window to the current mouse position.
+ */
+
+ if (tsdPtr->restrictWinPtr) {
+ InitializeEvent(&event, tsdPtr->restrictWinPtr, type, x, y,
+ tsdPtr->lastState, b);
+ Tk_QueueWindowEvent(&event, TCL_QUEUE_TAIL);
+ tsdPtr->lastState &= ~mask;
+ tsdPtr->lastWinPtr = tsdPtr->restrictWinPtr;
+ tsdPtr->restrictWinPtr = NULL;
+
+ GenerateEnterLeave(winPtr, x, y, tsdPtr->lastState);
+ tsdPtr->lastPos = pos;
+ continue;
+ }
+ }
+
+ /*
+ * If a restrict window is set, make sure the pointer event is
+ * reported relative to that window. Otherwise, if a global grab
+ * is in effect then events outside of windows managed by Tk
+ * should be reported to the grab window.
+ */
+
+ if (tsdPtr->restrictWinPtr) {
+ targetWinPtr = tsdPtr->restrictWinPtr;
+ } else if (tsdPtr->grabWinPtr && !winPtr) {
+ targetWinPtr = tsdPtr->grabWinPtr;
+ } else {
+ targetWinPtr = winPtr;
+ }
+
+ /*
+ * If we still have a target window, send the event.
+ */
+
+ if (targetWinPtr != NULL) {
+ InitializeEvent(&event, targetWinPtr, type, x, y,
+ tsdPtr->lastState, b);
+ Tk_QueueWindowEvent(&event, TCL_QUEUE_TAIL);
+ }
+
+ /*
+ * Update the state for the next iteration.
+ */
+
+ tsdPtr->lastState = (type == ButtonPress)
+ ? (tsdPtr->lastState | mask) : (tsdPtr->lastState & ~mask);
+ tsdPtr->lastPos = pos;
+ }
+ }
+
+ /*
+ * Make sure the cursor window is up to date.
+ */
+
+ if (tsdPtr->restrictWinPtr) {
+ targetWinPtr = tsdPtr->restrictWinPtr;
+ } else if (tsdPtr->grabWinPtr) {
+ targetWinPtr = (TkPositionInTree(winPtr, tsdPtr->grabWinPtr)
+ == TK_GRAB_IN_TREE) ? winPtr : tsdPtr->grabWinPtr;
+ } else {
+ targetWinPtr = winPtr;
+ }
+ UpdateCursor(targetWinPtr);
+
+ /*
+ * If no other events caused the position to be updated, generate a motion
+ * event.
+ */
+
+ if (tsdPtr->lastPos.x != pos.x || tsdPtr->lastPos.y != pos.y) {
+ if (tsdPtr->restrictWinPtr) {
+ targetWinPtr = tsdPtr->restrictWinPtr;
+ } else if (tsdPtr->grabWinPtr && !winPtr) {
+ targetWinPtr = tsdPtr->grabWinPtr;
+ }
+
+ if (targetWinPtr != NULL) {
+ InitializeEvent(&event, targetWinPtr, MotionNotify, x, y,
+ tsdPtr->lastState, NotifyNormal);
+ Tk_QueueWindowEvent(&event, TCL_QUEUE_TAIL);
+ }
+ tsdPtr->lastPos = pos;
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * XGrabPointer --
+ *
+ * Capture the mouse so event are reported outside of toplevels. Note
+ * that this is a very limited implementation that only supports
+ * GrabModeAsync and owner_events True.
+ *
+ * Results:
+ * Always returns GrabSuccess.
+ *
+ * Side effects:
+ * Turns on mouse capture, sets the global grab pointer, and clears any
+ * window restrictions.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+XGrabPointer(
+ Display *display,
+ Window grab_window,
+ Bool owner_events,
+ unsigned int event_mask,
+ int pointer_mode,
+ int keyboard_mode,
+ Window confine_to,
+ Cursor cursor,
+ Time time)
+{
+ ThreadSpecificData *tsdPtr =
+ Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
+
+ display->request++;
+ tsdPtr->grabWinPtr = (TkWindow *) Tk_IdToWindow(display, grab_window);
+ tsdPtr->restrictWinPtr = NULL;
+ TkpSetCapture(tsdPtr->grabWinPtr);
+ if (TkPositionInTree(tsdPtr->lastWinPtr, tsdPtr->grabWinPtr)
+ != TK_GRAB_IN_TREE) {
+ UpdateCursor(tsdPtr->grabWinPtr);
+ }
+ return GrabSuccess;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * XUngrabPointer --
+ *
+ * Release the current grab.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Releases the mouse capture.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+XUngrabPointer(
+ Display *display,
+ Time time)
+{
+ ThreadSpecificData *tsdPtr =
+ Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
+
+ display->request++;
+ tsdPtr->grabWinPtr = NULL;
+ tsdPtr->restrictWinPtr = NULL;
+ TkpSetCapture(NULL);
+ UpdateCursor(tsdPtr->lastWinPtr);
+ return Success;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkPointerDeadWindow --
+ *
+ * Clean up pointer module state when a window is destroyed.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * May release the current capture window.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TkPointerDeadWindow(
+ TkWindow *winPtr)
+{
+ ThreadSpecificData *tsdPtr =
+ Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
+
+ if (winPtr == tsdPtr->lastWinPtr) {
+ tsdPtr->lastWinPtr = NULL;
+ }
+ if (winPtr == tsdPtr->grabWinPtr) {
+ tsdPtr->grabWinPtr = NULL;
+ }
+ if (winPtr == tsdPtr->restrictWinPtr) {
+ tsdPtr->restrictWinPtr = NULL;
+ }
+ if (!(tsdPtr->restrictWinPtr || tsdPtr->grabWinPtr)) {
+ TkpSetCapture(NULL);
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * UpdateCursor --
+ *
+ * Set the windows global cursor to the cursor associated with the given
+ * Tk window.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Changes the mouse cursor.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+UpdateCursor(
+ TkWindow *winPtr)
+{
+ Cursor cursor = None;
+ ThreadSpecificData *tsdPtr =
+ Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
+
+ /*
+ * A window inherits its cursor from its parent if it doesn't have one of
+ * its own. Top level windows inherit the default cursor.
+ */
+
+ tsdPtr->cursorWinPtr = winPtr;
+ while (winPtr != NULL) {
+ if (winPtr->atts.cursor != None) {
+ cursor = winPtr->atts.cursor;
+ break;
+ } else if (winPtr->flags & TK_TOP_HIERARCHY) {
+ break;
+ }
+ winPtr = winPtr->parentPtr;
+ }
+ TkpSetCursor((TkpCursor) cursor);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * XDefineCursor --
+ *
+ * This function is called to update the cursor on a window. Since the
+ * mouse might be in the specified window, we need to check the specified
+ * window against the current mouse position and grab state.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * May update the cursor.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+XDefineCursor(
+ Display *display,
+ Window w,
+ Cursor cursor)
+{
+ TkWindow *winPtr = (TkWindow *) Tk_IdToWindow(display, w);
+ ThreadSpecificData *tsdPtr =
+ Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
+
+ if (tsdPtr->cursorWinPtr == winPtr) {
+ UpdateCursor(winPtr);
+ }
+ display->request++;
+ return Success;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkGenerateActivateEvents --
+ *
+ * This function is called by the Mac and Windows window manager routines
+ * when a toplevel window is activated or deactivated.
+ * Activate/Deactivate events will be sent to every subwindow of the
+ * toplevel followed by a FocusIn/FocusOut message.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Generates X events.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TkGenerateActivateEvents(
+ TkWindow *winPtr, /* Toplevel to activate. */
+ int active) /* Non-zero if the window is being activated,
+ * else 0.*/
+{
+ XEvent event;
+
+ /*
+ * Generate Activate and Deactivate events. This event is sent to every
+ * subwindow in a toplevel window.
+ */
+
+ event.xany.serial = winPtr->display->request++;
+ event.xany.send_event = False;
+ event.xany.display = winPtr->display;
+ event.xany.window = winPtr->window;
+
+ event.xany.type = active ? ActivateNotify : DeactivateNotify;
+ TkQueueEventForAllChildren(winPtr, &event);
+}
+
+/*
+ * Local Variables:
+ * mode: c
+ * c-basic-offset: 4
+ * fill-column: 78
+ * End:
+ */
diff --git a/tk8.6/generic/tkPort.h b/tk8.6/generic/tkPort.h
new file mode 100644
index 0000000..d6db449
--- /dev/null
+++ b/tk8.6/generic/tkPort.h
@@ -0,0 +1,31 @@
+/*
+ * tkPort.h --
+ *
+ * This header file handles porting issues that occur because of
+ * differences between systems. It reads in platform specific
+ * portability files.
+ *
+ * Copyright (c) 1995 Sun Microsystems, Inc.
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ */
+
+#ifndef _TKPORT
+#define _TKPORT
+
+#if defined(_WIN32)
+# include "tkWinPort.h"
+#endif
+#ifndef _TK
+# include "tk.h"
+#endif
+#if !defined(_WIN32)
+# if defined(MAC_OSX_TK)
+# include "tkMacOSXPort.h"
+# else
+# include "tkUnixPort.h"
+# endif
+#endif
+
+#endif /* _TKPORT */
diff --git a/tk8.6/generic/tkRectOval.c b/tk8.6/generic/tkRectOval.c
new file mode 100644
index 0000000..50b5f1a
--- /dev/null
+++ b/tk8.6/generic/tkRectOval.c
@@ -0,0 +1,1436 @@
+/*
+ * tkRectOval.c --
+ *
+ * This file implements rectangle and oval items for canvas widgets.
+ *
+ * Copyright (c) 1991-1994 The Regents of the University of California.
+ * Copyright (c) 1994-1997 Sun Microsystems, Inc.
+ *
+ * See the file "license.terms" for information on usage and redistribution of
+ * this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ */
+
+#include "tkInt.h"
+#include "tkCanvas.h"
+
+/*
+ * The structure below defines the record for each rectangle/oval item.
+ */
+
+typedef struct RectOvalItem {
+ Tk_Item header; /* Generic stuff that's the same for all
+ * types. MUST BE FIRST IN STRUCTURE. */
+ Tk_Outline outline; /* Outline structure */
+ double bbox[4]; /* Coordinates of bounding box for rectangle
+ * or oval (x1, y1, x2, y2). Item includes x1
+ * and x2 but not y1 and y2. */
+ Tk_TSOffset tsoffset;
+ XColor *fillColor; /* Color for filling rectangle/oval. */
+ XColor *activeFillColor; /* Color for filling rectangle/oval if state
+ * is active. */
+ XColor *disabledFillColor; /* Color for filling rectangle/oval if state
+ * is disabled. */
+ Pixmap fillStipple; /* Stipple bitmap for filling item. */
+ Pixmap activeFillStipple; /* Stipple bitmap for filling item if state is
+ * active. */
+ Pixmap disabledFillStipple; /* Stipple bitmap for filling item if state is
+ * disabled. */
+ GC fillGC; /* Graphics context for filling item. */
+} RectOvalItem;
+
+/*
+ * Information used for parsing configuration specs:
+ */
+
+static const Tk_CustomOption stateOption = {
+ TkStateParseProc, TkStatePrintProc, INT2PTR(2)
+};
+static const Tk_CustomOption tagsOption = {
+ Tk_CanvasTagsParseProc, Tk_CanvasTagsPrintProc, NULL
+};
+static const Tk_CustomOption dashOption = {
+ TkCanvasDashParseProc, TkCanvasDashPrintProc, NULL
+};
+static const Tk_CustomOption offsetOption = {
+ TkOffsetParseProc, TkOffsetPrintProc, INT2PTR(TK_OFFSET_RELATIVE)
+};
+static const Tk_CustomOption pixelOption = {
+ TkPixelParseProc, TkPixelPrintProc, NULL
+};
+
+static const Tk_ConfigSpec configSpecs[] = {
+ {TK_CONFIG_CUSTOM, "-activedash", NULL, NULL,
+ NULL, Tk_Offset(RectOvalItem, outline.activeDash),
+ TK_CONFIG_NULL_OK, &dashOption},
+ {TK_CONFIG_COLOR, "-activefill", NULL, NULL,
+ NULL, Tk_Offset(RectOvalItem, activeFillColor), TK_CONFIG_NULL_OK, NULL},
+ {TK_CONFIG_COLOR, "-activeoutline", NULL, NULL,
+ NULL, Tk_Offset(RectOvalItem, outline.activeColor), TK_CONFIG_NULL_OK, NULL},
+ {TK_CONFIG_BITMAP, "-activeoutlinestipple", NULL, NULL,
+ NULL, Tk_Offset(RectOvalItem, outline.activeStipple),
+ TK_CONFIG_NULL_OK, NULL},
+ {TK_CONFIG_BITMAP, "-activestipple", NULL, NULL,
+ NULL, Tk_Offset(RectOvalItem, activeFillStipple), TK_CONFIG_NULL_OK, NULL},
+ {TK_CONFIG_CUSTOM, "-activewidth", NULL, NULL,
+ "0.0", Tk_Offset(RectOvalItem, outline.activeWidth),
+ TK_CONFIG_DONT_SET_DEFAULT, &pixelOption},
+ {TK_CONFIG_CUSTOM, "-dash", NULL, NULL,
+ NULL, Tk_Offset(RectOvalItem, outline.dash),
+ TK_CONFIG_NULL_OK, &dashOption},
+ {TK_CONFIG_PIXELS, "-dashoffset", NULL, NULL,
+ "0", Tk_Offset(RectOvalItem, outline.offset),
+ TK_CONFIG_DONT_SET_DEFAULT, NULL},
+ {TK_CONFIG_CUSTOM, "-disableddash", NULL, NULL,
+ NULL, Tk_Offset(RectOvalItem, outline.disabledDash),
+ TK_CONFIG_NULL_OK, &dashOption},
+ {TK_CONFIG_COLOR, "-disabledfill", NULL, NULL,
+ NULL, Tk_Offset(RectOvalItem, disabledFillColor), TK_CONFIG_NULL_OK, NULL},
+ {TK_CONFIG_COLOR, "-disabledoutline", NULL, NULL,
+ NULL, Tk_Offset(RectOvalItem, outline.disabledColor),
+ TK_CONFIG_NULL_OK, NULL},
+ {TK_CONFIG_BITMAP, "-disabledoutlinestipple", NULL, NULL,
+ NULL, Tk_Offset(RectOvalItem, outline.disabledStipple),
+ TK_CONFIG_NULL_OK, NULL},
+ {TK_CONFIG_BITMAP, "-disabledstipple", NULL, NULL,
+ NULL, Tk_Offset(RectOvalItem, disabledFillStipple), TK_CONFIG_NULL_OK, NULL},
+ {TK_CONFIG_PIXELS, "-disabledwidth", NULL, NULL,
+ "0.0", Tk_Offset(RectOvalItem, outline.disabledWidth),
+ TK_CONFIG_DONT_SET_DEFAULT, &pixelOption},
+ {TK_CONFIG_COLOR, "-fill", NULL, NULL,
+ NULL, Tk_Offset(RectOvalItem, fillColor), TK_CONFIG_NULL_OK, NULL},
+ {TK_CONFIG_CUSTOM, "-offset", NULL, NULL,
+ "0,0", Tk_Offset(RectOvalItem, tsoffset),
+ TK_CONFIG_DONT_SET_DEFAULT, &offsetOption},
+ {TK_CONFIG_COLOR, "-outline", NULL, NULL,
+ "black", Tk_Offset(RectOvalItem, outline.color), TK_CONFIG_NULL_OK, NULL},
+ {TK_CONFIG_CUSTOM, "-outlineoffset", NULL, NULL,
+ "0,0", Tk_Offset(RectOvalItem, outline.tsoffset),
+ TK_CONFIG_DONT_SET_DEFAULT, &offsetOption},
+ {TK_CONFIG_BITMAP, "-outlinestipple", NULL, NULL,
+ NULL, Tk_Offset(RectOvalItem, outline.stipple), TK_CONFIG_NULL_OK, NULL},
+ {TK_CONFIG_CUSTOM, "-state", NULL, NULL,
+ NULL, Tk_Offset(Tk_Item, state),TK_CONFIG_NULL_OK, &stateOption},
+ {TK_CONFIG_BITMAP, "-stipple", NULL, NULL,
+ NULL, Tk_Offset(RectOvalItem, fillStipple),TK_CONFIG_NULL_OK, NULL},
+ {TK_CONFIG_CUSTOM, "-tags", NULL, NULL,
+ NULL, 0, TK_CONFIG_NULL_OK, &tagsOption},
+ {TK_CONFIG_CUSTOM, "-width", NULL, NULL,
+ "1.0", Tk_Offset(RectOvalItem, outline.width),
+ TK_CONFIG_DONT_SET_DEFAULT, &pixelOption},
+ {TK_CONFIG_END, NULL, NULL, NULL, NULL, 0, 0, NULL}
+};
+
+/*
+ * Prototypes for functions defined in this file:
+ */
+
+static void ComputeRectOvalBbox(Tk_Canvas canvas,
+ RectOvalItem *rectOvalPtr);
+static int ConfigureRectOval(Tcl_Interp *interp, Tk_Canvas canvas,
+ Tk_Item *itemPtr, int objc, Tcl_Obj *const objv[],
+ int flags);
+static int CreateRectOval(Tcl_Interp *interp, Tk_Canvas canvas,
+ Tk_Item *itemPtr, int objc, Tcl_Obj *const objv[]);
+static void DeleteRectOval(Tk_Canvas canvas, Tk_Item *itemPtr,
+ Display *display);
+static void DisplayRectOval(Tk_Canvas canvas, Tk_Item *itemPtr,
+ Display *display, Drawable dst, int x, int y,
+ int width, int height);
+static int OvalToArea(Tk_Canvas canvas, Tk_Item *itemPtr,
+ double *areaPtr);
+static double OvalToPoint(Tk_Canvas canvas, Tk_Item *itemPtr,
+ double *pointPtr);
+static int RectOvalCoords(Tcl_Interp *interp, Tk_Canvas canvas,
+ Tk_Item *itemPtr, int objc, Tcl_Obj *const objv[]);
+static int RectOvalToPostscript(Tcl_Interp *interp,
+ Tk_Canvas canvas, Tk_Item *itemPtr, int prepass);
+static int RectToArea(Tk_Canvas canvas, Tk_Item *itemPtr,
+ double *areaPtr);
+static double RectToPoint(Tk_Canvas canvas, Tk_Item *itemPtr,
+ double *pointPtr);
+static void ScaleRectOval(Tk_Canvas canvas, Tk_Item *itemPtr,
+ double originX, double originY,
+ double scaleX, double scaleY);
+static void TranslateRectOval(Tk_Canvas canvas, Tk_Item *itemPtr,
+ double deltaX, double deltaY);
+
+/*
+ * The structures below defines the rectangle and oval item types by means of
+ * functions that can be invoked by generic item code.
+ */
+
+Tk_ItemType tkRectangleType = {
+ "rectangle", /* name */
+ sizeof(RectOvalItem), /* itemSize */
+ CreateRectOval, /* createProc */
+ configSpecs, /* configSpecs */
+ ConfigureRectOval, /* configureProc */
+ RectOvalCoords, /* coordProc */
+ DeleteRectOval, /* deleteProc */
+ DisplayRectOval, /* displayProc */
+ TK_CONFIG_OBJS, /* flags */
+ RectToPoint, /* pointProc */
+ RectToArea, /* areaProc */
+ RectOvalToPostscript, /* postscriptProc */
+ ScaleRectOval, /* scaleProc */
+ TranslateRectOval, /* translateProc */
+ NULL, /* indexProc */
+ NULL, /* icursorProc */
+ NULL, /* selectionProc */
+ NULL, /* insertProc */
+ NULL, /* dTextProc */
+ NULL, /* nextPtr */
+ NULL, 0, NULL, NULL
+};
+
+Tk_ItemType tkOvalType = {
+ "oval", /* name */
+ sizeof(RectOvalItem), /* itemSize */
+ CreateRectOval, /* createProc */
+ configSpecs, /* configSpecs */
+ ConfigureRectOval, /* configureProc */
+ RectOvalCoords, /* coordProc */
+ DeleteRectOval, /* deleteProc */
+ DisplayRectOval, /* displayProc */
+ TK_CONFIG_OBJS, /* flags */
+ OvalToPoint, /* pointProc */
+ OvalToArea, /* areaProc */
+ RectOvalToPostscript, /* postscriptProc */
+ ScaleRectOval, /* scaleProc */
+ TranslateRectOval, /* translateProc */
+ NULL, /* indexProc */
+ NULL, /* cursorProc */
+ NULL, /* selectionProc */
+ NULL, /* insertProc */
+ NULL, /* dTextProc */
+ NULL, /* nextPtr */
+ NULL, 0, NULL, NULL
+};
+
+/*
+ *--------------------------------------------------------------
+ *
+ * CreateRectOval --
+ *
+ * This function is invoked to create a new rectangle or oval item in a
+ * canvas.
+ *
+ * Results:
+ * A standard Tcl return value. If an error occurred in creating the
+ * item, then an error message is left in the interp's result; in this
+ * case itemPtr is left uninitialized, so it can be safely freed by the
+ * caller.
+ *
+ * Side effects:
+ * A new rectangle or oval item is created.
+ *
+ *--------------------------------------------------------------
+ */
+
+static int
+CreateRectOval(
+ Tcl_Interp *interp, /* For error reporting. */
+ Tk_Canvas canvas, /* Canvas to hold new item. */
+ Tk_Item *itemPtr, /* Record to hold new item; header has been
+ * initialized by caller. */
+ int objc, /* Number of arguments in objv. */
+ Tcl_Obj *const objv[]) /* Arguments describing rectangle. */
+{
+ RectOvalItem *rectOvalPtr = (RectOvalItem *) itemPtr;
+ int i;
+
+ if (objc == 0) {
+ Tcl_Panic("canvas did not pass any coords");
+ }
+
+ /*
+ * Carry out initialization that is needed in order to clean up after
+ * errors during the the remainder of this function.
+ */
+
+ Tk_CreateOutline(&(rectOvalPtr->outline));
+ rectOvalPtr->tsoffset.flags = 0;
+ rectOvalPtr->tsoffset.xoffset = 0;
+ rectOvalPtr->tsoffset.yoffset = 0;
+ rectOvalPtr->fillColor = NULL;
+ rectOvalPtr->activeFillColor = NULL;
+ rectOvalPtr->disabledFillColor = NULL;
+ rectOvalPtr->fillStipple = None;
+ rectOvalPtr->activeFillStipple = None;
+ rectOvalPtr->disabledFillStipple = None;
+ rectOvalPtr->fillGC = None;
+
+ /*
+ * Process the arguments to fill in the item record.
+ */
+
+ for (i = 1; i < objc; i++) {
+ const char *arg = Tcl_GetString(objv[i]);
+
+ if ((arg[0] == '-') && (arg[1] >= 'a') && (arg[1] <= 'z')) {
+ break;
+ }
+ }
+ if ((RectOvalCoords(interp, canvas, itemPtr, i, objv) != TCL_OK)) {
+ goto error;
+ }
+ if (ConfigureRectOval(interp, canvas, itemPtr, objc-i, objv+i, 0)
+ == TCL_OK) {
+ return TCL_OK;
+ }
+
+ error:
+ DeleteRectOval(canvas, itemPtr, Tk_Display(Tk_CanvasTkwin(canvas)));
+ return TCL_ERROR;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * RectOvalCoords --
+ *
+ * This function is invoked to process the "coords" widget command on
+ * rectangles and ovals. See the user documentation for details on what
+ * it does.
+ *
+ * Results:
+ * Returns TCL_OK or TCL_ERROR, and sets the interp's result.
+ *
+ * Side effects:
+ * The coordinates for the given item may be changed.
+ *
+ *--------------------------------------------------------------
+ */
+
+static int
+RectOvalCoords(
+ Tcl_Interp *interp, /* Used for error reporting. */
+ Tk_Canvas canvas, /* Canvas containing item. */
+ Tk_Item *itemPtr, /* Item whose coordinates are to be read or
+ * modified. */
+ int objc, /* Number of coordinates supplied in objv. */
+ Tcl_Obj *const objv[]) /* Array of coordinates: x1,y1,x2,y2,... */
+{
+ RectOvalItem *rectOvalPtr = (RectOvalItem *) itemPtr;
+
+ /*
+ * If no coordinates, return the current coordinates (i.e. bounding box).
+ */
+
+ if (objc == 0) {
+ Tcl_Obj *bbox[4];
+
+ bbox[0] = Tcl_NewDoubleObj(rectOvalPtr->bbox[0]);
+ bbox[1] = Tcl_NewDoubleObj(rectOvalPtr->bbox[1]);
+ bbox[2] = Tcl_NewDoubleObj(rectOvalPtr->bbox[2]);
+ bbox[3] = Tcl_NewDoubleObj(rectOvalPtr->bbox[3]);
+ Tcl_SetObjResult(interp, Tcl_NewListObj(4, bbox));
+ return TCL_OK;
+ }
+
+ /*
+ * If one "coordinate", treat as list of coordinates.
+ */
+
+ if (objc == 1) {
+ if (Tcl_ListObjGetElements(interp, objv[0], &objc,
+ (Tcl_Obj ***) &objv) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ }
+
+ /*
+ * Better have four coordinates now. Spit out an error message otherwise.
+ */
+
+ if (objc != 4) {
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "wrong # coordinates: expected 0 or 4, got %d", objc));
+ Tcl_SetErrorCode(interp, "TK", "CANVAS", "COORDS",
+ (rectOvalPtr->header.typePtr == &tkRectangleType
+ ? "RECTANGLE" : "OVAL"), NULL);
+ return TCL_ERROR;
+ }
+
+ /*
+ * Parse the coordinates and update our bounding box.
+ */
+
+ if ((Tk_CanvasGetCoordFromObj(interp, canvas, objv[0],
+ &rectOvalPtr->bbox[0]) != TCL_OK)
+ || (Tk_CanvasGetCoordFromObj(interp, canvas, objv[1],
+ &rectOvalPtr->bbox[1]) != TCL_OK)
+ || (Tk_CanvasGetCoordFromObj(interp, canvas, objv[2],
+ &rectOvalPtr->bbox[2]) != TCL_OK)
+ || (Tk_CanvasGetCoordFromObj(interp, canvas, objv[3],
+ &rectOvalPtr->bbox[3]) != TCL_OK)) {
+ return TCL_ERROR;
+ }
+ ComputeRectOvalBbox(canvas, rectOvalPtr);
+ return TCL_OK;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * ConfigureRectOval --
+ *
+ * This function is invoked to configure various aspects of a rectangle
+ * or oval item, such as its border and background colors.
+ *
+ * Results:
+ * A standard Tcl result code. If an error occurs, then an error message
+ * is left in the interp's result.
+ *
+ * Side effects:
+ * Configuration information, such as colors and stipple patterns, may be
+ * set for itemPtr.
+ *
+ *--------------------------------------------------------------
+ */
+
+static int
+ConfigureRectOval(
+ Tcl_Interp *interp, /* Used for error reporting. */
+ Tk_Canvas canvas, /* Canvas containing itemPtr. */
+ Tk_Item *itemPtr, /* Rectangle item to reconfigure. */
+ int objc, /* Number of elements in objv. */
+ Tcl_Obj *const objv[], /* Arguments describing things to configure. */
+ int flags) /* Flags to pass to Tk_ConfigureWidget. */
+{
+ RectOvalItem *rectOvalPtr = (RectOvalItem *) itemPtr;
+ XGCValues gcValues;
+ GC newGC;
+ unsigned long mask;
+ Tk_Window tkwin;
+ Tk_TSOffset *tsoffset;
+ XColor *color;
+ Pixmap stipple;
+ Tk_State state;
+
+ tkwin = Tk_CanvasTkwin(canvas);
+
+ if (TCL_OK != Tk_ConfigureWidget(interp, tkwin, configSpecs, objc,
+ (const char **)objv, (char *) rectOvalPtr, flags|TK_CONFIG_OBJS)) {
+ return TCL_ERROR;
+ }
+ state = itemPtr->state;
+
+ /*
+ * A few of the options require additional processing, such as graphics
+ * contexts.
+ */
+
+ if (rectOvalPtr->outline.activeWidth > rectOvalPtr->outline.width ||
+ rectOvalPtr->outline.activeDash.number != 0 ||
+ rectOvalPtr->outline.activeColor != NULL ||
+ rectOvalPtr->outline.activeStipple != None ||
+ rectOvalPtr->activeFillColor != NULL ||
+ rectOvalPtr->activeFillStipple != None) {
+ itemPtr->redraw_flags |= TK_ITEM_STATE_DEPENDANT;
+ } else {
+ itemPtr->redraw_flags &= ~TK_ITEM_STATE_DEPENDANT;
+ }
+
+ tsoffset = &rectOvalPtr->outline.tsoffset;
+ flags = tsoffset->flags;
+ if (flags & TK_OFFSET_LEFT) {
+ tsoffset->xoffset = (int) (rectOvalPtr->bbox[0] + 0.5);
+ } else if (flags & TK_OFFSET_CENTER) {
+ tsoffset->xoffset = (int)
+ ((rectOvalPtr->bbox[0]+rectOvalPtr->bbox[2]+1)/2);
+ } else if (flags & TK_OFFSET_RIGHT) {
+ tsoffset->xoffset = (int) (rectOvalPtr->bbox[2] + 0.5);
+ }
+ if (flags & TK_OFFSET_TOP) {
+ tsoffset->yoffset = (int) (rectOvalPtr->bbox[1] + 0.5);
+ } else if (flags & TK_OFFSET_MIDDLE) {
+ tsoffset->yoffset = (int)
+ ((rectOvalPtr->bbox[1]+rectOvalPtr->bbox[3]+1)/2);
+ } else if (flags & TK_OFFSET_BOTTOM) {
+ tsoffset->yoffset = (int) (rectOvalPtr->bbox[2] + 0.5);
+ }
+
+ /*
+ * Configure the outline graphics context. If mask is non-zero, the gc has
+ * changed and must be reallocated, provided that the new settings specify
+ * a valid outline (non-zero width and non-NULL color)
+ */
+
+ mask = Tk_ConfigOutlineGC(&gcValues, canvas, itemPtr,
+ &(rectOvalPtr->outline));
+ if (mask && \
+ rectOvalPtr->outline.width != 0 && \
+ rectOvalPtr->outline.color != NULL) {
+ gcValues.cap_style = CapProjecting;
+ mask |= GCCapStyle;
+ newGC = Tk_GetGC(tkwin, mask, &gcValues);
+ } else {
+ newGC = None;
+ }
+ if (rectOvalPtr->outline.gc != None) {
+ Tk_FreeGC(Tk_Display(tkwin), rectOvalPtr->outline.gc);
+ }
+ rectOvalPtr->outline.gc = newGC;
+
+ if (state == TK_STATE_NULL) {
+ state = Canvas(canvas)->canvas_state;
+ }
+ if (state == TK_STATE_HIDDEN) {
+ ComputeRectOvalBbox(canvas, rectOvalPtr);
+ return TCL_OK;
+ }
+
+ color = rectOvalPtr->fillColor;
+ stipple = rectOvalPtr->fillStipple;
+ if (Canvas(canvas)->currentItemPtr == itemPtr) {
+ if (rectOvalPtr->activeFillColor!=NULL) {
+ color = rectOvalPtr->activeFillColor;
+ }
+ if (rectOvalPtr->activeFillStipple!=None) {
+ stipple = rectOvalPtr->activeFillStipple;
+ }
+ } else if (state == TK_STATE_DISABLED) {
+ if (rectOvalPtr->disabledFillColor!=NULL) {
+ color = rectOvalPtr->disabledFillColor;
+ }
+ if (rectOvalPtr->disabledFillStipple!=None) {
+ stipple = rectOvalPtr->disabledFillStipple;
+ }
+ }
+
+ if (color == NULL) {
+ newGC = None;
+ } else {
+ gcValues.foreground = color->pixel;
+ if (stipple != None) {
+ gcValues.stipple = stipple;
+ gcValues.fill_style = FillStippled;
+ mask = GCForeground|GCStipple|GCFillStyle;
+ } else {
+ mask = GCForeground;
+ }
+#ifdef MAC_OSX_TK
+ /*
+ * Mac OS X CG drawing needs access to the outline linewidth even for
+ * fills (as linewidth controls antialiasing).
+ */
+
+ gcValues.line_width = rectOvalPtr->outline.gc != None ?
+ rectOvalPtr->outline.gc->line_width : 0;
+ mask |= GCLineWidth;
+#endif
+ newGC = Tk_GetGC(tkwin, mask, &gcValues);
+ }
+ if (rectOvalPtr->fillGC != None) {
+ Tk_FreeGC(Tk_Display(tkwin), rectOvalPtr->fillGC);
+ }
+ rectOvalPtr->fillGC = newGC;
+
+ tsoffset = &rectOvalPtr->tsoffset;
+ flags = tsoffset->flags;
+ if (flags & TK_OFFSET_LEFT) {
+ tsoffset->xoffset = (int) (rectOvalPtr->bbox[0] + 0.5);
+ } else if (flags & TK_OFFSET_CENTER) {
+ tsoffset->xoffset = (int)
+ ((rectOvalPtr->bbox[0]+rectOvalPtr->bbox[2]+1)/2);
+ } else if (flags & TK_OFFSET_RIGHT) {
+ tsoffset->xoffset = (int) (rectOvalPtr->bbox[2] + 0.5);
+ }
+ if (flags & TK_OFFSET_TOP) {
+ tsoffset->yoffset = (int) (rectOvalPtr->bbox[1] + 0.5);
+ } else if (flags & TK_OFFSET_MIDDLE) {
+ tsoffset->yoffset = (int)
+ ((rectOvalPtr->bbox[1]+rectOvalPtr->bbox[3]+1)/2);
+ } else if (flags & TK_OFFSET_BOTTOM) {
+ tsoffset->yoffset = (int) (rectOvalPtr->bbox[3] + 0.5);
+ }
+
+ ComputeRectOvalBbox(canvas, rectOvalPtr);
+
+ return TCL_OK;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * DeleteRectOval --
+ *
+ * This function is called to clean up the data structure associated with
+ * a rectangle or oval item.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Resources associated with itemPtr are released.
+ *
+ *--------------------------------------------------------------
+ */
+
+static void
+DeleteRectOval(
+ Tk_Canvas canvas, /* Info about overall widget. */
+ Tk_Item *itemPtr, /* Item that is being deleted. */
+ Display *display) /* Display containing window for canvas. */
+{
+ RectOvalItem *rectOvalPtr = (RectOvalItem *) itemPtr;
+
+ Tk_DeleteOutline(display, &(rectOvalPtr->outline));
+ if (rectOvalPtr->fillColor != NULL) {
+ Tk_FreeColor(rectOvalPtr->fillColor);
+ }
+ if (rectOvalPtr->activeFillColor != NULL) {
+ Tk_FreeColor(rectOvalPtr->activeFillColor);
+ }
+ if (rectOvalPtr->disabledFillColor != NULL) {
+ Tk_FreeColor(rectOvalPtr->disabledFillColor);
+ }
+ if (rectOvalPtr->fillStipple != None) {
+ Tk_FreeBitmap(display, rectOvalPtr->fillStipple);
+ }
+ if (rectOvalPtr->activeFillStipple != None) {
+ Tk_FreeBitmap(display, rectOvalPtr->activeFillStipple);
+ }
+ if (rectOvalPtr->disabledFillStipple != None) {
+ Tk_FreeBitmap(display, rectOvalPtr->disabledFillStipple);
+ }
+ if (rectOvalPtr->fillGC != None) {
+ Tk_FreeGC(display, rectOvalPtr->fillGC);
+ }
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * ComputeRectOvalBbox --
+ *
+ * This function is invoked to compute the bounding box of all the pixels
+ * that may be drawn as part of a rectangle or oval.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The fields x1, y1, x2, and y2 are updated in the header for itemPtr.
+ *
+ *--------------------------------------------------------------
+ */
+
+ /* ARGSUSED */
+static void
+ComputeRectOvalBbox(
+ Tk_Canvas canvas, /* Canvas that contains item. */
+ RectOvalItem *rectOvalPtr) /* Item whose bbox is to be recomputed. */
+{
+ int bloat, tmp;
+ double dtmp, width;
+ Tk_State state = rectOvalPtr->header.state;
+
+ if (state == TK_STATE_NULL) {
+ state = Canvas(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 (Canvas(canvas)->currentItemPtr == (Tk_Item *) rectOvalPtr) {
+ if (rectOvalPtr->outline.activeWidth>width) {
+ width = rectOvalPtr->outline.activeWidth;
+ }
+ } else if (state == TK_STATE_DISABLED) {
+ if (rectOvalPtr->outline.disabledWidth>0) {
+ width = rectOvalPtr->outline.disabledWidth;
+ }
+ }
+
+ /*
+ * Make sure that the first coordinates are the lowest ones.
+ */
+
+ if (rectOvalPtr->bbox[1] > rectOvalPtr->bbox[3]) {
+ double tmpY = rectOvalPtr->bbox[3];
+
+ rectOvalPtr->bbox[3] = rectOvalPtr->bbox[1];
+ rectOvalPtr->bbox[1] = tmpY;
+ }
+ if (rectOvalPtr->bbox[0] > rectOvalPtr->bbox[2]) {
+ double tmpX = rectOvalPtr->bbox[2];
+
+ rectOvalPtr->bbox[2] = rectOvalPtr->bbox[0];
+ rectOvalPtr->bbox[0] = tmpX;
+ }
+
+ 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 /* _WIN32 */
+ } else {
+#ifdef MAC_OSX_TK
+ /*
+ * Mac OS X CoreGraphics needs correct rounding here otherwise it will
+ * draw outside the bounding box. Probably correct on other platforms
+ * as well?
+ */
+
+ bloat = (int) (width+1.5)/2;
+#else
+ bloat = (int) (width+1)/2;
+#endif /* MAC_OSX_TK */
+ }
+
+ /*
+ * Special note: the rectangle is always drawn at least 1x1 in size, so
+ * round up the upper coordinates to be at least 1 unit greater than the
+ * lower ones.
+ */
+
+ tmp = (int) ((rectOvalPtr->bbox[0] >= 0) ? rectOvalPtr->bbox[0] + .5
+ : rectOvalPtr->bbox[0] - .5);
+ rectOvalPtr->header.x1 = tmp - bloat;
+ tmp = (int) ((rectOvalPtr->bbox[1] >= 0) ? rectOvalPtr->bbox[1] + .5
+ : rectOvalPtr->bbox[1] - .5);
+ rectOvalPtr->header.y1 = tmp - bloat;
+ dtmp = rectOvalPtr->bbox[2];
+ if (dtmp < (rectOvalPtr->bbox[0] + 1)) {
+ dtmp = rectOvalPtr->bbox[0] + 1;
+ }
+ tmp = (int) ((dtmp >= 0) ? dtmp + .5 : dtmp - .5);
+ rectOvalPtr->header.x2 = tmp + bloat;
+ dtmp = rectOvalPtr->bbox[3];
+ if (dtmp < (rectOvalPtr->bbox[1] + 1)) {
+ dtmp = rectOvalPtr->bbox[1] + 1;
+ }
+ tmp = (int) ((dtmp >= 0) ? dtmp + .5 : dtmp - .5);
+ rectOvalPtr->header.y2 = tmp + bloat;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * DisplayRectOval --
+ *
+ * This function is invoked to draw a rectangle or oval item in a given
+ * drawable.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * ItemPtr is drawn in drawable using the transformation information in
+ * canvas.
+ *
+ *--------------------------------------------------------------
+ */
+
+static void
+DisplayRectOval(
+ 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, int y, int width, int height)
+ /* Describes region of canvas that must be
+ * redisplayed (not used). */
+{
+ RectOvalItem *rectOvalPtr = (RectOvalItem *) itemPtr;
+ short x1, y1, x2, y2;
+ Pixmap fillStipple;
+ Tk_State state = itemPtr->state;
+
+ /*
+ * Compute the screen coordinates of the bounding box for the item. Make
+ * sure that the bbox is at least one pixel large, since some X servers
+ * will die if it isn't.
+ */
+
+ Tk_CanvasDrawableCoords(canvas, rectOvalPtr->bbox[0],rectOvalPtr->bbox[1],
+ &x1, &y1);
+ Tk_CanvasDrawableCoords(canvas, rectOvalPtr->bbox[2],rectOvalPtr->bbox[3],
+ &x2, &y2);
+ if (x2 <= x1) {
+ x2 = x1+1;
+ }
+ if (y2 <= y1) {
+ y2 = y1+1;
+ }
+
+ /*
+ * Display filled part first (if wanted), then outline. If we're
+ * stippling, then modify the stipple offset in the GC. Be sure to reset
+ * the offset when done, since the GC is supposed to be read-only.
+ */
+
+ if (state == TK_STATE_NULL) {
+ state = Canvas(canvas)->canvas_state;
+ }
+ fillStipple = rectOvalPtr->fillStipple;
+ if (Canvas(canvas)->currentItemPtr == (Tk_Item *) rectOvalPtr) {
+ if (rectOvalPtr->activeFillStipple != None) {
+ fillStipple = rectOvalPtr->activeFillStipple;
+ }
+ } else if (state == TK_STATE_DISABLED) {
+ if (rectOvalPtr->disabledFillStipple != None) {
+ fillStipple = rectOvalPtr->disabledFillStipple;
+ }
+ }
+
+ if (rectOvalPtr->fillGC != None) {
+ if (fillStipple != None) {
+ Tk_TSOffset *tsoffset;
+ int w = 0, h = 0;
+
+ tsoffset = &rectOvalPtr->tsoffset;
+ if (tsoffset) {
+ int flags = tsoffset->flags;
+
+ if (flags & (TK_OFFSET_CENTER|TK_OFFSET_MIDDLE)) {
+ Tk_SizeOfBitmap(display, fillStipple, &w, &h);
+ if (flags & TK_OFFSET_CENTER) {
+ w /= 2;
+ } else {
+ w = 0;
+ }
+ if (flags & TK_OFFSET_MIDDLE) {
+ h /= 2;
+ } else {
+ h = 0;
+ }
+ }
+ tsoffset->xoffset -= w;
+ tsoffset->yoffset -= h;
+ }
+ Tk_CanvasSetOffset(canvas, rectOvalPtr->fillGC, tsoffset);
+ if (tsoffset) {
+ tsoffset->xoffset += w;
+ tsoffset->yoffset += h;
+ }
+ }
+ if (rectOvalPtr->header.typePtr == &tkRectangleType) {
+ XFillRectangle(display, drawable, rectOvalPtr->fillGC,
+ x1, y1, (unsigned int) (x2-x1), (unsigned int) (y2-y1));
+ } else {
+ XFillArc(display, drawable, rectOvalPtr->fillGC,
+ x1, y1, (unsigned) (x2-x1), (unsigned) (y2-y1),
+ 0, 360*64);
+ }
+ if (fillStipple != None) {
+ XSetTSOrigin(display, rectOvalPtr->fillGC, 0, 0);
+ }
+ }
+
+ if (rectOvalPtr->outline.gc != None) {
+ Tk_ChangeOutlineGC(canvas, itemPtr, &(rectOvalPtr->outline));
+ if (rectOvalPtr->header.typePtr == &tkRectangleType) {
+ XDrawRectangle(display, drawable, rectOvalPtr->outline.gc,
+ x1, y1, (unsigned) (x2-x1), (unsigned) (y2-y1));
+ } else {
+ XDrawArc(display, drawable, rectOvalPtr->outline.gc,
+ x1, y1, (unsigned) (x2-x1), (unsigned) (y2-y1), 0, 360*64);
+ }
+ Tk_ResetOutlineGC(canvas, itemPtr, &(rectOvalPtr->outline));
+ }
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * RectToPoint --
+ *
+ * Computes the distance from a given point to a given rectangle, in
+ * canvas units.
+ *
+ * Results:
+ * The return value is 0 if the point whose x and y coordinates are
+ * coordPtr[0] and coordPtr[1] is inside the rectangle. If the point
+ * isn't inside the rectangle then the return value is the distance from
+ * the point to the rectangle. If itemPtr is filled, then anywhere in the
+ * interior is considered "inside"; if itemPtr isn't filled, then
+ * "inside" means only the area occupied by the outline.
+ *
+ * Side effects:
+ * None.
+ *
+ *--------------------------------------------------------------
+ */
+
+ /* ARGSUSED */
+static double
+RectToPoint(
+ Tk_Canvas canvas, /* Canvas containing item. */
+ Tk_Item *itemPtr, /* Item to check against point. */
+ double *pointPtr) /* Pointer to x and y coordinates. */
+{
+ RectOvalItem *rectPtr = (RectOvalItem *) itemPtr;
+ double xDiff, yDiff, x1, y1, x2, y2, inc, tmp;
+ double width;
+ Tk_State state = itemPtr->state;
+
+ if (state == TK_STATE_NULL) {
+ state = Canvas(canvas)->canvas_state;
+ }
+
+ width = rectPtr->outline.width;
+ if (Canvas(canvas)->currentItemPtr == itemPtr) {
+ if (rectPtr->outline.activeWidth>width) {
+ width = rectPtr->outline.activeWidth;
+ }
+ } else if (state == TK_STATE_DISABLED) {
+ if (rectPtr->outline.disabledWidth>0) {
+ width = rectPtr->outline.disabledWidth;
+ }
+ }
+
+ /*
+ * Generate a new larger rectangle that includes the border width, if
+ * there is one.
+ */
+
+ x1 = rectPtr->bbox[0];
+ y1 = rectPtr->bbox[1];
+ x2 = rectPtr->bbox[2];
+ y2 = rectPtr->bbox[3];
+ if (rectPtr->outline.gc != None) {
+ inc = width/2.0;
+ x1 -= inc;
+ y1 -= inc;
+ x2 += inc;
+ y2 += inc;
+ }
+
+ /*
+ * If the point is inside the rectangle, handle specially: distance is 0
+ * if rectangle is filled, otherwise compute distance to nearest edge of
+ * rectangle and subtract width of edge.
+ */
+
+ if ((pointPtr[0] >= x1) && (pointPtr[0] < x2)
+ && (pointPtr[1] >= y1) && (pointPtr[1] < y2)) {
+ if ((rectPtr->fillGC != None) || (rectPtr->outline.gc == None)) {
+ return 0.0;
+ }
+ xDiff = pointPtr[0] - x1;
+ tmp = x2 - pointPtr[0];
+ if (tmp < xDiff) {
+ xDiff = tmp;
+ }
+ yDiff = pointPtr[1] - y1;
+ tmp = y2 - pointPtr[1];
+ if (tmp < yDiff) {
+ yDiff = tmp;
+ }
+ if (yDiff < xDiff) {
+ xDiff = yDiff;
+ }
+ xDiff -= width;
+ if (xDiff < 0.0) {
+ return 0.0;
+ }
+ return xDiff;
+ }
+
+ /*
+ * Point is outside rectangle.
+ */
+
+ if (pointPtr[0] < x1) {
+ xDiff = x1 - pointPtr[0];
+ } else if (pointPtr[0] > x2) {
+ xDiff = pointPtr[0] - x2;
+ } else {
+ xDiff = 0;
+ }
+
+ if (pointPtr[1] < y1) {
+ yDiff = y1 - pointPtr[1];
+ } else if (pointPtr[1] > y2) {
+ yDiff = pointPtr[1] - y2;
+ } else {
+ yDiff = 0;
+ }
+
+ return hypot(xDiff, yDiff);
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * OvalToPoint --
+ *
+ * Computes the distance from a given point to a given oval, in canvas
+ * units.
+ *
+ * Results:
+ * The return value is 0 if the point whose x and y coordinates are
+ * coordPtr[0] and coordPtr[1] is inside the oval. If the point isn't
+ * inside the oval then the return value is the distance from the point
+ * to the oval. If itemPtr is filled, then anywhere in the interior is
+ * considered "inside"; if itemPtr isn't filled, then "inside" means only
+ * the area occupied by the outline.
+ *
+ * Side effects:
+ * None.
+ *
+ *--------------------------------------------------------------
+ */
+
+ /* ARGSUSED */
+static double
+OvalToPoint(
+ Tk_Canvas canvas, /* Canvas containing item. */
+ Tk_Item *itemPtr, /* Item to check against point. */
+ double *pointPtr) /* Pointer to x and y coordinates. */
+{
+ RectOvalItem *ovalPtr = (RectOvalItem *) itemPtr;
+ double width;
+ int filled;
+ Tk_State state = itemPtr->state;
+
+ if (state == TK_STATE_NULL) {
+ state = Canvas(canvas)->canvas_state;
+ }
+
+ width = (double) ovalPtr->outline.width;
+ if (Canvas(canvas)->currentItemPtr == itemPtr) {
+ if (ovalPtr->outline.activeWidth>width) {
+ width = (double) ovalPtr->outline.activeWidth;
+ }
+ } else if (state == TK_STATE_DISABLED) {
+ if (ovalPtr->outline.disabledWidth>0) {
+ width = (double) ovalPtr->outline.disabledWidth;
+ }
+ }
+
+
+ filled = ovalPtr->fillGC != None;
+ if (ovalPtr->outline.gc == None) {
+ width = 0.0;
+ filled = 1;
+ }
+ return TkOvalToPoint(ovalPtr->bbox, width, filled, pointPtr);
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * RectToArea --
+ *
+ * This function is called to determine whether an item lies entirely
+ * inside, entirely outside, or overlapping a given rectangle.
+ *
+ * Results:
+ * -1 is returned if the item is entirely outside the area given by
+ * rectPtr, 0 if it overlaps, and 1 if it is entirely inside the given
+ * area.
+ *
+ * Side effects:
+ * None.
+ *
+ *--------------------------------------------------------------
+ */
+
+ /* ARGSUSED */
+static int
+RectToArea(
+ Tk_Canvas canvas, /* Canvas containing item. */
+ Tk_Item *itemPtr, /* Item to check against rectangle. */
+ double *areaPtr) /* Pointer to array of four coordinates (x1,
+ * y1, x2, y2) describing rectangular area. */
+{
+ RectOvalItem *rectPtr = (RectOvalItem *) itemPtr;
+ double halfWidth;
+ double width;
+ Tk_State state = itemPtr->state;
+
+ if (state == TK_STATE_NULL) {
+ state = Canvas(canvas)->canvas_state;
+ }
+
+ width = rectPtr->outline.width;
+ if (Canvas(canvas)->currentItemPtr == itemPtr) {
+ if (rectPtr->outline.activeWidth > width) {
+ width = rectPtr->outline.activeWidth;
+ }
+ } else if (state == TK_STATE_DISABLED) {
+ if (rectPtr->outline.disabledWidth > 0) {
+ width = rectPtr->outline.disabledWidth;
+ }
+ }
+
+ halfWidth = width/2.0;
+ if (rectPtr->outline.gc == None) {
+ halfWidth = 0.0;
+ }
+
+ if ((areaPtr[2] <= (rectPtr->bbox[0] - halfWidth))
+ || (areaPtr[0] >= (rectPtr->bbox[2] + halfWidth))
+ || (areaPtr[3] <= (rectPtr->bbox[1] - halfWidth))
+ || (areaPtr[1] >= (rectPtr->bbox[3] + halfWidth))) {
+ return -1;
+ }
+ if ((rectPtr->fillGC == None) && (rectPtr->outline.gc != None)
+ && (areaPtr[0] >= (rectPtr->bbox[0] + halfWidth))
+ && (areaPtr[1] >= (rectPtr->bbox[1] + halfWidth))
+ && (areaPtr[2] <= (rectPtr->bbox[2] - halfWidth))
+ && (areaPtr[3] <= (rectPtr->bbox[3] - halfWidth))) {
+ return -1;
+ }
+ if ((areaPtr[0] <= (rectPtr->bbox[0] - halfWidth))
+ && (areaPtr[1] <= (rectPtr->bbox[1] - halfWidth))
+ && (areaPtr[2] >= (rectPtr->bbox[2] + halfWidth))
+ && (areaPtr[3] >= (rectPtr->bbox[3] + halfWidth))) {
+ return 1;
+ }
+ return 0;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * OvalToArea --
+ *
+ * This function is called to determine whether an item lies entirely
+ * inside, entirely outside, or overlapping a given rectangular area.
+ *
+ * Results:
+ * -1 is returned if the item is entirely outside the area given by
+ * rectPtr, 0 if it overlaps, and 1 if it is entirely inside the given
+ * area.
+ *
+ * Side effects:
+ * None.
+ *
+ *--------------------------------------------------------------
+ */
+
+ /* ARGSUSED */
+static int
+OvalToArea(
+ Tk_Canvas canvas, /* Canvas containing item. */
+ Tk_Item *itemPtr, /* Item to check against oval. */
+ double *areaPtr) /* Pointer to array of four coordinates (x1,
+ * y1, x2, y2) describing rectangular area. */
+{
+ RectOvalItem *ovalPtr = (RectOvalItem *) itemPtr;
+ double oval[4], halfWidth, width;
+ int result;
+ Tk_State state = itemPtr->state;
+
+ if (state == TK_STATE_NULL) {
+ state = Canvas(canvas)->canvas_state;
+ }
+
+ width = ovalPtr->outline.width;
+ if (Canvas(canvas)->currentItemPtr == itemPtr) {
+ if (ovalPtr->outline.activeWidth > width) {
+ width = ovalPtr->outline.activeWidth;
+ }
+ } else if (state == TK_STATE_DISABLED) {
+ if (ovalPtr->outline.disabledWidth > 0) {
+ width = ovalPtr->outline.disabledWidth;
+ }
+ }
+
+ /*
+ * Expand the oval to include the width of the outline, if any.
+ */
+
+ halfWidth = width/2.0;
+ if (ovalPtr->outline.gc == None) {
+ halfWidth = 0.0;
+ }
+ oval[0] = ovalPtr->bbox[0] - halfWidth;
+ oval[1] = ovalPtr->bbox[1] - halfWidth;
+ oval[2] = ovalPtr->bbox[2] + halfWidth;
+ oval[3] = ovalPtr->bbox[3] + halfWidth;
+
+ result = TkOvalToArea(oval, areaPtr);
+
+ /*
+ * If the rectangle appears to overlap the oval and the oval isn't filled,
+ * do one more check to see if perhaps all four of the rectangle's corners
+ * are totally inside the oval's unfilled center, in which case we should
+ * return "outside".
+ */
+
+ if ((result == 0) && (ovalPtr->outline.gc != None)
+ && (ovalPtr->fillGC == None)) {
+ double centerX, centerY, height;
+ double xDelta1, yDelta1, xDelta2, yDelta2;
+
+ centerX = (ovalPtr->bbox[0] + ovalPtr->bbox[2])/2.0;
+ centerY = (ovalPtr->bbox[1] + ovalPtr->bbox[3])/2.0;
+ width = (ovalPtr->bbox[2] - ovalPtr->bbox[0])/2.0 - halfWidth;
+ height = (ovalPtr->bbox[3] - ovalPtr->bbox[1])/2.0 - halfWidth;
+ xDelta1 = (areaPtr[0] - centerX)/width;
+ xDelta1 *= xDelta1;
+ yDelta1 = (areaPtr[1] - centerY)/height;
+ yDelta1 *= yDelta1;
+ xDelta2 = (areaPtr[2] - centerX)/width;
+ xDelta2 *= xDelta2;
+ yDelta2 = (areaPtr[3] - centerY)/height;
+ yDelta2 *= yDelta2;
+ if (((xDelta1 + yDelta1) < 1.0)
+ && ((xDelta1 + yDelta2) < 1.0)
+ && ((xDelta2 + yDelta1) < 1.0)
+ && ((xDelta2 + yDelta2) < 1.0)) {
+ return -1;
+ }
+ }
+ return result;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * ScaleRectOval --
+ *
+ * This function is invoked to rescale a rectangle or oval item.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The rectangle or oval referred to by itemPtr is rescaled so that the
+ * following transformation is applied to all point coordinates:
+ * x' = originX + scaleX*(x-originX)
+ * y' = originY + scaleY*(y-originY)
+ *
+ *--------------------------------------------------------------
+ */
+
+static void
+ScaleRectOval(
+ Tk_Canvas canvas, /* Canvas containing rectangle. */
+ Tk_Item *itemPtr, /* Rectangle to be scaled. */
+ double originX, double originY,
+ /* Origin about which to scale rect. */
+ double scaleX, /* Amount to scale in X direction. */
+ double scaleY) /* Amount to scale in Y direction. */
+{
+ RectOvalItem *rectOvalPtr = (RectOvalItem *) itemPtr;
+
+ rectOvalPtr->bbox[0] = originX + scaleX*(rectOvalPtr->bbox[0] - originX);
+ rectOvalPtr->bbox[1] = originY + scaleY*(rectOvalPtr->bbox[1] - originY);
+ rectOvalPtr->bbox[2] = originX + scaleX*(rectOvalPtr->bbox[2] - originX);
+ rectOvalPtr->bbox[3] = originY + scaleY*(rectOvalPtr->bbox[3] - originY);
+ ComputeRectOvalBbox(canvas, rectOvalPtr);
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * TranslateRectOval --
+ *
+ * This function is called to move a rectangle or oval by a given amount.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The position of the rectangle or oval is offset by (xDelta, yDelta),
+ * and the bounding box is updated in the generic part of the item
+ * structure.
+ *
+ *--------------------------------------------------------------
+ */
+
+static void
+TranslateRectOval(
+ Tk_Canvas canvas, /* Canvas containing item. */
+ Tk_Item *itemPtr, /* Item that is being moved. */
+ double deltaX, double deltaY)
+ /* Amount by which item is to be moved. */
+{
+ RectOvalItem *rectOvalPtr = (RectOvalItem *) itemPtr;
+
+ rectOvalPtr->bbox[0] += deltaX;
+ rectOvalPtr->bbox[1] += deltaY;
+ rectOvalPtr->bbox[2] += deltaX;
+ rectOvalPtr->bbox[3] += deltaY;
+ ComputeRectOvalBbox(canvas, rectOvalPtr);
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * RectOvalToPostscript --
+ *
+ * This function is called to generate Postscript for rectangle and oval
+ * items.
+ *
+ * Results:
+ * The return value is a standard Tcl result. If an error occurs in
+ * generating Postscript then an error message is left in the interp's
+ * result, replacing whatever used to be there. If no error occurs, then
+ * Postscript for the rectangle is appended to the result.
+ *
+ * Side effects:
+ * None.
+ *
+ *--------------------------------------------------------------
+ */
+
+static int
+RectOvalToPostscript(
+ Tcl_Interp *interp, /* Interpreter for error reporting. */
+ Tk_Canvas canvas, /* Information about overall canvas. */
+ Tk_Item *itemPtr, /* Item for which Postscript is wanted. */
+ int prepass) /* 1 means this is a prepass to collect font
+ * information; 0 means final Postscript is
+ * being created. */
+{
+ Tcl_Obj *pathObj, *psObj;
+ RectOvalItem *rectOvalPtr = (RectOvalItem *) itemPtr;
+ double y1, y2;
+ XColor *color;
+ XColor *fillColor;
+ Pixmap fillStipple;
+ Tk_State state = itemPtr->state;
+ Tcl_InterpState interpState;
+
+ y1 = Tk_CanvasPsY(canvas, rectOvalPtr->bbox[1]);
+ y2 = Tk_CanvasPsY(canvas, rectOvalPtr->bbox[3]);
+
+ /*
+ * Generate a string that creates a path for the rectangle or oval. This
+ * is the only part of the function's code that is type-specific.
+ */
+
+ if (rectOvalPtr->header.typePtr == &tkRectangleType) {
+ pathObj = Tcl_ObjPrintf(
+ "%.15g %.15g moveto "
+ "%.15g 0 rlineto "
+ "0 %.15g rlineto "
+ "%.15g 0 rlineto "
+ "closepath\n",
+ rectOvalPtr->bbox[0], y1,
+ rectOvalPtr->bbox[2]-rectOvalPtr->bbox[0],
+ y2-y1,
+ rectOvalPtr->bbox[0]-rectOvalPtr->bbox[2]);
+ } else {
+ pathObj = Tcl_ObjPrintf(
+ "matrix currentmatrix\n"
+ "%.15g %.15g translate "
+ "%.15g %.15g scale "
+ "1 0 moveto 0 0 1 0 360 arc\n"
+ "setmatrix\n",
+ (rectOvalPtr->bbox[0] + rectOvalPtr->bbox[2])/2, (y1 + y2)/2,
+ (rectOvalPtr->bbox[2] - rectOvalPtr->bbox[0])/2, (y1 - y2)/2);
+ }
+
+ if (state == TK_STATE_NULL) {
+ state = Canvas(canvas)->canvas_state;
+ }
+ color = rectOvalPtr->outline.color;
+ fillColor = rectOvalPtr->fillColor;
+ fillStipple = rectOvalPtr->fillStipple;
+ if (Canvas(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;
+ }
+ }
+
+ /*
+ * Make our working space.
+ */
+
+ psObj = Tcl_NewObj();
+ interpState = Tcl_SaveInterpState(interp, TCL_OK);
+
+ /*
+ * First draw the filled area of the rectangle.
+ */
+
+ if (fillColor != NULL) {
+ Tcl_AppendObjToObj(psObj, pathObj);
+
+ Tcl_ResetResult(interp);
+ if (Tk_CanvasPsColor(interp, canvas, fillColor) != TCL_OK) {
+ goto error;
+ }
+ Tcl_AppendObjToObj(psObj, Tcl_GetObjResult(interp));
+
+ if (fillStipple != None) {
+ Tcl_AppendToObj(psObj, "clip ", -1);
+
+ Tcl_ResetResult(interp);
+ if (Tk_CanvasPsStipple(interp, canvas, fillStipple) != TCL_OK) {
+ goto error;
+ }
+ Tcl_AppendObjToObj(psObj, Tcl_GetObjResult(interp));
+ if (color != NULL) {
+ Tcl_AppendToObj(psObj, "grestore gsave\n", -1);
+ }
+ } else {
+ Tcl_AppendToObj(psObj, "fill\n", -1);
+ }
+ }
+
+ /*
+ * Now draw the outline, if there is one.
+ */
+
+ if (color != NULL) {
+ Tcl_AppendObjToObj(psObj, pathObj);
+ Tcl_AppendToObj(psObj, "0 setlinejoin 2 setlinecap\n", -1);
+
+ Tcl_ResetResult(interp);
+ if (Tk_CanvasPsOutline(canvas, itemPtr,
+ &rectOvalPtr->outline)!= TCL_OK) {
+ goto error;
+ }
+ Tcl_AppendObjToObj(psObj, Tcl_GetObjResult(interp));
+ }
+
+ /*
+ * Plug the accumulated postscript back into the result.
+ */
+
+ (void) Tcl_RestoreInterpState(interp, interpState);
+ Tcl_AppendObjToObj(Tcl_GetObjResult(interp), psObj);
+ Tcl_DecrRefCount(psObj);
+ Tcl_DecrRefCount(pathObj);
+ return TCL_OK;
+
+ error:
+ Tcl_DiscardInterpState(interpState);
+ Tcl_DecrRefCount(psObj);
+ Tcl_DecrRefCount(pathObj);
+ return TCL_ERROR;
+}
+
+/*
+ * Local Variables:
+ * mode: c
+ * c-basic-offset: 4
+ * fill-column: 78
+ * End:
+ */
diff --git a/tk8.6/generic/tkScale.c b/tk8.6/generic/tkScale.c
new file mode 100644
index 0000000..cbc5202
--- /dev/null
+++ b/tk8.6/generic/tkScale.c
@@ -0,0 +1,1434 @@
+/*
+ * tkScale.c --
+ *
+ * This module implements a scale widgets for the Tk toolkit. A scale
+ * displays a slider that can be adjusted to change a value; it also
+ * displays numeric labels and a textual label, if desired.
+ *
+ * The modifications to use floating-point values are based on an
+ * implementation by Paul Mackerras. The -variable option is due to
+ * Henning Schulzrinne. All of these are used with permission.
+ *
+ * Copyright (c) 1990-1994 The Regents of the University of California.
+ * Copyright (c) 1994-1997 Sun Microsystems, Inc.
+ * Copyright (c) 1998-2000 by Scriptics Corporation.
+ *
+ * See the file "license.terms" for information on usage and redistribution of
+ * this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ */
+
+#include "default.h"
+#include "tkInt.h"
+#include "tkScale.h"
+
+/*
+ * The following table defines the legal values for the -orient option. It is
+ * used together with the "enum orient" declaration in tkScale.h.
+ */
+
+static const char *const orientStrings[] = {
+ "horizontal", "vertical", 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 const char *const stateStrings[] = {
+ "active", "disabled", "normal", NULL
+};
+
+static const Tk_OptionSpec optionSpecs[] = {
+ {TK_OPTION_BORDER, "-activebackground", "activeBackground", "Foreground",
+ DEF_SCALE_ACTIVE_BG_COLOR, -1, Tk_Offset(TkScale, activeBorder),
+ 0, DEF_SCALE_ACTIVE_BG_MONO, 0},
+ {TK_OPTION_BORDER, "-background", "background", "Background",
+ DEF_SCALE_BG_COLOR, -1, Tk_Offset(TkScale, bgBorder),
+ 0, 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", NULL, NULL,
+ NULL, 0, -1, 0, "-borderwidth", 0},
+ {TK_OPTION_SYNONYM, "-bg", NULL, NULL,
+ NULL, 0, -1, 0, "-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", NULL,
+ NULL, 0, -1, 0, "-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, 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, 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, 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, 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, NULL, NULL, NULL, NULL, 0, -1, 0, 0, 0}
+};
+
+/*
+ * The following tables define the scale widget commands and map the indexes
+ * into the string tables into a single enumerated type used to dispatch the
+ * scale widget command.
+ */
+
+static const char *const commandNames[] = {
+ "cget", "configure", "coords", "get", "identify", "set", NULL
+};
+
+enum command {
+ COMMAND_CGET, COMMAND_CONFIGURE, COMMAND_COORDS, COMMAND_GET,
+ COMMAND_IDENTIFY, COMMAND_SET
+};
+
+/*
+ * Forward declarations for procedures defined later in this file:
+ */
+
+static void ComputeFormat(TkScale *scalePtr);
+static void ComputeScaleGeometry(TkScale *scalePtr);
+static int ConfigureScale(Tcl_Interp *interp, TkScale *scalePtr,
+ int objc, Tcl_Obj *const objv[]);
+static void DestroyScale(char *memPtr);
+static void ScaleCmdDeletedProc(ClientData clientData);
+static void ScaleEventProc(ClientData clientData,
+ XEvent *eventPtr);
+static char * ScaleVarProc(ClientData clientData,
+ Tcl_Interp *interp, const char *name1,
+ const char *name2, int flags);
+static int ScaleWidgetObjCmd(ClientData clientData,
+ Tcl_Interp *interp, int objc,
+ Tcl_Obj *const objv[]);
+static void ScaleWorldChanged(ClientData instanceData);
+static void ScaleSetVariable(TkScale *scalePtr);
+
+/*
+ * The structure below defines scale class behavior by means of procedures
+ * that can be invoked from generic window code.
+ */
+
+static const Tk_ClassProcs scaleClass = {
+ sizeof(Tk_ClassProcs), /* size */
+ ScaleWorldChanged, /* worldChangedProc */
+ NULL, /* createProc */
+ NULL /* modalProc */
+};
+
+/*
+ *--------------------------------------------------------------
+ *
+ * Tk_ScaleObjCmd --
+ *
+ * This procedure is invoked to process the "scale" Tcl command. See the
+ * user documentation for details on what it does.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * See the user documentation.
+ *
+ *--------------------------------------------------------------
+ */
+
+int
+Tk_ScaleObjCmd(
+ ClientData clientData, /* NULL. */
+ Tcl_Interp *interp, /* Current interpreter. */
+ int objc, /* Number of arguments. */
+ Tcl_Obj *const objv[]) /* Argument values. */
+{
+ register TkScale *scalePtr;
+ Tk_OptionTable optionTable;
+ Tk_Window tkwin;
+
+ if (objc < 2) {
+ Tcl_WrongNumArgs(interp, 1, objv, "pathName ?-option value ...?");
+ return TCL_ERROR;
+ }
+
+ tkwin = Tk_CreateWindowFromPath(interp, Tk_MainWindow(interp),
+ Tcl_GetString(objv[1]), NULL);
+ if (tkwin == NULL) {
+ return TCL_ERROR;
+ }
+
+ /*
+ * Create the option table for this widget class. If it has already been
+ * created, the cached pointer will be returned.
+ */
+
+ optionTable = Tk_CreateOptionTable(interp, optionSpecs);
+
+ Tk_SetClass(tkwin, "Scale");
+ scalePtr = TkpCreateScale(tkwin);
+
+ /*
+ * Initialize fields that won't be initialized by ConfigureScale, or which
+ * ConfigureScale expects to have reasonable values (e.g. resource
+ * pointers).
+ */
+
+ scalePtr->tkwin = tkwin;
+ scalePtr->display = Tk_Display(tkwin);
+ scalePtr->interp = interp;
+ scalePtr->widgetCmd = Tcl_CreateObjCommand(interp,
+ Tk_PathName(scalePtr->tkwin), ScaleWidgetObjCmd,
+ scalePtr, ScaleCmdDeletedProc);
+ scalePtr->optionTable = optionTable;
+ scalePtr->orient = ORIENT_VERTICAL;
+ scalePtr->width = 0;
+ scalePtr->length = 0;
+ scalePtr->value = 0.0;
+ scalePtr->varNamePtr = NULL;
+ scalePtr->fromValue = 0.0;
+ scalePtr->toValue = 0.0;
+ scalePtr->tickInterval = 0.0;
+ scalePtr->resolution = 1.0;
+ scalePtr->digits = 0;
+ scalePtr->bigIncrement = 0.0;
+ scalePtr->command = NULL;
+ scalePtr->repeatDelay = 0;
+ scalePtr->repeatInterval = 0;
+ scalePtr->label = NULL;
+ scalePtr->labelLength = 0;
+ scalePtr->state = STATE_NORMAL;
+ scalePtr->borderWidth = 0;
+ scalePtr->bgBorder = NULL;
+ scalePtr->activeBorder = NULL;
+ scalePtr->sliderRelief = TK_RELIEF_RAISED;
+ scalePtr->troughColorPtr = NULL;
+ scalePtr->troughGC = None;
+ scalePtr->copyGC = None;
+ scalePtr->tkfont = NULL;
+ scalePtr->textColorPtr = NULL;
+ scalePtr->textGC = None;
+ scalePtr->relief = TK_RELIEF_FLAT;
+ scalePtr->highlightWidth = 0;
+ scalePtr->highlightBorder = NULL;
+ scalePtr->highlightColorPtr = NULL;
+ scalePtr->inset = 0;
+ scalePtr->sliderLength = 0;
+ scalePtr->showValue = 0;
+ scalePtr->horizLabelY = 0;
+ scalePtr->horizValueY = 0;
+ scalePtr->horizTroughY = 0;
+ scalePtr->horizTickY = 0;
+ scalePtr->vertTickRightX = 0;
+ scalePtr->vertValueRightX = 0;
+ scalePtr->vertTroughX = 0;
+ scalePtr->vertLabelX = 0;
+ scalePtr->fontHeight = 0;
+ scalePtr->cursor = None;
+ scalePtr->takeFocusPtr = NULL;
+ scalePtr->flags = NEVER_SET;
+
+ Tk_SetClassProcs(scalePtr->tkwin, &scaleClass, scalePtr);
+ Tk_CreateEventHandler(scalePtr->tkwin,
+ ExposureMask|StructureNotifyMask|FocusChangeMask,
+ ScaleEventProc, scalePtr);
+
+ if ((Tk_InitOptions(interp, (char *) scalePtr, optionTable, tkwin)
+ != TCL_OK) ||
+ (ConfigureScale(interp, scalePtr, objc - 2, objv + 2) != TCL_OK)) {
+ Tk_DestroyWindow(scalePtr->tkwin);
+ return TCL_ERROR;
+ }
+
+ /*
+ * The widget was just created, no command callback must be invoked.
+ */
+
+ scalePtr->flags &= ~INVOKE_COMMAND;
+
+ Tcl_SetObjResult(interp, TkNewWindowObj(scalePtr->tkwin));
+ return TCL_OK;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * ScaleWidgetObjCmd --
+ *
+ * This procedure is invoked to process the Tcl command that corresponds
+ * to a widget managed by this module. See the user documentation for
+ * details on what it does.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * See the user documentation.
+ *
+ *--------------------------------------------------------------
+ */
+
+static int
+ScaleWidgetObjCmd(
+ ClientData clientData, /* Information about scale widget. */
+ Tcl_Interp *interp, /* Current interpreter. */
+ int objc, /* Number of arguments. */
+ Tcl_Obj *const objv[]) /* Argument strings. */
+{
+ TkScale *scalePtr = clientData;
+ Tcl_Obj *objPtr;
+ int index, result;
+
+ if (objc < 2) {
+ Tcl_WrongNumArgs(interp, 1, objv, "option ?arg ...?");
+ return TCL_ERROR;
+ }
+ result = Tcl_GetIndexFromObjStruct(interp, objv[1], commandNames,
+ sizeof(char *), "option", 0, &index);
+ if (result != TCL_OK) {
+ return result;
+ }
+ Tcl_Preserve(scalePtr);
+
+ switch (index) {
+ case COMMAND_CGET:
+ if (objc != 3) {
+ Tcl_WrongNumArgs(interp, 1, objv, "cget option");
+ goto error;
+ }
+ objPtr = Tk_GetOptionValue(interp, (char *) scalePtr,
+ scalePtr->optionTable, objv[2], scalePtr->tkwin);
+ if (objPtr == NULL) {
+ goto error;
+ }
+ Tcl_SetObjResult(interp, objPtr);
+ break;
+ case COMMAND_CONFIGURE:
+ if (objc <= 3) {
+ objPtr = Tk_GetOptionInfo(interp, (char *) scalePtr,
+ scalePtr->optionTable,
+ (objc == 3) ? objv[2] : NULL, scalePtr->tkwin);
+ if (objPtr == NULL) {
+ goto error;
+ }
+ Tcl_SetObjResult(interp, objPtr);
+ } else {
+ result = ConfigureScale(interp, scalePtr, objc-2, objv+2);
+ }
+ break;
+ case COMMAND_COORDS: {
+ int x, y;
+ double value;
+ Tcl_Obj *coords[2];
+
+ if ((objc != 2) && (objc != 3)) {
+ Tcl_WrongNumArgs(interp, 1, objv, "coords ?value?");
+ goto error;
+ }
+ if (objc == 3) {
+ if (Tcl_GetDoubleFromObj(interp, objv[2], &value) != TCL_OK) {
+ goto error;
+ }
+ } else {
+ value = scalePtr->value;
+ }
+ if (scalePtr->orient == ORIENT_VERTICAL) {
+ x = scalePtr->vertTroughX + scalePtr->width/2
+ + scalePtr->borderWidth;
+ y = TkScaleValueToPixel(scalePtr, value);
+ } else {
+ x = TkScaleValueToPixel(scalePtr, value);
+ y = scalePtr->horizTroughY + scalePtr->width/2
+ + scalePtr->borderWidth;
+ }
+ coords[0] = Tcl_NewIntObj(x);
+ coords[1] = Tcl_NewIntObj(y);
+ Tcl_SetObjResult(interp, Tcl_NewListObj(2, coords));
+ break;
+ }
+ case COMMAND_GET: {
+ double value;
+ int x, y;
+
+ 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);
+ }
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(scalePtr->format, value));
+ break;
+ }
+ case COMMAND_IDENTIFY: {
+ int x, y;
+ const char *zone = "";
+
+ 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;
+ }
+ switch (TkpScaleElement(scalePtr, x, y)) {
+ case TROUGH1: zone = "trough1"; break;
+ case SLIDER: zone = "slider"; break;
+ case TROUGH2: zone = "trough2"; break;
+ }
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(zone, -1));
+ break;
+ }
+ case COMMAND_SET: {
+ double value;
+
+ if (objc != 3) {
+ Tcl_WrongNumArgs(interp, 1, objv, "set value");
+ goto error;
+ }
+ if (Tcl_GetDoubleFromObj(interp, objv[2], &value) != TCL_OK) {
+ goto error;
+ }
+ if (scalePtr->state != STATE_DISABLED) {
+ TkScaleSetValue(scalePtr, value, 1, 1);
+ }
+ break;
+ }
+ }
+ Tcl_Release(scalePtr);
+ return result;
+
+ error:
+ Tcl_Release(scalePtr);
+ return TCL_ERROR;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * DestroyScale --
+ *
+ * This procedure is invoked by Tcl_EventuallyFree or Tcl_Release to
+ * clean up the internal structure of a button at a safe time (when
+ * no-one is using it anymore).
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Everything associated with the scale is freed up.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+DestroyScale(
+ char *memPtr) /* Info about scale widget. */
+{
+ register TkScale *scalePtr = (TkScale *) memPtr;
+
+ scalePtr->flags |= SCALE_DELETED;
+
+ Tcl_DeleteCommandFromToken(scalePtr->interp, scalePtr->widgetCmd);
+ if (scalePtr->flags & REDRAW_PENDING) {
+ Tcl_CancelIdleCall(TkpDisplayScale, scalePtr);
+ }
+
+ /*
+ * Free up all the stuff that requires special handling, then let
+ * Tk_FreeOptions handle all the standard option-related stuff.
+ */
+
+ if (scalePtr->varNamePtr != NULL) {
+ Tcl_UntraceVar2(scalePtr->interp, Tcl_GetString(scalePtr->varNamePtr),
+ NULL, TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS,
+ ScaleVarProc, scalePtr);
+ }
+ if (scalePtr->troughGC != None) {
+ Tk_FreeGC(scalePtr->display, scalePtr->troughGC);
+ }
+ if (scalePtr->copyGC != None) {
+ Tk_FreeGC(scalePtr->display, scalePtr->copyGC);
+ }
+ if (scalePtr->textGC != None) {
+ Tk_FreeGC(scalePtr->display, scalePtr->textGC);
+ }
+ Tk_FreeConfigOptions((char *) scalePtr, scalePtr->optionTable,
+ scalePtr->tkwin);
+ scalePtr->tkwin = NULL;
+ TkpDestroyScale(scalePtr);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ConfigureScale --
+ *
+ * This procedure is called to process an argv/argc list, plus the Tk
+ * option database, in order to configure (or reconfigure) a scale
+ * widget.
+ *
+ * Results:
+ * The return value is a standard Tcl result. If TCL_ERROR is returned,
+ * then the interp's result contains an error message.
+ *
+ * Side effects:
+ * Configuration information, such as colors, border width, etc. get set
+ * for scalePtr; old resources get freed, if there were any.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+ConfigureScale(
+ Tcl_Interp *interp, /* Used for error reporting. */
+ register TkScale *scalePtr, /* Information about widget; may or may not
+ * already have values for some fields. */
+ int objc, /* Number of valid entries in objv. */
+ Tcl_Obj *const objv[]) /* Argument values. */
+{
+ Tk_SavedOptions savedOptions;
+ Tcl_Obj *errorResult = NULL;
+ int error;
+ double varValue;
+
+ /*
+ * Eliminate any existing trace on a variable monitored by the scale.
+ */
+
+ if (scalePtr->varNamePtr != NULL) {
+ Tcl_UntraceVar2(interp, Tcl_GetString(scalePtr->varNamePtr),
+ NULL, TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS,
+ ScaleVarProc, scalePtr);
+ }
+
+ for (error = 0; error <= 1; error++) {
+ if (!error) {
+ /*
+ * First pass: set options to new values.
+ */
+
+ if (Tk_SetOptions(interp, (char *) scalePtr,
+ scalePtr->optionTable, objc, objv, scalePtr->tkwin,
+ &savedOptions, NULL) != TCL_OK) {
+ continue;
+ }
+ } else {
+ /*
+ * Second pass: restore options to old values.
+ */
+
+ errorResult = Tcl_GetObjResult(interp);
+ Tcl_IncrRefCount(errorResult);
+ Tk_RestoreSavedOptions(&savedOptions);
+ }
+
+ /*
+ * If the scale is tied to the value of a variable, then set the
+ * scale's value from the value of the variable, if it exists and it
+ * holds a valid double value.
+ */
+
+ if (scalePtr->varNamePtr != NULL) {
+ double value;
+ Tcl_Obj *valuePtr;
+
+ valuePtr = Tcl_ObjGetVar2(interp, scalePtr->varNamePtr, NULL,
+ TCL_GLOBAL_ONLY);
+ if ((valuePtr != NULL) &&
+ (Tcl_GetDoubleFromObj(NULL, valuePtr, &value) == TCL_OK)) {
+ scalePtr->value = TkRoundToResolution(scalePtr, value);
+ }
+ }
+
+ /*
+ * Several options need special processing, such as parsing the
+ * orientation and creating GCs.
+ */
+
+ scalePtr->fromValue = TkRoundToResolution(scalePtr,
+ scalePtr->fromValue);
+ scalePtr->toValue = TkRoundToResolution(scalePtr, scalePtr->toValue);
+ scalePtr->tickInterval = TkRoundToResolution(scalePtr,
+ scalePtr->tickInterval);
+
+ /*
+ * Make sure that the tick interval has the right sign so that
+ * addition moves from fromValue to toValue.
+ */
+
+ if ((scalePtr->tickInterval < 0)
+ ^ ((scalePtr->toValue - scalePtr->fromValue) < 0)) {
+ scalePtr->tickInterval = -scalePtr->tickInterval;
+ }
+
+ ComputeFormat(scalePtr);
+
+ scalePtr->labelLength = scalePtr->label ? (int)strlen(scalePtr->label) : 0;
+
+ Tk_SetBackgroundFromBorder(scalePtr->tkwin, scalePtr->bgBorder);
+
+ if (scalePtr->highlightWidth < 0) {
+ scalePtr->highlightWidth = 0;
+ }
+ scalePtr->inset = scalePtr->highlightWidth + scalePtr->borderWidth;
+ break;
+ }
+ if (!error) {
+ Tk_FreeSavedOptions(&savedOptions);
+ }
+
+ /*
+ * Set the scale value to itself; all this does is to make sure that the
+ * scale's value is within the new acceptable range for the scale. We
+ * don't set the var here because we need to make special checks for
+ * possibly changed varNamePtr.
+ */
+
+ TkScaleSetValue(scalePtr, scalePtr->value, 0, 1);
+
+ /*
+ * Reestablish the variable trace, if it is needed.
+ */
+
+ if (scalePtr->varNamePtr != NULL) {
+ Tcl_Obj *valuePtr;
+
+ /*
+ * Set the associated variable only when the new value differs from
+ * the current value, or the variable doesn't yet exist.
+ */
+
+ valuePtr = Tcl_ObjGetVar2(interp, scalePtr->varNamePtr, NULL,
+ TCL_GLOBAL_ONLY);
+ if ((valuePtr == NULL) || (Tcl_GetDoubleFromObj(NULL,
+ valuePtr, &varValue) != TCL_OK)) {
+ ScaleSetVariable(scalePtr);
+ } else {
+ char varString[TCL_DOUBLE_SPACE], scaleString[TCL_DOUBLE_SPACE];
+
+ sprintf(varString, scalePtr->format, varValue);
+ sprintf(scaleString, scalePtr->format, scalePtr->value);
+ if (strcmp(varString, scaleString)) {
+ ScaleSetVariable(scalePtr);
+ }
+ }
+ Tcl_TraceVar2(interp, Tcl_GetString(scalePtr->varNamePtr),
+ NULL, TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS,
+ ScaleVarProc, scalePtr);
+ }
+
+ ScaleWorldChanged(scalePtr);
+ if (error) {
+ Tcl_SetObjResult(interp, errorResult);
+ Tcl_DecrRefCount(errorResult);
+ return TCL_ERROR;
+ }
+ return TCL_OK;
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * ScaleWorldChanged --
+ *
+ * This procedure is called when the world has changed in some way and
+ * the widget needs to recompute all its graphics contexts and determine
+ * its new geometry.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Scale will be relayed out and redisplayed.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+static void
+ScaleWorldChanged(
+ ClientData instanceData) /* Information about widget. */
+{
+ XGCValues gcValues;
+ GC gc;
+ TkScale *scalePtr = instanceData;
+
+ gcValues.foreground = scalePtr->troughColorPtr->pixel;
+ gc = Tk_GetGC(scalePtr->tkwin, GCForeground, &gcValues);
+ if (scalePtr->troughGC != None) {
+ Tk_FreeGC(scalePtr->display, scalePtr->troughGC);
+ }
+ scalePtr->troughGC = gc;
+
+ gcValues.font = Tk_FontId(scalePtr->tkfont);
+ gcValues.foreground = scalePtr->textColorPtr->pixel;
+ gc = Tk_GetGC(scalePtr->tkwin, GCForeground | GCFont, &gcValues);
+ if (scalePtr->textGC != None) {
+ Tk_FreeGC(scalePtr->display, scalePtr->textGC);
+ }
+ scalePtr->textGC = gc;
+
+ if (scalePtr->copyGC == None) {
+ gcValues.graphics_exposures = False;
+ scalePtr->copyGC = Tk_GetGC(scalePtr->tkwin, GCGraphicsExposures,
+ &gcValues);
+ }
+ scalePtr->inset = scalePtr->highlightWidth + scalePtr->borderWidth;
+
+ /*
+ * Recompute display-related information, and let the geometry manager
+ * know how much space is needed now.
+ */
+
+ ComputeScaleGeometry(scalePtr);
+
+ TkEventuallyRedrawScale(scalePtr, REDRAW_ALL);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ComputeFormat --
+ *
+ * This procedure is invoked to recompute the "format" field of a scale's
+ * widget record, which determines how the value of the scale is
+ * converted to a string.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The format field of scalePtr is modified.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+ComputeFormat(
+ TkScale *scalePtr) /* Information about scale widget. */
+{
+ double maxValue, x;
+ int mostSigDigit, numDigits, leastSigDigit, afterDecimal;
+ int eDigits, fDigits;
+
+ /*
+ * Compute the displacement from the decimal of the most significant digit
+ * required for any number in the scale's range.
+ */
+
+ maxValue = fabs(scalePtr->fromValue);
+ x = fabs(scalePtr->toValue);
+ if (x > maxValue) {
+ maxValue = x;
+ }
+ if (maxValue == 0) {
+ maxValue = 1;
+ }
+ mostSigDigit = (int) floor(log10(maxValue));
+
+ /*
+ * If the number of significant digits wasn't specified explicitly,
+ * compute it. It's the difference between the most significant digit
+ * needed to represent any number on the scale and the most significant
+ * digit of the smallest difference between numbers on the scale. In other
+ * words, display enough digits so that at least one digit will be
+ * different between any two adjacent positions of the scale.
+ */
+
+ numDigits = scalePtr->digits;
+ if (numDigits > TCL_MAX_PREC) {
+ numDigits = 0;
+ }
+ if (numDigits <= 0) {
+ if (scalePtr->resolution > 0) {
+ /*
+ * A resolution was specified for the scale, so just use it.
+ */
+
+ leastSigDigit = (int) floor(log10(scalePtr->resolution));
+ } else {
+ /*
+ * No resolution was specified, so compute the difference in value
+ * between adjacent pixels and use it for the least significant
+ * digit.
+ */
+
+ x = fabs(scalePtr->fromValue - scalePtr->toValue);
+ if (scalePtr->length > 0) {
+ x /= scalePtr->length;
+ }
+ if (x > 0){
+ leastSigDigit = (int) floor(log10(x));
+ } else {
+ leastSigDigit = 0;
+ }
+ }
+ numDigits = mostSigDigit - leastSigDigit + 1;
+ if (numDigits < 1) {
+ numDigits = 1;
+ }
+ }
+
+ /*
+ * Compute the number of characters required using "e" format and "f"
+ * format, and then choose whichever one takes fewer characters.
+ */
+
+ eDigits = numDigits + 4;
+ if (numDigits > 1) {
+ eDigits++; /* Decimal point. */
+ }
+ afterDecimal = numDigits - mostSigDigit - 1;
+ if (afterDecimal < 0) {
+ afterDecimal = 0;
+ }
+ fDigits = (mostSigDigit >= 0) ? mostSigDigit + afterDecimal : afterDecimal;
+ if (afterDecimal > 0) {
+ fDigits++; /* Decimal point. */
+ }
+ if (mostSigDigit < 0) {
+ fDigits++; /* Zero to left of decimal point. */
+ }
+ if (fDigits <= eDigits) {
+ sprintf(scalePtr->format, "%%.%df", afterDecimal);
+ } else {
+ sprintf(scalePtr->format, "%%.%de", numDigits-1);
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ComputeScaleGeometry --
+ *
+ * This procedure is called to compute various geometrical information
+ * for a scale, such as where various things get displayed. It's called
+ * when the window is reconfigured.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Display-related numbers get changed in *scalePtr. The geometry manager
+ * gets told about the window's preferred size.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+ComputeScaleGeometry(
+ register TkScale *scalePtr) /* Information about widget. */
+{
+ char valueString[TCL_DOUBLE_SPACE];
+ int tmp, valuePixels, x, y, extraSpace;
+ Tk_FontMetrics fm;
+
+ Tk_GetFontMetrics(scalePtr->tkfont, &fm);
+ scalePtr->fontHeight = fm.linespace + SPACING;
+
+ /*
+ * Horizontal scales are simpler than vertical ones because all sizes are
+ * the same (the height of a line of text); handle them first and then
+ * quit.
+ */
+
+ if (scalePtr->orient == ORIENT_HORIZONTAL) {
+ y = scalePtr->inset;
+ extraSpace = 0;
+ if (scalePtr->labelLength != 0) {
+ scalePtr->horizLabelY = y + SPACING;
+ y += scalePtr->fontHeight;
+ extraSpace = SPACING;
+ }
+ if (scalePtr->showValue) {
+ scalePtr->horizValueY = y + SPACING;
+ y += scalePtr->fontHeight;
+ extraSpace = SPACING;
+ } else {
+ scalePtr->horizValueY = y;
+ }
+ y += extraSpace;
+ scalePtr->horizTroughY = y;
+ y += scalePtr->width + 2*scalePtr->borderWidth;
+ if (scalePtr->tickInterval != 0) {
+ scalePtr->horizTickY = y + SPACING;
+ y += scalePtr->fontHeight + SPACING;
+ }
+ Tk_GeometryRequest(scalePtr->tkwin,
+ scalePtr->length + 2*scalePtr->inset, y + scalePtr->inset);
+ Tk_SetInternalBorder(scalePtr->tkwin, scalePtr->inset);
+ return;
+ }
+
+ /*
+ * Vertical scale: compute the amount of space needed to display the
+ * scales value by formatting strings for the two end points; use
+ * whichever length is longer.
+ */
+
+ sprintf(valueString, scalePtr->format, scalePtr->fromValue);
+ valuePixels = Tk_TextWidth(scalePtr->tkfont, valueString, -1);
+
+ sprintf(valueString, scalePtr->format, scalePtr->toValue);
+ tmp = Tk_TextWidth(scalePtr->tkfont, valueString, -1);
+ if (valuePixels < tmp) {
+ valuePixels = tmp;
+ }
+
+ /*
+ * Assign x-locations to the elements of the scale, working from left to
+ * right.
+ */
+
+ x = scalePtr->inset;
+ if ((scalePtr->tickInterval != 0) && (scalePtr->showValue)) {
+ scalePtr->vertTickRightX = x + SPACING + valuePixels;
+ scalePtr->vertValueRightX = scalePtr->vertTickRightX + valuePixels
+ + fm.ascent/2;
+ x = scalePtr->vertValueRightX + SPACING;
+ } else if (scalePtr->tickInterval != 0) {
+ scalePtr->vertTickRightX = x + SPACING + valuePixels;
+ scalePtr->vertValueRightX = scalePtr->vertTickRightX;
+ x = scalePtr->vertTickRightX + SPACING;
+ } else if (scalePtr->showValue) {
+ scalePtr->vertTickRightX = x;
+ scalePtr->vertValueRightX = x + SPACING + valuePixels;
+ x = scalePtr->vertValueRightX + SPACING;
+ } else {
+ scalePtr->vertTickRightX = x;
+ scalePtr->vertValueRightX = x;
+ }
+ scalePtr->vertTroughX = x;
+ x += 2*scalePtr->borderWidth + scalePtr->width;
+ if (scalePtr->labelLength == 0) {
+ scalePtr->vertLabelX = 0;
+ } else {
+ scalePtr->vertLabelX = x + fm.ascent/2;
+ x = scalePtr->vertLabelX + fm.ascent/2
+ + Tk_TextWidth(scalePtr->tkfont, scalePtr->label,
+ scalePtr->labelLength);
+ }
+ Tk_GeometryRequest(scalePtr->tkwin, x + scalePtr->inset,
+ scalePtr->length + 2*scalePtr->inset);
+ Tk_SetInternalBorder(scalePtr->tkwin, scalePtr->inset);
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * ScaleEventProc --
+ *
+ * This procedure is invoked by the Tk dispatcher for various events on
+ * scales.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * When the window gets deleted, internal structures get cleaned up.
+ * When it gets exposed, it is redisplayed.
+ *
+ *--------------------------------------------------------------
+ */
+
+static void
+ScaleEventProc(
+ ClientData clientData, /* Information about window. */
+ XEvent *eventPtr) /* Information about event. */
+{
+ TkScale *scalePtr = clientData;
+
+ if ((eventPtr->type == Expose) && (eventPtr->xexpose.count == 0)) {
+ TkEventuallyRedrawScale(scalePtr, REDRAW_ALL);
+ } else if (eventPtr->type == DestroyNotify) {
+ DestroyScale(clientData);
+ } else if (eventPtr->type == ConfigureNotify) {
+ ComputeScaleGeometry(scalePtr);
+ TkEventuallyRedrawScale(scalePtr, REDRAW_ALL);
+ } else if (eventPtr->type == FocusIn) {
+ if (eventPtr->xfocus.detail != NotifyInferior) {
+ scalePtr->flags |= GOT_FOCUS;
+ if (scalePtr->highlightWidth > 0) {
+ TkEventuallyRedrawScale(scalePtr, REDRAW_ALL);
+ }
+ }
+ } else if (eventPtr->type == FocusOut) {
+ if (eventPtr->xfocus.detail != NotifyInferior) {
+ scalePtr->flags &= ~GOT_FOCUS;
+ if (scalePtr->highlightWidth > 0) {
+ TkEventuallyRedrawScale(scalePtr, REDRAW_ALL);
+ }
+ }
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ScaleCmdDeletedProc --
+ *
+ * This procedure is invoked when a widget command is deleted. If the
+ * widget isn't already in the process of being destroyed, this command
+ * destroys it.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The widget is destroyed.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+ScaleCmdDeletedProc(
+ ClientData clientData) /* Pointer to widget record for widget. */
+{
+ TkScale *scalePtr = clientData;
+ Tk_Window tkwin = scalePtr->tkwin;
+
+ /*
+ * This procedure could be invoked either because the window was destroyed
+ * and the command was then deleted (in which case tkwin is NULL) or
+ * because the command was deleted, and then this procedure destroys the
+ * widget.
+ */
+
+ if (!(scalePtr->flags & SCALE_DELETED)) {
+ scalePtr->flags |= SCALE_DELETED;
+ Tk_DestroyWindow(tkwin);
+ }
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * TkEventuallyRedrawScale --
+ *
+ * Arrange for part or all of a scale widget to redrawn at the next
+ * convenient time in the future.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * If "what" is REDRAW_SLIDER then just the slider and the value readout
+ * will be redrawn; if "what" is REDRAW_ALL then the entire widget will
+ * be redrawn.
+ *
+ *--------------------------------------------------------------
+ */
+
+void
+TkEventuallyRedrawScale(
+ register TkScale *scalePtr, /* Information about widget. */
+ int what) /* What to redraw: REDRAW_SLIDER or
+ * REDRAW_ALL. */
+{
+ if ((what == 0) || (scalePtr->tkwin == NULL)
+ || !Tk_IsMapped(scalePtr->tkwin)) {
+ return;
+ }
+ if (!(scalePtr->flags & REDRAW_PENDING)) {
+ scalePtr->flags |= REDRAW_PENDING;
+ Tcl_DoWhenIdle(TkpDisplayScale, scalePtr);
+ }
+ scalePtr->flags |= what;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * TkRoundToResolution --
+ *
+ * Round a given floating-point value to the nearest multiple of the
+ * scale's resolution.
+ *
+ * Results:
+ * The return value is the rounded result.
+ *
+ * Side effects:
+ * None.
+ *
+ *--------------------------------------------------------------
+ */
+
+double
+TkRoundToResolution(
+ TkScale *scalePtr, /* Information about scale widget. */
+ double value) /* Value to round. */
+{
+ double rem, rounded, tick;
+
+ if (scalePtr->resolution <= 0) {
+ return value;
+ }
+ tick = floor(value/scalePtr->resolution);
+ rounded = scalePtr->resolution * tick;
+ rem = value - rounded;
+ if (rem < 0) {
+ if (rem <= -scalePtr->resolution/2) {
+ rounded = (tick - 1.0) * scalePtr->resolution;
+ }
+ } else {
+ if (rem >= scalePtr->resolution/2) {
+ rounded = (tick + 1.0) * scalePtr->resolution;
+ }
+ }
+ return rounded;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ScaleVarProc --
+ *
+ * This procedure is invoked by Tcl whenever someone modifies a variable
+ * associated with a scale widget.
+ *
+ * Results:
+ * NULL is always returned.
+ *
+ * Side effects:
+ * The value displayed in the scale will change to match the variable's
+ * new value. If the variable has a bogus value then it is reset to the
+ * value of the scale.
+ *
+ *----------------------------------------------------------------------
+ */
+
+ /* ARGSUSED */
+static char *
+ScaleVarProc(
+ ClientData clientData, /* Information about button. */
+ Tcl_Interp *interp, /* Interpreter containing variable. */
+ const char *name1, /* Name of variable. */
+ const char *name2, /* Second part of variable name. */
+ int flags) /* Information about what happened. */
+{
+ register TkScale *scalePtr = clientData;
+ const char *resultStr;
+ double value;
+ Tcl_Obj *valuePtr;
+ int result;
+
+ /*
+ * If the variable is unset, then immediately recreate it unless the whole
+ * interpreter is going away.
+ */
+
+ if (flags & TCL_TRACE_UNSETS) {
+ if ((flags & TCL_TRACE_DESTROYED) && !(flags & TCL_INTERP_DESTROYED)) {
+ Tcl_TraceVar2(interp, Tcl_GetString(scalePtr->varNamePtr),
+ NULL, TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS,
+ ScaleVarProc, clientData);
+ scalePtr->flags |= NEVER_SET;
+ TkScaleSetValue(scalePtr, scalePtr->value, 1, 0);
+ }
+ return NULL;
+ }
+
+ /*
+ * If we came here because we updated the variable (in TkScaleSetValue),
+ * then ignore the trace. Otherwise update the scale with the value of the
+ * variable.
+ */
+
+ if (scalePtr->flags & SETTING_VAR) {
+ return NULL;
+ }
+ resultStr = NULL;
+ valuePtr = Tcl_ObjGetVar2(interp, scalePtr->varNamePtr, NULL,
+ TCL_GLOBAL_ONLY);
+ result = Tcl_GetDoubleFromObj(interp, valuePtr, &value);
+ if (result != TCL_OK) {
+ resultStr = "can't assign non-numeric value to scale variable";
+ ScaleSetVariable(scalePtr);
+ } else {
+ scalePtr->value = TkRoundToResolution(scalePtr, value);
+
+ /*
+ * This code is a bit tricky because it sets the scale's value before
+ * calling TkScaleSetValue. This way, TkScaleSetValue won't bother to
+ * set the variable again or to invoke the -command. However, it also
+ * won't redisplay the scale, so we have to ask for that explicitly.
+ */
+
+ TkScaleSetValue(scalePtr, scalePtr->value, 1, 0);
+ }
+ TkEventuallyRedrawScale(scalePtr, REDRAW_SLIDER);
+
+ return (char *) 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(
+ 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;
+
+ /*
+ * Schedule command callback invocation only if there is such a command
+ * already registered, otherwise the callback would trigger later when
+ * configuring the widget -command option even if the value did not change.
+ */
+
+ if ((invokeCommand) && (scalePtr->command != NULL)) {
+ 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(
+ register TkScale *scalePtr) /* Info about widget. */
+{
+ if (scalePtr->varNamePtr != NULL) {
+ char string[TCL_DOUBLE_SPACE];
+
+ 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(
+ register TkScale *scalePtr, /* Information about widget. */
+ int x, int 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(
+ 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;
+}
+
+/*
+ * Local Variables:
+ * mode: c
+ * c-basic-offset: 4
+ * fill-column: 78
+ * End:
+ */
diff --git a/tk8.6/generic/tkScale.h b/tk8.6/generic/tkScale.h
new file mode 100644
index 0000000..4fd9995
--- /dev/null
+++ b/tk8.6/generic/tkScale.h
@@ -0,0 +1,232 @@
+/*
+ * tkScale.h --
+ *
+ * Declarations of types and functions used to implement the scale
+ * widget.
+ *
+ * Copyright (c) 1996 by Sun Microsystems, Inc.
+ * Copyright (c) 1999-2000 by Scriptics Corporation.
+ *
+ * See the file "license.terms" for information on usage and redistribution of
+ * this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ */
+
+#ifndef _TKSCALE
+#define _TKSCALE
+
+#ifndef _TKINT
+#include "tkInt.h"
+#endif
+
+/*
+ * Legal values for the "orient" field of TkScale records.
+ */
+
+enum orient {
+ ORIENT_HORIZONTAL, ORIENT_VERTICAL
+};
+
+/*
+ * Legal values for the "state" field of TkScale records.
+ */
+
+enum state {
+ STATE_ACTIVE, STATE_DISABLED, STATE_NORMAL
+};
+
+/*
+ * A data structure of the following type is kept for each scale widget
+ * managed by this file:
+ */
+
+typedef struct TkScale {
+ Tk_Window tkwin; /* Window that embodies the scale. NULL means
+ * that the window has been destroyed but the
+ * data structures haven't yet been cleaned
+ * up.*/
+ Display *display; /* Display containing widget. Used, among
+ * other things, so that resources can be
+ * freed even after tkwin has gone away. */
+ Tcl_Interp *interp; /* Interpreter associated with scale. */
+ Tcl_Command widgetCmd; /* Token for scale's widget command. */
+ Tk_OptionTable optionTable; /* Table that defines configuration options
+ * available for this widget. */
+ enum orient orient; /* Orientation for window (vertical or
+ * horizontal). */
+ int width; /* Desired narrow dimension of scale, in
+ * pixels. */
+ int length; /* Desired long dimension of scale, in
+ * pixels. */
+ double value; /* Current value of scale. */
+ Tcl_Obj *varNamePtr; /* Name of variable or NULL. If non-NULL,
+ * scale's value tracks the contents of this
+ * variable and vice versa. */
+ double fromValue; /* Value corresponding to left or top of
+ * scale. */
+ double toValue; /* Value corresponding to right or bottom of
+ * scale. */
+ double tickInterval; /* Distance between tick marks; 0 means don't
+ * display any tick marks. */
+ double resolution; /* If > 0, all values are rounded to an even
+ * multiple of this value. */
+ int digits; /* Number of significant digits to print in
+ * values. 0 means we get to choose the number
+ * based on resolution and/or the range of the
+ * scale. */
+ char format[10]; /* Sprintf conversion specifier computed from
+ * digits and other information. */
+ double bigIncrement; /* Amount to use for large increments to scale
+ * value. (0 means we pick a value). */
+ char *command; /* Command prefix to use when invoking Tcl
+ * commands because the scale value changed.
+ * NULL means don't invoke commands. */
+ int repeatDelay; /* How long to wait before auto-repeating on
+ * scrolling actions (in ms). */
+ int repeatInterval; /* Interval between autorepeats (in ms). */
+ char *label; /* Label to display above or to right of
+ * scale; NULL means don't display a label. */
+ int labelLength; /* Number of non-NULL chars. in label. */
+ enum state state; /* Values are active, normal, or disabled.
+ * Value of scale cannot be changed when
+ * disabled. */
+
+ /*
+ * Information used when displaying widget:
+ */
+
+ int borderWidth; /* Width of 3-D border around window. */
+ Tk_3DBorder bgBorder; /* Used for drawing slider and other
+ * background areas. */
+ Tk_3DBorder activeBorder; /* For drawing the slider when active. */
+ int sliderRelief; /* Is slider to be drawn raised, sunken,
+ * etc. */
+ XColor *troughColorPtr; /* Color for drawing trough. */
+ GC troughGC; /* For drawing trough. */
+ GC copyGC; /* Used for copying from pixmap onto screen */
+ Tk_Font tkfont; /* Information about text font, or NULL. */
+ XColor *textColorPtr; /* Color for drawing text. */
+ GC textGC; /* GC for drawing text in normal mode. */
+ int relief; /* Indicates whether window as a whole is
+ * raised, sunken, or flat. */
+ int highlightWidth; /* Width in pixels of highlight to draw around
+ * widget when it has the focus. <= 0 means
+ * don't draw a highlight. */
+ Tk_3DBorder highlightBorder;/* Value of -highlightbackground option:
+ * specifies background with which to draw 3-D
+ * default ring and focus highlight area when
+ * highlight is off. */
+ XColor *highlightColorPtr; /* Color for drawing traversal highlight. */
+ int inset; /* Total width of all borders, including
+ * traversal highlight and 3-D border.
+ * Indicates how much interior stuff must be
+ * offset from outside edges to leave room for
+ * borders. */
+ int sliderLength; /* Length of slider, measured in pixels along
+ * long dimension of scale. */
+ int showValue; /* Non-zero means to display the scale value
+ * below or to the left of the slider; zero
+ * means don't display the value. */
+
+ /*
+ * Layout information for horizontal scales, assuming that window gets the
+ * size it requested:
+ */
+
+ int horizLabelY; /* Y-coord at which to draw label. */
+ int horizValueY; /* Y-coord at which to draw value text. */
+ int horizTroughY; /* Y-coord of top of slider trough. */
+ int horizTickY; /* Y-coord at which to draw tick text. */
+ /*
+ * Layout information for vertical scales, assuming that window gets the
+ * size it requested:
+ */
+
+ int vertTickRightX; /* X-location of right side of tick-marks. */
+ int vertValueRightX; /* X-location of right side of value string. */
+ int vertTroughX; /* X-location of scale's slider trough. */
+ int vertLabelX; /* X-location of origin of label. */
+
+ /*
+ * Miscellaneous information:
+ */
+
+ int fontHeight; /* Height of scale font. */
+ Tk_Cursor cursor; /* Current cursor for window, or None. */
+ Tcl_Obj *takeFocusPtr; /* Value of -takefocus option; not used in the
+ * C code, but used by keyboard traversal
+ * scripts. May be NULL. */
+ int flags; /* Various flags; see below for
+ * definitions. */
+} TkScale;
+
+/*
+ * Flag bits for scales:
+ *
+ * REDRAW_SLIDER - 1 means slider (and numerical readout) need to
+ * be redrawn.
+ * REDRAW_OTHER - 1 means other stuff besides slider and value
+ * need to be redrawn.
+ * REDRAW_ALL - 1 means the entire widget needs to be redrawn.
+ * REDRAW_PENDING - 1 means any sort of redraw is pending
+ * ACTIVE - 1 means the widget is active (the mouse is in
+ * its window).
+ * INVOKE_COMMAND - 1 means the scale's command needs to be
+ * invoked during the next redisplay (the value
+ * of the scale has changed since the last time
+ * the command was invoked).
+ * SETTING_VAR - 1 means that the associated variable is being
+ * set by us, so there's no need for ScaleVarProc
+ * to do anything.
+ * NEVER_SET - 1 means that the scale's value has never been
+ * set before (so must invoke -command and set
+ * associated variable even if the value doesn't
+ * appear to have changed).
+ * GOT_FOCUS - 1 means that the focus is currently in this
+ * widget.
+ * SCALE_DELETED - 1 means the scale widget is being deleted
+ */
+
+#define REDRAW_SLIDER (1<<0)
+#define REDRAW_OTHER (1<<1)
+#define REDRAW_ALL (REDRAW_OTHER|REDRAW_SLIDER)
+#define REDRAW_PENDING (1<<2)
+#define ACTIVE (1<<3)
+#define INVOKE_COMMAND (1<<4)
+#define SETTING_VAR (1<<5)
+#define NEVER_SET (1<<6)
+#define GOT_FOCUS (1<<7)
+#define SCALE_DELETED (1<<8)
+
+/*
+ * Symbolic values for the active parts of a slider. These are the values that
+ * may be returned by the ScaleElement procedure.
+ */
+
+#define OTHER 0
+#define TROUGH1 1
+#define SLIDER 2
+#define TROUGH2 3
+
+/*
+ * Space to leave between scale area and text, and between text and edge of
+ * window.
+ */
+
+#define SPACING 2
+
+/*
+ * Declaration of procedures used in the implementation of the scale widget.
+ */
+
+MODULE_SCOPE void TkEventuallyRedrawScale(TkScale *scalePtr, int what);
+MODULE_SCOPE double TkRoundToResolution(TkScale *scalePtr, double value);
+MODULE_SCOPE TkScale * TkpCreateScale(Tk_Window tkwin);
+MODULE_SCOPE void TkpDestroyScale(TkScale *scalePtr);
+MODULE_SCOPE void TkpDisplayScale(ClientData clientData);
+MODULE_SCOPE int TkpScaleElement(TkScale *scalePtr, int x, int y);
+MODULE_SCOPE void TkScaleSetValue(TkScale *scalePtr, double value,
+ int setVar, int invokeCommand);
+MODULE_SCOPE double TkScalePixelToValue(TkScale *scalePtr, int x, int y);
+MODULE_SCOPE int TkScaleValueToPixel(TkScale *scalePtr, double value);
+
+#endif /* _TKSCALE */
diff --git a/tk8.6/generic/tkScrollbar.c b/tk8.6/generic/tkScrollbar.c
new file mode 100644
index 0000000..5017d30
--- /dev/null
+++ b/tk8.6/generic/tkScrollbar.c
@@ -0,0 +1,703 @@
+/*
+ * tkScrollbar.c --
+ *
+ * This module implements a scrollbar widgets for the Tk toolkit. A
+ * scrollbar displays a slider and two arrows; mouse clicks on features
+ * within the scrollbar cause scrolling commands to be invoked.
+ *
+ * Copyright (c) 1990-1994 The Regents of the University of California.
+ * Copyright (c) 1994-1997 Sun Microsystems, Inc.
+ *
+ * See the file "license.terms" for information on usage and redistribution of
+ * this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ */
+
+#include "tkInt.h"
+#include "tkScrollbar.h"
+#include "default.h"
+
+/*
+ * Custom option for handling "-orient"
+ */
+
+static const Tk_CustomOption orientOption = {
+ TkOrientParseProc, TkOrientPrintProc, NULL
+};
+
+/* non-const space for "-width" default value for scrollbars */
+char tkDefScrollbarWidth[TCL_INTEGER_SPACE] = DEF_SCROLLBAR_WIDTH;
+
+/*
+ * Information used for argv parsing.
+ */
+
+static const Tk_ConfigSpec configSpecs[] = {
+ {TK_CONFIG_BORDER, "-activebackground", "activeBackground", "Foreground",
+ DEF_SCROLLBAR_ACTIVE_BG_COLOR, Tk_Offset(TkScrollbar, activeBorder),
+ TK_CONFIG_COLOR_ONLY, NULL},
+ {TK_CONFIG_BORDER, "-activebackground", "activeBackground", "Foreground",
+ DEF_SCROLLBAR_ACTIVE_BG_MONO, Tk_Offset(TkScrollbar, activeBorder),
+ TK_CONFIG_MONO_ONLY, NULL},
+ {TK_CONFIG_RELIEF, "-activerelief", "activeRelief", "Relief",
+ DEF_SCROLLBAR_ACTIVE_RELIEF, Tk_Offset(TkScrollbar, activeRelief), 0, NULL},
+ {TK_CONFIG_BORDER, "-background", "background", "Background",
+ DEF_SCROLLBAR_BG_COLOR, Tk_Offset(TkScrollbar, bgBorder),
+ TK_CONFIG_COLOR_ONLY, NULL},
+ {TK_CONFIG_BORDER, "-background", "background", "Background",
+ DEF_SCROLLBAR_BG_MONO, Tk_Offset(TkScrollbar, bgBorder),
+ TK_CONFIG_MONO_ONLY, NULL},
+ {TK_CONFIG_SYNONYM, "-bd", "borderWidth", NULL, NULL, 0, 0, NULL},
+ {TK_CONFIG_SYNONYM, "-bg", "background", NULL, NULL, 0, 0, NULL},
+ {TK_CONFIG_PIXELS, "-borderwidth", "borderWidth", "BorderWidth",
+ DEF_SCROLLBAR_BORDER_WIDTH, Tk_Offset(TkScrollbar, borderWidth), 0, NULL},
+ {TK_CONFIG_STRING, "-command", "command", "Command",
+ DEF_SCROLLBAR_COMMAND, Tk_Offset(TkScrollbar, command),
+ TK_CONFIG_NULL_OK, NULL},
+ {TK_CONFIG_ACTIVE_CURSOR, "-cursor", "cursor", "Cursor",
+ DEF_SCROLLBAR_CURSOR, Tk_Offset(TkScrollbar, cursor), TK_CONFIG_NULL_OK, NULL},
+ {TK_CONFIG_PIXELS, "-elementborderwidth", "elementBorderWidth",
+ "BorderWidth", DEF_SCROLLBAR_EL_BORDER_WIDTH,
+ Tk_Offset(TkScrollbar, elementBorderWidth), 0, NULL},
+ {TK_CONFIG_COLOR, "-highlightbackground", "highlightBackground",
+ "HighlightBackground", DEF_SCROLLBAR_HIGHLIGHT_BG,
+ Tk_Offset(TkScrollbar, highlightBgColorPtr), 0, NULL},
+ {TK_CONFIG_COLOR, "-highlightcolor", "highlightColor", "HighlightColor",
+ DEF_SCROLLBAR_HIGHLIGHT,
+ Tk_Offset(TkScrollbar, highlightColorPtr), 0, NULL},
+ {TK_CONFIG_PIXELS, "-highlightthickness", "highlightThickness",
+ "HighlightThickness",
+ DEF_SCROLLBAR_HIGHLIGHT_WIDTH, Tk_Offset(TkScrollbar, highlightWidth), 0, NULL},
+ {TK_CONFIG_BOOLEAN, "-jump", "jump", "Jump",
+ DEF_SCROLLBAR_JUMP, Tk_Offset(TkScrollbar, jump), 0, NULL},
+ {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, NULL},
+ {TK_CONFIG_INT, "-repeatdelay", "repeatDelay", "RepeatDelay",
+ DEF_SCROLLBAR_REPEAT_DELAY, Tk_Offset(TkScrollbar, repeatDelay), 0, NULL},
+ {TK_CONFIG_INT, "-repeatinterval", "repeatInterval", "RepeatInterval",
+ DEF_SCROLLBAR_REPEAT_INTERVAL, Tk_Offset(TkScrollbar, repeatInterval), 0, NULL},
+ {TK_CONFIG_STRING, "-takefocus", "takeFocus", "TakeFocus",
+ DEF_SCROLLBAR_TAKE_FOCUS, Tk_Offset(TkScrollbar, takeFocus),
+ TK_CONFIG_NULL_OK, NULL},
+ {TK_CONFIG_COLOR, "-troughcolor", "troughColor", "Background",
+ DEF_SCROLLBAR_TROUGH_COLOR, Tk_Offset(TkScrollbar, troughColorPtr),
+ TK_CONFIG_COLOR_ONLY, NULL},
+ {TK_CONFIG_COLOR, "-troughcolor", "troughColor", "Background",
+ DEF_SCROLLBAR_TROUGH_MONO, Tk_Offset(TkScrollbar, troughColorPtr),
+ TK_CONFIG_MONO_ONLY, NULL},
+ {TK_CONFIG_PIXELS, "-width", "width", "Width",
+ tkDefScrollbarWidth, Tk_Offset(TkScrollbar, width), 0, NULL},
+ {TK_CONFIG_END, NULL, NULL, NULL, NULL, 0, 0, NULL}
+};
+
+/*
+ * Forward declarations for functions defined later in this file:
+ */
+
+static int ConfigureScrollbar(Tcl_Interp *interp,
+ TkScrollbar *scrollPtr, int objc,
+ Tcl_Obj *const objv[], int flags);
+static void ScrollbarCmdDeletedProc(ClientData clientData);
+static int ScrollbarWidgetObjCmd(ClientData clientData,
+ Tcl_Interp *, int objc, Tcl_Obj *const objv[]);
+
+/*
+ *--------------------------------------------------------------
+ *
+ * Tk_ScrollbarObjCmd --
+ *
+ * This function 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_ScrollbarObjCmd(
+ ClientData clientData, /* Main window associated with interpreter. */
+ Tcl_Interp *interp, /* Current interpreter. */
+ int objc, /* Number of arguments. */
+ Tcl_Obj *const objv[]) /* Argument strings. */
+{
+ Tk_Window tkwin = clientData;
+ register TkScrollbar *scrollPtr;
+ Tk_Window newWin;
+
+ if (objc < 2) {
+ Tcl_WrongNumArgs(interp, 1, objv, "pathName ?-option value ...?");
+ return TCL_ERROR;
+ }
+
+ newWin = Tk_CreateWindowFromPath(interp, tkwin, Tcl_GetString(objv[1]), NULL);
+ if (newWin == NULL) {
+ return TCL_ERROR;
+ }
+
+ Tk_SetClass(newWin, "Scrollbar");
+ scrollPtr = TkpCreateScrollbar(newWin);
+
+ Tk_SetClassProcs(newWin, &tkpScrollbarProcs, scrollPtr);
+
+ /*
+ * Initialize fields that won't be initialized by ConfigureScrollbar, or
+ * which ConfigureScrollbar expects to have reasonable values (e.g.
+ * resource pointers).
+ */
+
+ scrollPtr->tkwin = newWin;
+ scrollPtr->display = Tk_Display(newWin);
+ scrollPtr->interp = interp;
+ scrollPtr->widgetCmd = Tcl_CreateObjCommand(interp,
+ Tk_PathName(scrollPtr->tkwin), ScrollbarWidgetObjCmd,
+ scrollPtr, ScrollbarCmdDeletedProc);
+ scrollPtr->vertical = 0;
+ scrollPtr->width = 0;
+ scrollPtr->command = NULL;
+ scrollPtr->commandSize = 0;
+ scrollPtr->repeatDelay = 0;
+ scrollPtr->repeatInterval = 0;
+ scrollPtr->borderWidth = 0;
+ scrollPtr->bgBorder = NULL;
+ scrollPtr->activeBorder = NULL;
+ scrollPtr->troughColorPtr = NULL;
+ scrollPtr->relief = TK_RELIEF_FLAT;
+ scrollPtr->highlightWidth = 0;
+ scrollPtr->highlightBgColorPtr = NULL;
+ scrollPtr->highlightColorPtr = NULL;
+ scrollPtr->inset = 0;
+ scrollPtr->elementBorderWidth = -1;
+ scrollPtr->arrowLength = 0;
+ scrollPtr->sliderFirst = 0;
+ scrollPtr->sliderLast = 0;
+ scrollPtr->activeField = 0;
+ scrollPtr->activeRelief = TK_RELIEF_RAISED;
+ scrollPtr->totalUnits = 0;
+ scrollPtr->windowUnits = 0;
+ scrollPtr->firstUnit = 0;
+ scrollPtr->lastUnit = 0;
+ scrollPtr->firstFraction = 0.0;
+ scrollPtr->lastFraction = 0.0;
+ scrollPtr->cursor = None;
+ scrollPtr->takeFocus = NULL;
+ scrollPtr->flags = 0;
+
+ if (ConfigureScrollbar(interp, scrollPtr, objc-2, objv+2, 0) != TCL_OK) {
+ Tk_DestroyWindow(scrollPtr->tkwin);
+ return TCL_ERROR;
+ }
+
+ Tcl_SetObjResult(interp, TkNewWindowObj(scrollPtr->tkwin));
+ return TCL_OK;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * ScrollbarWidgetObjCmd --
+ *
+ * This function 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
+ScrollbarWidgetObjCmd(
+ ClientData clientData, /* Information about scrollbar widget. */
+ Tcl_Interp *interp, /* Current interpreter. */
+ int objc, /* Number of arguments. */
+ Tcl_Obj *const objv[]) /* Argument strings. */
+{
+ register TkScrollbar *scrollPtr = clientData;
+ int result = TCL_OK;
+ int length, cmdIndex;
+ static const char *const commandNames[] = {
+ "activate", "cget", "configure", "delta", "fraction",
+ "get", "identify", "set", NULL
+ };
+ enum command {
+ COMMAND_ACTIVATE, COMMAND_CGET, COMMAND_CONFIGURE, COMMAND_DELTA,
+ COMMAND_FRACTION, COMMAND_GET, COMMAND_IDENTIFY, COMMAND_SET
+ };
+
+ if (objc < 2) {
+ Tcl_WrongNumArgs(interp, 1, objv, "option ?arg ...?");
+ return TCL_ERROR;
+ }
+ /*
+ * Parse the command by looking up the second argument in the list of
+ * valid subcommand names
+ */
+
+ result = Tcl_GetIndexFromObj(interp, objv[1], commandNames,
+ "option", 0, &cmdIndex);
+ if (result != TCL_OK) {
+ return result;
+ }
+ Tcl_Preserve(scrollPtr);
+ switch (cmdIndex) {
+ case COMMAND_ACTIVATE: {
+ int oldActiveField, c;
+
+ if (objc == 2) {
+ const char *zone = "";
+
+ switch (scrollPtr->activeField) {
+ case TOP_ARROW: zone = "arrow1"; break;
+ case SLIDER: zone = "slider"; break;
+ case BOTTOM_ARROW: zone = "arrow2"; break;
+ }
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(zone, -1));
+ goto done;
+ }
+ if (objc != 3) {
+ Tcl_WrongNumArgs(interp, 1, objv, "activate element");
+ goto error;
+ }
+ c = Tcl_GetStringFromObj(objv[2], &length)[0];
+ oldActiveField = scrollPtr->activeField;
+ if ((c == 'a') && (strcmp(Tcl_GetString(objv[2]), "arrow1") == 0)) {
+ scrollPtr->activeField = TOP_ARROW;
+ } else if ((c == 'a') && (strcmp(Tcl_GetString(objv[2]), "arrow2") == 0)) {
+ scrollPtr->activeField = BOTTOM_ARROW;
+ } else if ((c == 's') && (strncmp(Tcl_GetString(objv[2]), "slider", length) == 0)) {
+ scrollPtr->activeField = SLIDER;
+ } else {
+ scrollPtr->activeField = OUTSIDE;
+ }
+ if (oldActiveField != scrollPtr->activeField) {
+ TkScrollbarEventuallyRedraw(scrollPtr);
+ }
+ break;
+ }
+ case COMMAND_CGET: {
+ if (objc != 3) {
+ Tcl_WrongNumArgs(interp, 1, objv, "cget option");
+ goto error;
+ }
+ result = Tk_ConfigureValue(interp, scrollPtr->tkwin,
+ configSpecs, (char *) scrollPtr, Tcl_GetString(objv[2]), 0);
+ break;
+ }
+ case COMMAND_CONFIGURE: {
+ if (objc == 2) {
+ result = Tk_ConfigureInfo(interp, scrollPtr->tkwin,
+ configSpecs, (char *) scrollPtr, NULL, 0);
+ } else if (objc == 3) {
+ result = Tk_ConfigureInfo(interp, scrollPtr->tkwin,
+ configSpecs, (char *) scrollPtr, Tcl_GetString(objv[2]), 0);
+ } else {
+ result = ConfigureScrollbar(interp, scrollPtr, objc-2,
+ objv+2, TK_CONFIG_ARGV_ONLY);
+ }
+ break;
+ }
+ case COMMAND_DELTA: {
+ int xDelta, yDelta, pixels, length;
+ double fraction;
+
+ if (objc != 4) {
+ Tcl_WrongNumArgs(interp, 1, objv, "delta xDelta yDelta");
+ goto error;
+ }
+ if ((Tcl_GetIntFromObj(interp, objv[2], &xDelta) != TCL_OK)
+ || (Tcl_GetIntFromObj(interp, objv[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);
+ }
+ Tcl_SetObjResult(interp, Tcl_NewDoubleObj(fraction));
+ break;
+ }
+ case COMMAND_FRACTION: {
+ int x, y, pos, length;
+ double fraction;
+
+ if (objc != 4) {
+ Tcl_WrongNumArgs(interp, 1, objv, "fraction x y");
+ goto error;
+ }
+ if ((Tcl_GetIntFromObj(interp, objv[2], &x) != TCL_OK)
+ || (Tcl_GetIntFromObj(interp, objv[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;
+ }
+ Tcl_SetObjResult(interp, Tcl_NewDoubleObj(fraction));
+ break;
+ }
+ case COMMAND_GET: {
+ Tcl_Obj *resObjs[4];
+
+ if (objc != 2) {
+ Tcl_WrongNumArgs(interp, 1, objv, "get");
+ goto error;
+ }
+ if (scrollPtr->flags & NEW_STYLE_COMMANDS) {
+ resObjs[0] = Tcl_NewDoubleObj(scrollPtr->firstFraction);
+ resObjs[1] = Tcl_NewDoubleObj(scrollPtr->lastFraction);
+ Tcl_SetObjResult(interp, Tcl_NewListObj(2, resObjs));
+ } else {
+ resObjs[0] = Tcl_NewIntObj(scrollPtr->totalUnits);
+ resObjs[1] = Tcl_NewIntObj(scrollPtr->windowUnits);
+ resObjs[2] = Tcl_NewIntObj(scrollPtr->firstUnit);
+ resObjs[3] = Tcl_NewIntObj(scrollPtr->lastUnit);
+ Tcl_SetObjResult(interp, Tcl_NewListObj(4, resObjs));
+ }
+ break;
+ }
+ case COMMAND_IDENTIFY: {
+ int x, y;
+ const char *zone = "";
+
+ 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;
+ }
+ switch (TkpScrollbarPosition(scrollPtr, x, y)) {
+ case TOP_ARROW: zone = "arrow1"; break;
+ case TOP_GAP: zone = "trough1"; break;
+ case SLIDER: zone = "slider"; break;
+ case BOTTOM_GAP: zone = "trough2"; break;
+ case BOTTOM_ARROW: zone = "arrow2"; break;
+ }
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(zone, -1));
+ break;
+ }
+ case COMMAND_SET: {
+ int totalUnits, windowUnits, firstUnit, lastUnit;
+
+ if (objc == 4) {
+ double first, last;
+
+ if (Tcl_GetDoubleFromObj(interp, objv[2], &first) != TCL_OK) {
+ goto error;
+ }
+ if (Tcl_GetDoubleFromObj(interp, objv[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 (objc == 6) {
+ if (Tcl_GetIntFromObj(interp, objv[2], &totalUnits) != TCL_OK) {
+ goto error;
+ }
+ if (totalUnits < 0) {
+ totalUnits = 0;
+ }
+ if (Tcl_GetIntFromObj(interp, objv[3], &windowUnits) != TCL_OK) {
+ goto error;
+ }
+ if (windowUnits < 0) {
+ windowUnits = 0;
+ }
+ if (Tcl_GetIntFromObj(interp, objv[4], &firstUnit) != TCL_OK) {
+ goto error;
+ }
+ if (Tcl_GetIntFromObj(interp, objv[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_WrongNumArgs(interp, 1, objv, "set firstFraction lastFraction");
+ Tcl_AppendResult(interp, " or \"", Tcl_GetString(objv[0]),
+ " set totalUnits windowUnits firstUnit lastUnit\"", NULL);
+ goto error;
+ }
+ TkpComputeScrollbarGeometry(scrollPtr);
+ TkScrollbarEventuallyRedraw(scrollPtr);
+ break;
+ }
+ }
+
+ done:
+ Tcl_Release(scrollPtr);
+ return result;
+
+ error:
+ Tcl_Release(scrollPtr);
+ return TCL_ERROR;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ConfigureScrollbar --
+ *
+ * This function is called to process an argv/argc list, plus the Tk
+ * option database, in order to configure (or reconfigure) a scrollbar
+ * widget.
+ *
+ * Results:
+ * The return value is a standard Tcl result. If TCL_ERROR is returned,
+ * then the interp's result contains an error message.
+ *
+ * Side effects:
+ * Configuration information, such as colors, border width, etc. get set
+ * for scrollPtr; old resources get freed, if there were any.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+ConfigureScrollbar(
+ Tcl_Interp *interp, /* Used for error reporting. */
+ register TkScrollbar *scrollPtr,
+ /* Information about widget; may or may not
+ * already have values for some fields. */
+ int objc, /* Number of valid entries in argv. */
+ Tcl_Obj *const objv[], /* Arguments. */
+ int flags) /* Flags to pass to Tk_ConfigureWidget. */
+{
+ if (Tk_ConfigureWidget(interp, scrollPtr->tkwin, configSpecs, objc,
+ (const char **)objv, (char *) scrollPtr, flags|TK_CONFIG_OBJS) != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ /*
+ * A few options need special processing, such as setting the background
+ * from a 3-D border.
+ */
+
+ if (scrollPtr->command != NULL) {
+ scrollPtr->commandSize = (int) strlen(scrollPtr->command);
+ } else {
+ scrollPtr->commandSize = 0;
+ }
+
+ /*
+ * Configure platform specific options.
+ */
+
+ TkpConfigureScrollbar(scrollPtr);
+
+ /*
+ * Register the desired geometry for the window (leave enough space for
+ * the two arrows plus a minimum-size slider, plus border around the whole
+ * window, if any). Then arrange for the window to be redisplayed.
+ */
+
+ TkpComputeScrollbarGeometry(scrollPtr);
+ TkScrollbarEventuallyRedraw(scrollPtr);
+ return TCL_OK;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * TkScrollbarEventProc --
+ *
+ * This function is invoked by the Tk dispatcher for various events on
+ * scrollbars.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * When the window gets deleted, internal structures get cleaned up.
+ * When it gets exposed, it is redisplayed.
+ *
+ *--------------------------------------------------------------
+ */
+
+void
+TkScrollbarEventProc(
+ ClientData clientData, /* Information about window. */
+ XEvent *eventPtr) /* Information about event. */
+{
+ TkScrollbar *scrollPtr = clientData;
+
+ if ((eventPtr->type == Expose) && (eventPtr->xexpose.count == 0)) {
+ TkScrollbarEventuallyRedraw(scrollPtr);
+ } else if (eventPtr->type == DestroyNotify) {
+ TkpDestroyScrollbar(scrollPtr);
+ if (scrollPtr->tkwin != NULL) {
+ scrollPtr->tkwin = NULL;
+ Tcl_DeleteCommandFromToken(scrollPtr->interp,
+ scrollPtr->widgetCmd);
+ }
+ if (scrollPtr->flags & REDRAW_PENDING) {
+ Tcl_CancelIdleCall(TkpDisplayScrollbar, scrollPtr);
+ }
+ /*
+ * Free up all the stuff that requires special handling, then let
+ * Tk_FreeOptions handle all the standard option-related stuff.
+ */
+
+ Tk_FreeOptions(configSpecs, (char*) scrollPtr, scrollPtr->display, 0);
+ Tcl_EventuallyFree(scrollPtr, TCL_DYNAMIC);
+ } else if (eventPtr->type == ConfigureNotify) {
+ TkpComputeScrollbarGeometry(scrollPtr);
+ TkScrollbarEventuallyRedraw(scrollPtr);
+ } else if (eventPtr->type == FocusIn) {
+ if (eventPtr->xfocus.detail != NotifyInferior) {
+ scrollPtr->flags |= GOT_FOCUS;
+ if (scrollPtr->highlightWidth > 0) {
+ TkScrollbarEventuallyRedraw(scrollPtr);
+ }
+ }
+ } else if (eventPtr->type == FocusOut) {
+ if (eventPtr->xfocus.detail != NotifyInferior) {
+ scrollPtr->flags &= ~GOT_FOCUS;
+ if (scrollPtr->highlightWidth > 0) {
+ TkScrollbarEventuallyRedraw(scrollPtr);
+ }
+ }
+ } else if (eventPtr->type == MapNotify) {
+ TkScrollbarEventuallyRedraw(scrollPtr);
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ScrollbarCmdDeletedProc --
+ *
+ * This function 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) /* Pointer to widget record for widget. */
+{
+ TkScrollbar *scrollPtr = clientData;
+ Tk_Window tkwin = scrollPtr->tkwin;
+
+ /*
+ * This function 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 function destroys the
+ * widget.
+ */
+
+ if (tkwin != NULL) {
+ scrollPtr->tkwin = NULL;
+ Tk_DestroyWindow(tkwin);
+ }
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * TkScrollbarEventuallyRedraw --
+ *
+ * Arrange for one or more of the fields of a scrollbar to be redrawn.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * None.
+ *
+ *--------------------------------------------------------------
+ */
+
+void
+TkScrollbarEventuallyRedraw(
+ TkScrollbar *scrollPtr) /* Information about widget. */
+{
+ if ((scrollPtr->tkwin == NULL) || !Tk_IsMapped(scrollPtr->tkwin)) {
+ return;
+ }
+ if (!(scrollPtr->flags & REDRAW_PENDING)) {
+ Tcl_DoWhenIdle(TkpDisplayScrollbar, scrollPtr);
+ scrollPtr->flags |= REDRAW_PENDING;
+ }
+}
+
+/*
+ * Local Variables:
+ * mode: c
+ * c-basic-offset: 4
+ * fill-column: 78
+ * End:
+ */
diff --git a/tk8.6/generic/tkScrollbar.h b/tk8.6/generic/tkScrollbar.h
new file mode 100644
index 0000000..b0cd085
--- /dev/null
+++ b/tk8.6/generic/tkScrollbar.h
@@ -0,0 +1,183 @@
+/*
+ * tkScrollbar.h --
+ *
+ * Declarations of types and functions used to implement the scrollbar
+ * widget.
+ *
+ * Copyright (c) 1996 by Sun Microsystems, Inc.
+ *
+ * See the file "license.terms" for information on usage and redistribution of
+ * this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ */
+
+#ifndef _TKSCROLLBAR
+#define _TKSCROLLBAR
+
+#ifndef _TKINT
+#include "tkInt.h"
+#endif
+
+/*
+ * A data structure of the following type is kept for each scrollbar widget.
+ */
+
+typedef struct TkScrollbar {
+ Tk_Window tkwin; /* Window that embodies the scrollbar. NULL
+ * means that the window has been destroyed
+ * but the data structures haven't yet been
+ * cleaned up.*/
+ Display *display; /* Display containing widget. Used, among
+ * other things, so that resources can be
+ * freed even after tkwin has gone away. */
+ Tcl_Interp *interp; /* Interpreter associated with scrollbar. */
+ Tcl_Command widgetCmd; /* Token for scrollbar's widget command. */
+ int vertical; /* Non-zero means vertical orientation
+ * requested, zero means horizontal. */
+ int width; /* Desired narrow dimension of scrollbar, in
+ * pixels. */
+ char *command; /* Command prefix to use when invoking
+ * scrolling commands. NULL means don't invoke
+ * commands. Malloc'ed. */
+ int commandSize; /* Number of non-NULL bytes in command. */
+ int repeatDelay; /* How long to wait before auto-repeating on
+ * scrolling actions (in ms). */
+ int repeatInterval; /* Interval between autorepeats (in ms). */
+ int jump; /* Value of -jump option. */
+
+ /*
+ * Information used when displaying widget:
+ */
+
+ int borderWidth; /* Width of 3-D borders. */
+ Tk_3DBorder bgBorder; /* Used for drawing background (all flat
+ * surfaces except for trough). */
+ Tk_3DBorder activeBorder; /* For drawing backgrounds when active (i.e.
+ * when mouse is positioned over element). */
+ XColor *troughColorPtr; /* Color for drawing trough. */
+ int relief; /* Indicates whether window as a whole is
+ * raised, sunken, or flat. */
+ int highlightWidth; /* Width in pixels of highlight to draw around
+ * widget when it has the focus. <= 0 means
+ * don't draw a highlight. */
+ XColor *highlightBgColorPtr;
+ /* Color for drawing traversal highlight area
+ * when highlight is off. */
+ XColor *highlightColorPtr; /* Color for drawing traversal highlight. */
+ int inset; /* Total width of all borders, including
+ * traversal highlight and 3-D border.
+ * Indicates how much interior stuff must be
+ * offset from outside edges to leave room for
+ * borders. */
+ int elementBorderWidth; /* Width of border to draw around elements
+ * inside scrollbar (arrows and slider). -1
+ * means use borderWidth. */
+ int arrowLength; /* Length of arrows along long dimension of
+ * scrollbar, including space for a small gap
+ * between the arrow and the slider.
+ * Recomputed on window size changes. */
+ int sliderFirst; /* Pixel coordinate of top or left edge of
+ * slider area, including border. */
+ int sliderLast; /* Coordinate of pixel just after bottom or
+ * right edge of slider area, including
+ * border. */
+ int activeField; /* Names field to be displayed in active
+ * colors, such as TOP_ARROW, or 0 for no
+ * field. */
+ int activeRelief; /* Value of -activeRelief option: relief to
+ * use for active element. */
+
+ /*
+ * Information describing the application related to the scrollbar. This
+ * information is provided by the application by invoking the "set" widget
+ * command. This information can now be provided in two ways: the "old"
+ * form (totalUnits, windowUnits, firstUnit, and lastUnit), or the "new"
+ * form (firstFraction and lastFraction). FirstFraction and lastFraction
+ * will always be valid, but the old-style information is only valid if
+ * the NEW_STYLE_COMMANDS flag is 0.
+ */
+
+ int totalUnits; /* Total dimension of application, in units.
+ * Valid only if the NEW_STYLE_COMMANDS flag
+ * isn't set. */
+ int windowUnits; /* Maximum number of units that can be
+ * displayed in the window at once. Valid only
+ * if the NEW_STYLE_COMMANDS flag isn't set. */
+ int firstUnit; /* Number of last unit visible in
+ * application's window. Valid only if the
+ * NEW_STYLE_COMMANDS flag isn't set. */
+ int lastUnit; /* Index of last unit visible in window.
+ * Valid only if the NEW_STYLE_COMMANDS flag
+ * isn't set. */
+ double firstFraction; /* Position of first visible thing in window,
+ * specified as a fraction between 0 and
+ * 1.0. */
+ double lastFraction; /* Position of last visible thing in window,
+ * specified as a fraction between 0 and
+ * 1.0. */
+
+ /*
+ * Miscellaneous information:
+ */
+
+ Tk_Cursor cursor; /* Current cursor for window, or None. */
+ char *takeFocus; /* Value of -takefocus option; not used in the
+ * C code, but used by keyboard traversal
+ * scripts. Malloc'ed, but may be NULL. */
+ int flags; /* Various flags; see below for
+ * definitions. */
+} TkScrollbar;
+
+/*
+ * Legal values for "activeField" field of Scrollbar structures. These are
+ * also the return values from the ScrollbarPosition function.
+ */
+
+#define OUTSIDE 0
+#define TOP_ARROW 1
+#define TOP_GAP 2
+#define SLIDER 3
+#define BOTTOM_GAP 4
+#define BOTTOM_ARROW 5
+
+/*
+ * Flag bits for scrollbars:
+ *
+ * REDRAW_PENDING: Non-zero means a DoWhenIdle handler has
+ * already been queued to redraw this window.
+ * NEW_STYLE_COMMANDS: Non-zero means the new style of commands
+ * should be used to communicate with the widget:
+ * ".t yview scroll 2 lines", instead of
+ * ".t yview 40", for example.
+ * GOT_FOCUS: Non-zero means this window has the input
+ * focus.
+ */
+
+#define REDRAW_PENDING 1
+#define NEW_STYLE_COMMANDS 2
+#define GOT_FOCUS 4
+
+/*
+ * Declaration of scrollbar class functions structure
+ * and default scrollbar width, for use in configSpec.
+ */
+
+MODULE_SCOPE const Tk_ClassProcs tkpScrollbarProcs;
+MODULE_SCOPE char tkDefScrollbarWidth[TCL_INTEGER_SPACE];
+
+/*
+ * Declaration of functions used in the implementation of the scrollbar
+ * widget.
+ */
+
+MODULE_SCOPE void TkScrollbarEventProc(ClientData clientData,
+ XEvent *eventPtr);
+MODULE_SCOPE void TkScrollbarEventuallyRedraw(TkScrollbar *scrollPtr);
+MODULE_SCOPE void TkpComputeScrollbarGeometry(TkScrollbar *scrollPtr);
+MODULE_SCOPE TkScrollbar *TkpCreateScrollbar(Tk_Window tkwin);
+MODULE_SCOPE void TkpDestroyScrollbar(TkScrollbar *scrollPtr);
+MODULE_SCOPE void TkpDisplayScrollbar(ClientData clientData);
+MODULE_SCOPE void TkpConfigureScrollbar(TkScrollbar *scrollPtr);
+MODULE_SCOPE int TkpScrollbarPosition(TkScrollbar *scrollPtr,
+ int x, int y);
+
+#endif /* _TKSCROLLBAR */
diff --git a/tk8.6/generic/tkSelect.c b/tk8.6/generic/tkSelect.c
new file mode 100644
index 0000000..ab9018a
--- /dev/null
+++ b/tk8.6/generic/tkSelect.c
@@ -0,0 +1,1602 @@
+/*
+ * tkSelect.c --
+ *
+ * This file manages the selection for the Tk toolkit, translating
+ * between the standard X ICCCM conventions and Tcl commands.
+ *
+ * Copyright (c) 1990-1993 The Regents of the University of California.
+ * Copyright (c) 1994-1997 Sun Microsystems, Inc.
+ *
+ * See the file "license.terms" for information on usage and redistribution of
+ * this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ */
+
+#include "tkInt.h"
+#include "tkSelect.h"
+
+/*
+ * When a selection handler is set up by invoking "selection handle", one of
+ * the following data structures is set up to hold information about the
+ * command to invoke and its interpreter.
+ */
+
+typedef struct {
+ Tcl_Interp *interp; /* Interpreter in which to invoke command. */
+ int cmdLength; /* # of non-NULL bytes in command. */
+ int charOffset; /* The offset of the next char to retrieve. */
+ int byteOffset; /* The expected byte offset of the next
+ * chunk. */
+ char buffer[TCL_UTF_MAX]; /* A buffer to hold part of a UTF character
+ * that is split across chunks. */
+ char command[1]; /* Command to invoke. Actual space is
+ * allocated as large as necessary. This must
+ * be the last entry in the structure. */
+} CommandInfo;
+
+/*
+ * When selection ownership is claimed with the "selection own" Tcl command,
+ * one of the following structures is created to record the Tcl command to be
+ * executed when the selection is lost again.
+ */
+
+typedef struct LostCommand {
+ Tcl_Interp *interp; /* Interpreter in which to invoke command. */
+ Tcl_Obj *cmdObj; /* Reference to command to invoke. */
+} LostCommand;
+
+/*
+ * The structure below is used to keep each thread's pending list separate.
+ */
+
+typedef struct ThreadSpecificData {
+ TkSelInProgress *pendingPtr;
+ /* Topmost search in progress, or NULL if
+ * none. */
+} ThreadSpecificData;
+static Tcl_ThreadDataKey dataKey;
+
+/*
+ * Forward declarations for functions defined in this file:
+ */
+
+static int HandleTclCommand(ClientData clientData,
+ int offset, char *buffer, int maxBytes);
+static void LostSelection(ClientData clientData);
+static int SelGetProc(ClientData clientData,
+ Tcl_Interp *interp, const char *portion);
+
+/*
+ *--------------------------------------------------------------
+ *
+ * Tk_CreateSelHandler --
+ *
+ * This function is called to register a function as the handler for
+ * selection requests of a particular target type on a particular window
+ * for a particular selection.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+
+ * In the future, whenever the selection is in tkwin's window and someone
+ * requests the selection in the form given by target, proc will be
+ * invoked to provide part or all of the selection in the given form. If
+ * there was already a handler declared for the given window, target and
+ * selection type, then it is replaced. Proc should have the following
+ * form:
+ *
+ * int
+ * proc(
+ * ClientData clientData,
+ * int offset,
+ * char *buffer,
+ * int maxBytes)
+ * {
+ * }
+ *
+ * The clientData argument to proc will be the same as the clientData
+ * argument to this function. The offset argument indicates which portion
+ * of the selection to return: skip the first offset bytes. Buffer is a
+ * pointer to an area in which to place the converted selection, and
+ * maxBytes gives the number of bytes available at buffer. Proc should
+ * place the selection in buffer as a string, and return a count of the
+ * number of bytes of selection actually placed in buffer (not including
+ * the terminating NULL character). If the return value equals maxBytes,
+ * this is a sign that there is probably still more selection information
+ * available.
+ *
+ *--------------------------------------------------------------
+ */
+
+void
+Tk_CreateSelHandler(
+ Tk_Window tkwin, /* Token for window. */
+ Atom selection, /* Selection to be handled. */
+ Atom target, /* The kind of selection conversions that can
+ * be handled by proc, e.g. TARGETS or
+ * STRING. */
+ Tk_SelectionProc *proc, /* Function to invoke to convert selection to
+ * type "target". */
+ ClientData clientData, /* Value to pass to proc. */
+ Atom format) /* Format in which the selection information
+ * should be returned to the requestor.
+ * XA_STRING is best by far, but anything
+ * listed in the ICCCM will be tolerated
+ * (blech). */
+{
+ register TkSelHandler *selPtr;
+ TkWindow *winPtr = (TkWindow *) tkwin;
+
+ if (winPtr->dispPtr->multipleAtom == None) {
+ TkSelInit(tkwin);
+ }
+
+ /*
+ * See if there's already a handler for this target and selection on this
+ * window. If so, re-use it. If not, create a new one.
+ */
+
+ for (selPtr = winPtr->selHandlerList; ; selPtr = selPtr->nextPtr) {
+ if (selPtr == NULL) {
+ selPtr = ckalloc(sizeof(TkSelHandler));
+ selPtr->nextPtr = winPtr->selHandlerList;
+ winPtr->selHandlerList = selPtr;
+ break;
+ }
+ if ((selPtr->selection == selection) && (selPtr->target == target)) {
+ /*
+ * Special case: when replacing handler created by "selection
+ * handle", free up memory. Should there be a callback to allow
+ * other clients to do this too?
+ */
+
+ if (selPtr->proc == HandleTclCommand) {
+ ckfree(selPtr->clientData);
+ }
+ break;
+ }
+ }
+ selPtr->selection = selection;
+ selPtr->target = target;
+ selPtr->format = format;
+ selPtr->proc = proc;
+ selPtr->clientData = clientData;
+ if (format == XA_STRING) {
+ selPtr->size = 8;
+ } else {
+ selPtr->size = 32;
+ }
+
+ if ((target == XA_STRING) && (winPtr->dispPtr->utf8Atom != (Atom) 0)) {
+ /*
+ * If the user asked for a STRING handler and we understand
+ * UTF8_STRING, we implicitly create a UTF8_STRING handler for them.
+ */
+
+ target = winPtr->dispPtr->utf8Atom;
+ for (selPtr = winPtr->selHandlerList; ; selPtr = selPtr->nextPtr) {
+ if (selPtr == NULL) {
+ selPtr = ckalloc(sizeof(TkSelHandler));
+ selPtr->nextPtr = winPtr->selHandlerList;
+ winPtr->selHandlerList = selPtr;
+ selPtr->selection = selection;
+ selPtr->target = target;
+ selPtr->format = target; /* We want UTF8_STRING format */
+ selPtr->proc = proc;
+ if (selPtr->proc == HandleTclCommand) {
+ /*
+ * The clientData is selection controlled memory, so we
+ * should make a copy for this selPtr.
+ */
+
+ unsigned cmdInfoLen = Tk_Offset(CommandInfo, command) +
+ ((CommandInfo *)clientData)->cmdLength + 1;
+
+ selPtr->clientData = ckalloc(cmdInfoLen);
+ memcpy(selPtr->clientData, clientData, cmdInfoLen);
+ } else {
+ selPtr->clientData = clientData;
+ }
+ selPtr->size = 8;
+ break;
+ }
+ if (selPtr->selection==selection && selPtr->target==target) {
+ /*
+ * Looks like we had a utf-8 target already. Leave it alone.
+ */
+
+ break;
+ }
+ }
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_DeleteSelHandler --
+ *
+ * Remove the selection handler for a given window, target, and
+ * selection, if it exists.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The selection handler for tkwin and target is removed. If there is no
+ * such handler then nothing happens.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tk_DeleteSelHandler(
+ Tk_Window tkwin, /* Token for window. */
+ Atom selection, /* The selection whose handler is to be
+ * removed. */
+ Atom target) /* The target whose selection handler is to be
+ * removed. */
+{
+ TkWindow *winPtr = (TkWindow *) tkwin;
+ register TkSelHandler *selPtr, *prevPtr;
+ register TkSelInProgress *ipPtr;
+ ThreadSpecificData *tsdPtr =
+ Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
+
+ /*
+ * Find the selection handler to be deleted, or return if it doesn't
+ * exist.
+ */
+
+ for (selPtr = winPtr->selHandlerList, prevPtr = NULL; ;
+ prevPtr = selPtr, selPtr = selPtr->nextPtr) {
+ if (selPtr == NULL) {
+ return;
+ }
+ if ((selPtr->selection == selection) && (selPtr->target == target)) {
+ break;
+ }
+ }
+
+ /*
+ * If ConvertSelection is processing this handler, tell it that the
+ * handler is dead.
+ */
+
+ for (ipPtr = tsdPtr->pendingPtr; ipPtr != NULL;
+ ipPtr = ipPtr->nextPtr) {
+ if (ipPtr->selPtr == selPtr) {
+ ipPtr->selPtr = NULL;
+ }
+ }
+
+ /*
+ * Free resources associated with the handler.
+ */
+
+ if (prevPtr == NULL) {
+ winPtr->selHandlerList = selPtr->nextPtr;
+ } else {
+ prevPtr->nextPtr = selPtr->nextPtr;
+ }
+
+ if ((target == XA_STRING) && (winPtr->dispPtr->utf8Atom != (Atom) 0)) {
+ /*
+ * If the user asked for a STRING handler and we understand
+ * UTF8_STRING, we may have implicitly created a UTF8_STRING handler
+ * for them. Look for it and delete it as necessary.
+ */
+
+ TkSelHandler *utf8selPtr;
+
+ target = winPtr->dispPtr->utf8Atom;
+ for (utf8selPtr = winPtr->selHandlerList; utf8selPtr != NULL;
+ utf8selPtr = utf8selPtr->nextPtr) {
+ if ((utf8selPtr->selection == selection)
+ && (utf8selPtr->target == target)) {
+ break;
+ }
+ }
+ if (utf8selPtr != NULL) {
+ if ((utf8selPtr->format == target)
+ && (utf8selPtr->proc == selPtr->proc)
+ && (utf8selPtr->size == selPtr->size)) {
+ /*
+ * This recursive call is OK, because we've changed the value
+ * of 'target'.
+ */
+
+ Tk_DeleteSelHandler(tkwin, selection, target);
+ }
+ }
+ }
+
+ if (selPtr->proc == HandleTclCommand) {
+ /*
+ * Mark the CommandInfo as deleted and free it if we can.
+ */
+
+ ((CommandInfo *) selPtr->clientData)->interp = NULL;
+ Tcl_EventuallyFree(selPtr->clientData, TCL_DYNAMIC);
+ }
+ ckfree(selPtr);
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * Tk_OwnSelection --
+ *
+ * Arrange for tkwin to become the owner of a selection.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * From now on, requests for the selection will be directed to functions
+ * associated with tkwin (they must have been declared with calls to
+ * Tk_CreateSelHandler). When the selection is lost by this window, proc
+ * will be invoked (see the manual entry for details). This function may
+ * invoke callbacks, including Tcl scripts, so any calling function
+ * should be reentrant at the point where Tk_OwnSelection is invoked.
+ *
+ *--------------------------------------------------------------
+ */
+
+void
+Tk_OwnSelection(
+ Tk_Window tkwin, /* Window to become new selection owner. */
+ Atom selection, /* Selection that window should own. */
+ Tk_LostSelProc *proc, /* Function to call when selection is taken
+ * away from tkwin. */
+ ClientData clientData) /* Arbitrary one-word argument to pass to
+ * proc. */
+{
+ register TkWindow *winPtr = (TkWindow *) tkwin;
+ TkDisplay *dispPtr = winPtr->dispPtr;
+ TkSelectionInfo *infoPtr;
+ Tk_LostSelProc *clearProc = NULL;
+ ClientData clearData = NULL;/* Initialization needed only to prevent
+ * compiler warning. */
+
+ if (dispPtr->multipleAtom == None) {
+ TkSelInit(tkwin);
+ }
+ Tk_MakeWindowExist(tkwin);
+
+ /*
+ * This code is somewhat tricky. First, we find the specified selection on
+ * the selection list. If the previous owner is in this process, and is a
+ * different window, then we need to invoke the clearProc. However, it's
+ * dangerous to call the clearProc right now, because it could invoke a
+ * Tcl script that wrecks the current state (e.g. it could delete the
+ * window). To be safe, defer the call until the end of the function when
+ * we no longer care about the state.
+ */
+
+ for (infoPtr = dispPtr->selectionInfoPtr; infoPtr != NULL;
+ infoPtr = infoPtr->nextPtr) {
+ if (infoPtr->selection == selection) {
+ break;
+ }
+ }
+ if (infoPtr == NULL) {
+ infoPtr = ckalloc(sizeof(TkSelectionInfo));
+ infoPtr->selection = selection;
+ infoPtr->nextPtr = dispPtr->selectionInfoPtr;
+ dispPtr->selectionInfoPtr = infoPtr;
+ } else if (infoPtr->clearProc != NULL) {
+ if (infoPtr->owner != tkwin) {
+ clearProc = infoPtr->clearProc;
+ clearData = infoPtr->clearData;
+ } else if (infoPtr->clearProc == LostSelection) {
+ /*
+ * If the selection handler is one created by "selection own", be
+ * sure to free the record for it; otherwise there will be a
+ * memory leak.
+ */
+
+ ckfree(infoPtr->clearData);
+ }
+ }
+
+ infoPtr->owner = tkwin;
+ infoPtr->serial = NextRequest(winPtr->display);
+ infoPtr->clearProc = proc;
+ infoPtr->clearData = clientData;
+
+ /*
+ * Note that we are using CurrentTime, even though ICCCM recommends
+ * against this practice (the problem is that we don't necessarily have a
+ * valid time to use). We will not be able to retrieve a useful timestamp
+ * for the TIMESTAMP target later.
+ */
+
+ infoPtr->time = CurrentTime;
+
+ /*
+ * Note that we are not checking to see if the selection claim succeeded.
+ * If the ownership does not change, then the clearProc may never be
+ * invoked, and we will return incorrect information when queried for the
+ * current selection owner.
+ */
+
+ XSetSelectionOwner(winPtr->display, infoPtr->selection, winPtr->window,
+ infoPtr->time);
+
+ /*
+ * Now that we are done, we can invoke clearProc without running into
+ * reentrancy problems.
+ */
+
+ if (clearProc != NULL) {
+ clearProc(clearData);
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_ClearSelection --
+ *
+ * Eliminate the specified selection on tkwin's display, if there is one.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The specified selection is cleared, so that future requests to
+ * retrieve it will fail until some application owns it again. This
+ * function invokes callbacks, possibly including Tcl scripts, so any
+ * calling function should be reentrant at the point Tk_ClearSelection is
+ * invoked.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tk_ClearSelection(
+ Tk_Window tkwin, /* Window that selects a display. */
+ Atom selection) /* Selection to be cancelled. */
+{
+ register TkWindow *winPtr = (TkWindow *) tkwin;
+ TkDisplay *dispPtr = winPtr->dispPtr;
+ TkSelectionInfo *infoPtr;
+ TkSelectionInfo *prevPtr;
+ TkSelectionInfo *nextPtr;
+ Tk_LostSelProc *clearProc = NULL;
+ ClientData clearData = NULL;/* Initialization needed only to prevent
+ * compiler warning. */
+
+ if (dispPtr->multipleAtom == None) {
+ TkSelInit(tkwin);
+ }
+
+ for (infoPtr = dispPtr->selectionInfoPtr, prevPtr = NULL;
+ infoPtr != NULL; infoPtr = nextPtr) {
+ nextPtr = infoPtr->nextPtr;
+ if (infoPtr->selection == selection) {
+ if (prevPtr == NULL) {
+ dispPtr->selectionInfoPtr = nextPtr;
+ } else {
+ prevPtr->nextPtr = nextPtr;
+ }
+ break;
+ }
+ prevPtr = infoPtr;
+ }
+
+ if (infoPtr != NULL) {
+ clearProc = infoPtr->clearProc;
+ clearData = infoPtr->clearData;
+ ckfree(infoPtr);
+ }
+ XSetSelectionOwner(winPtr->display, selection, None, CurrentTime);
+
+ if (clearProc != NULL) {
+ clearProc(clearData);
+ }
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * Tk_GetSelection --
+ *
+ * Retrieve the value of a selection and pass it off (in pieces,
+ * possibly) to a given function.
+ *
+ * Results:
+ * The return value is a standard Tcl return value. If an error occurs
+ * (such as no selection exists) then an error message is left in the
+ * interp's result.
+ *
+ * Side effects:
+ * The standard X11 protocols are used to retrieve the selection. When it
+ * arrives, it is passed to proc. If the selection is very large, it will
+ * be passed to proc in several pieces. Proc should have the following
+ * structure:
+ *
+ * int
+ * proc(
+ * ClientData clientData,
+ * Tcl_Interp *interp,
+ * char *portion)
+ * {
+ * }
+ *
+ * The interp and clientData arguments to proc will be the same as the
+ * corresponding arguments to Tk_GetSelection. The portion argument
+ * points to a character string containing part of the selection, and
+ * numBytes indicates the length of the portion, not including the
+ * terminating NULL character. If the selection arrives in several
+ * pieces, the "portion" arguments in separate calls will contain
+ * successive parts of the selection. Proc should normally return TCL_OK.
+ * If it detects an error then it should return TCL_ERROR and leave an
+ * error message in the interp's result; the remainder of the selection
+ * retrieval will be aborted.
+ *
+ *--------------------------------------------------------------
+ */
+
+int
+Tk_GetSelection(
+ Tcl_Interp *interp, /* Interpreter to use for reporting errors. */
+ Tk_Window tkwin, /* Window on whose behalf to retrieve the
+ * selection (determines display from which to
+ * retrieve). */
+ Atom selection, /* Selection to retrieve. */
+ Atom target, /* Desired form in which selection is to be
+ * returned. */
+ Tk_GetSelProc *proc, /* Function to call to process the selection,
+ * once it has been retrieved. */
+ ClientData clientData) /* Arbitrary value to pass to proc. */
+{
+ TkWindow *winPtr = (TkWindow *) tkwin;
+ TkDisplay *dispPtr = winPtr->dispPtr;
+ TkSelectionInfo *infoPtr;
+ ThreadSpecificData *tsdPtr =
+ Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
+
+ if (dispPtr->multipleAtom == None) {
+ TkSelInit(tkwin);
+ }
+
+ /*
+ * If the selection is owned by a window managed by this process, then
+ * call the retrieval function directly, rather than going through the X
+ * server (it's dangerous to go through the X server in this case because
+ * it could result in deadlock if an INCR-style selection results).
+ */
+
+ for (infoPtr = dispPtr->selectionInfoPtr; infoPtr != NULL;
+ infoPtr = infoPtr->nextPtr) {
+ if (infoPtr->selection == selection) {
+ break;
+ }
+ }
+ if (infoPtr != NULL) {
+ register TkSelHandler *selPtr;
+ int offset, result, count;
+ char buffer[TK_SEL_BYTES_AT_ONCE+1];
+ TkSelInProgress ip;
+
+ for (selPtr = ((TkWindow *) infoPtr->owner)->selHandlerList;
+ selPtr != NULL; selPtr = selPtr->nextPtr) {
+ if (selPtr->target==target && selPtr->selection==selection) {
+ break;
+ }
+ }
+ if (selPtr == NULL) {
+ Atom type;
+
+ count = TkSelDefaultSelection(infoPtr, target, buffer,
+ TK_SEL_BYTES_AT_ONCE, &type);
+ if (count > TK_SEL_BYTES_AT_ONCE) {
+ Tcl_Panic("selection handler returned too many bytes");
+ }
+ if (count < 0) {
+ goto cantget;
+ }
+ buffer[count] = 0;
+ result = proc(clientData, interp, buffer);
+ } else {
+ offset = 0;
+ result = TCL_OK;
+ ip.selPtr = selPtr;
+ ip.nextPtr = tsdPtr->pendingPtr;
+ tsdPtr->pendingPtr = &ip;
+ while (1) {
+ count = selPtr->proc(selPtr->clientData, offset, buffer,
+ TK_SEL_BYTES_AT_ONCE);
+ if ((count < 0) || (ip.selPtr == NULL)) {
+ tsdPtr->pendingPtr = ip.nextPtr;
+ goto cantget;
+ }
+ if (count > TK_SEL_BYTES_AT_ONCE) {
+ Tcl_Panic("selection handler returned too many bytes");
+ }
+ buffer[count] = '\0';
+ result = proc(clientData, interp, buffer);
+ if ((result != TCL_OK) || (count < TK_SEL_BYTES_AT_ONCE)
+ || (ip.selPtr == NULL)) {
+ break;
+ }
+ offset += count;
+ }
+ tsdPtr->pendingPtr = ip.nextPtr;
+ }
+ return result;
+ }
+
+ /*
+ * The selection is owned by some other process.
+ */
+
+ return TkSelGetSelection(interp, tkwin, selection, target, proc,
+ clientData);
+
+ cantget:
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "%s selection doesn't exist or form \"%s\" not defined",
+ Tk_GetAtomName(tkwin, selection),
+ Tk_GetAtomName(tkwin, target)));
+ return TCL_ERROR;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * Tk_SelectionObjCmd --
+ *
+ * This function is invoked to process the "selection" Tcl command. See
+ * the user documentation for details on what it does.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * See the user documentation.
+ *
+ *--------------------------------------------------------------
+ */
+
+int
+Tk_SelectionObjCmd(
+ ClientData 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 = clientData;
+ const char *path = NULL;
+ Atom selection;
+ const char *selName = NULL;
+ const char *string;
+ int count, index;
+ Tcl_Obj **objs;
+ static const char *const optionStrings[] = {
+ "clear", "get", "handle", "own", NULL
+ };
+ enum options {
+ SELECTION_CLEAR, SELECTION_GET, SELECTION_HANDLE, SELECTION_OWN
+ };
+
+ 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 SELECTION_CLEAR: {
+ static const char *const clearOptionStrings[] = {
+ "-displayof", "-selection", NULL
+ };
+ enum clearOptions { CLEAR_DISPLAYOF, CLEAR_SELECTION };
+ int clearIndex;
+
+ for (count = objc-2, objs = ((Tcl_Obj **)objv)+2; count > 0;
+ count-=2, objs+=2) {
+ string = Tcl_GetString(objs[0]);
+ if (string[0] != '-') {
+ break;
+ }
+ if (count < 2) {
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "value for \"%s\" missing", string));
+ Tcl_SetErrorCode(interp, "TK", "SELECTION", "VALUE", NULL);
+ return TCL_ERROR;
+ }
+
+ if (Tcl_GetIndexFromObj(interp, objs[0], clearOptionStrings,
+ "option", 0, &clearIndex) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ switch ((enum clearOptions) clearIndex) {
+ case CLEAR_DISPLAYOF:
+ path = Tcl_GetString(objs[1]);
+ break;
+ case CLEAR_SELECTION:
+ selName = Tcl_GetString(objs[1]);
+ break;
+ }
+ }
+
+ if (count == 1) {
+ path = Tcl_GetString(objs[0]);
+ } else if (count > 1) {
+ Tcl_WrongNumArgs(interp, 2, objv, "?-option value ...?");
+ return TCL_ERROR;
+ }
+ if (path != NULL) {
+ tkwin = Tk_NameToWindow(interp, path, tkwin);
+ }
+ if (tkwin == NULL) {
+ return TCL_ERROR;
+ }
+ if (selName != NULL) {
+ selection = Tk_InternAtom(tkwin, selName);
+ } else {
+ selection = XA_PRIMARY;
+ }
+
+ Tk_ClearSelection(tkwin, selection);
+ break;
+ }
+
+ case SELECTION_GET: {
+ Atom target;
+ const char *targetName = NULL;
+ Tcl_DString selBytes;
+ int result;
+ static const char *const getOptionStrings[] = {
+ "-displayof", "-selection", "-type", NULL
+ };
+ enum getOptions { GET_DISPLAYOF, GET_SELECTION, GET_TYPE };
+ int getIndex;
+
+ for (count = objc-2, objs = ((Tcl_Obj **)objv)+2; count>0;
+ count-=2, objs+=2) {
+ string = Tcl_GetString(objs[0]);
+ if (string[0] != '-') {
+ break;
+ }
+ if (count < 2) {
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "value for \"%s\" missing", string));
+ Tcl_SetErrorCode(interp, "TK", "SELECTION", "VALUE", NULL);
+ return TCL_ERROR;
+ }
+
+ if (Tcl_GetIndexFromObj(interp, objs[0], getOptionStrings,
+ "option", 0, &getIndex) != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ switch ((enum getOptions) getIndex) {
+ case GET_DISPLAYOF:
+ path = Tcl_GetString(objs[1]);
+ break;
+ case GET_SELECTION:
+ selName = Tcl_GetString(objs[1]);
+ break;
+ case GET_TYPE:
+ targetName = Tcl_GetString(objs[1]);
+ break;
+ }
+ }
+
+ if (path != NULL) {
+ tkwin = Tk_NameToWindow(interp, path, tkwin);
+ }
+ if (tkwin == NULL) {
+ return TCL_ERROR;
+ }
+ if (selName != NULL) {
+ selection = Tk_InternAtom(tkwin, selName);
+ } else {
+ selection = XA_PRIMARY;
+ }
+ if (count > 1) {
+ Tcl_WrongNumArgs(interp, 2, objv, "?-option value ...?");
+ return TCL_ERROR;
+ } else if (count == 1) {
+ target = Tk_InternAtom(tkwin, Tcl_GetString(objs[0]));
+ } else if (targetName != NULL) {
+ target = Tk_InternAtom(tkwin, targetName);
+ } else {
+ target = XA_STRING;
+ }
+
+ Tcl_DStringInit(&selBytes);
+ result = Tk_GetSelection(interp, tkwin, selection, target,
+ SelGetProc, &selBytes);
+ if (result == TCL_OK) {
+ Tcl_DStringResult(interp, &selBytes);
+ } else {
+ Tcl_DStringFree(&selBytes);
+ }
+ return result;
+ }
+
+ case SELECTION_HANDLE: {
+ Atom target, format;
+ const char *targetName = NULL;
+ const char *formatName = NULL;
+ register CommandInfo *cmdInfoPtr;
+ int cmdLength;
+ static const char *const handleOptionStrings[] = {
+ "-format", "-selection", "-type", NULL
+ };
+ enum handleOptions {
+ HANDLE_FORMAT, HANDLE_SELECTION, HANDLE_TYPE
+ };
+ int handleIndex;
+
+ for (count = objc-2, objs = ((Tcl_Obj **)objv)+2; count > 0;
+ count-=2, objs+=2) {
+ string = Tcl_GetString(objs[0]);
+ if (string[0] != '-') {
+ break;
+ }
+ if (count < 2) {
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "value for \"%s\" missing", string));
+ Tcl_SetErrorCode(interp, "TK", "SELECTION", "VALUE", NULL);
+ return TCL_ERROR;
+ }
+
+ if (Tcl_GetIndexFromObj(interp, objs[0],handleOptionStrings,
+ "option", 0, &handleIndex) != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ switch ((enum handleOptions) handleIndex) {
+ case HANDLE_FORMAT:
+ formatName = Tcl_GetString(objs[1]);
+ break;
+ case HANDLE_SELECTION:
+ selName = Tcl_GetString(objs[1]);
+ break;
+ case HANDLE_TYPE:
+ targetName = Tcl_GetString(objs[1]);
+ break;
+ }
+ }
+
+ if ((count < 2) || (count > 4)) {
+ Tcl_WrongNumArgs(interp, 2, objv,
+ "?-option value ...? window command");
+ return TCL_ERROR;
+ }
+ tkwin = Tk_NameToWindow(interp, Tcl_GetString(objs[0]), tkwin);
+ if (tkwin == NULL) {
+ return TCL_ERROR;
+ }
+ if (selName != NULL) {
+ selection = Tk_InternAtom(tkwin, selName);
+ } else {
+ selection = XA_PRIMARY;
+ }
+
+ if (count > 2) {
+ target = Tk_InternAtom(tkwin, Tcl_GetString(objs[2]));
+ } else if (targetName != NULL) {
+ target = Tk_InternAtom(tkwin, targetName);
+ } else {
+ target = XA_STRING;
+ }
+ if (count > 3) {
+ format = Tk_InternAtom(tkwin, Tcl_GetString(objs[3]));
+ } else if (formatName != NULL) {
+ format = Tk_InternAtom(tkwin, formatName);
+ } else {
+ format = XA_STRING;
+ }
+ string = Tcl_GetStringFromObj(objs[1], &cmdLength);
+ if (cmdLength == 0) {
+ Tk_DeleteSelHandler(tkwin, selection, target);
+ } else {
+ cmdInfoPtr = ckalloc(Tk_Offset(CommandInfo, command)
+ + 1 + cmdLength);
+ cmdInfoPtr->interp = interp;
+ cmdInfoPtr->charOffset = 0;
+ cmdInfoPtr->byteOffset = 0;
+ cmdInfoPtr->buffer[0] = '\0';
+ cmdInfoPtr->cmdLength = cmdLength;
+ memcpy(cmdInfoPtr->command, string, cmdLength + 1);
+ Tk_CreateSelHandler(tkwin, selection, target, HandleTclCommand,
+ cmdInfoPtr, format);
+ }
+ return TCL_OK;
+ }
+
+ case SELECTION_OWN: {
+ register LostCommand *lostPtr;
+ Tcl_Obj *commandObj = NULL;
+ static const char *const ownOptionStrings[] = {
+ "-command", "-displayof", "-selection", NULL
+ };
+ enum ownOptions { OWN_COMMAND, OWN_DISPLAYOF, OWN_SELECTION };
+ int ownIndex;
+
+ for (count = objc-2, objs = ((Tcl_Obj **)objv)+2; count > 0;
+ count-=2, objs+=2) {
+ string = Tcl_GetString(objs[0]);
+ if (string[0] != '-') {
+ break;
+ }
+ if (count < 2) {
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "value for \"%s\" missing", string));
+ Tcl_SetErrorCode(interp, "TK", "SELECTION", "VALUE", NULL);
+ return TCL_ERROR;
+ }
+
+ if (Tcl_GetIndexFromObj(interp, objs[0], ownOptionStrings,
+ "option", 0, &ownIndex) != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ switch ((enum ownOptions) ownIndex) {
+ case OWN_COMMAND:
+ commandObj = objs[1];
+ break;
+ case OWN_DISPLAYOF:
+ path = Tcl_GetString(objs[1]);
+ break;
+ case OWN_SELECTION:
+ selName = Tcl_GetString(objs[1]);
+ break;
+ }
+ }
+
+ if (count > 2) {
+ Tcl_WrongNumArgs(interp, 2, objv, "?-option value ...? ?window?");
+ return TCL_ERROR;
+ }
+ if (selName != NULL) {
+ selection = Tk_InternAtom(tkwin, selName);
+ } else {
+ selection = XA_PRIMARY;
+ }
+
+ if (count == 0) {
+ TkSelectionInfo *infoPtr;
+ TkWindow *winPtr;
+
+ if (path != NULL) {
+ tkwin = Tk_NameToWindow(interp, path, tkwin);
+ }
+ if (tkwin == NULL) {
+ return TCL_ERROR;
+ }
+ winPtr = (TkWindow *) tkwin;
+ for (infoPtr = winPtr->dispPtr->selectionInfoPtr;
+ infoPtr != NULL; infoPtr = infoPtr->nextPtr) {
+ if (infoPtr->selection == selection) {
+ break;
+ }
+ }
+
+ /*
+ * Ignore the internal clipboard window.
+ */
+
+ if ((infoPtr != NULL)
+ && (infoPtr->owner != winPtr->dispPtr->clipWindow)) {
+ Tcl_SetObjResult(interp, TkNewWindowObj(infoPtr->owner));
+ }
+ return TCL_OK;
+ }
+
+ tkwin = Tk_NameToWindow(interp, Tcl_GetString(objs[0]), tkwin);
+ if (tkwin == NULL) {
+ return TCL_ERROR;
+ }
+ if (count == 2) {
+ commandObj = objs[1];
+ }
+ if (commandObj == NULL) {
+ Tk_OwnSelection(tkwin, selection, NULL, NULL);
+ return TCL_OK;
+ }
+ lostPtr = ckalloc(sizeof(LostCommand));
+ lostPtr->interp = interp;
+ lostPtr->cmdObj = commandObj;
+ Tcl_IncrRefCount(commandObj);
+ Tk_OwnSelection(tkwin, selection, LostSelection, lostPtr);
+ return TCL_OK;
+ }
+ }
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkSelGetInProgress --
+ *
+ * This function returns a pointer to the thread-local list of pending
+ * searches.
+ *
+ * Results:
+ * The return value is a pointer to the first search in progress, or NULL
+ * if there are none.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+TkSelInProgress *
+TkSelGetInProgress(void)
+{
+ ThreadSpecificData *tsdPtr =
+ Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
+
+ return tsdPtr->pendingPtr;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkSelSetInProgress --
+ *
+ * This function 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(
+ TkSelInProgress *pendingPtr)
+{
+ ThreadSpecificData *tsdPtr =
+ Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
+
+ tsdPtr->pendingPtr = pendingPtr;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkSelDeadWindow --
+ *
+ * This function is invoked just before a TkWindow is deleted. It
+ * performs selection-related cleanup.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Frees up memory associated with the selection.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TkSelDeadWindow(
+ register TkWindow *winPtr) /* Window that's being deleted. */
+{
+ register TkSelHandler *selPtr;
+ register TkSelInProgress *ipPtr;
+ TkSelectionInfo *infoPtr, *prevPtr, *nextPtr;
+ ThreadSpecificData *tsdPtr =
+ Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
+
+ /*
+ * While deleting all the handlers, be careful to check whether
+ * ConvertSelection or TkSelPropProc are about to process one of the
+ * deleted handlers.
+ */
+
+ while (winPtr->selHandlerList != NULL) {
+ selPtr = winPtr->selHandlerList;
+ winPtr->selHandlerList = selPtr->nextPtr;
+ for (ipPtr = tsdPtr->pendingPtr; ipPtr != NULL;
+ ipPtr = ipPtr->nextPtr) {
+ if (ipPtr->selPtr == selPtr) {
+ ipPtr->selPtr = NULL;
+ }
+ }
+ if (selPtr->proc == HandleTclCommand) {
+ /*
+ * Mark the CommandInfo as deleted and free it when we can.
+ */
+
+ ((CommandInfo *) selPtr->clientData)->interp = NULL;
+ Tcl_EventuallyFree(selPtr->clientData, TCL_DYNAMIC);
+ }
+ ckfree(selPtr);
+ }
+
+ /*
+ * Remove selections owned by window being deleted.
+ */
+
+ for (infoPtr = winPtr->dispPtr->selectionInfoPtr, prevPtr = NULL;
+ infoPtr != NULL; infoPtr = nextPtr) {
+ nextPtr = infoPtr->nextPtr;
+ if (infoPtr->owner == (Tk_Window) winPtr) {
+ if (infoPtr->clearProc == LostSelection) {
+ ckfree(infoPtr->clearData);
+ }
+ ckfree(infoPtr);
+ infoPtr = prevPtr;
+ if (prevPtr == NULL) {
+ winPtr->dispPtr->selectionInfoPtr = nextPtr;
+ } else {
+ prevPtr->nextPtr = nextPtr;
+ }
+ }
+ prevPtr = infoPtr;
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkSelInit --
+ *
+ * Initialize selection-related information for a display.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Selection-related information is initialized.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TkSelInit(
+ Tk_Window tkwin) /* Window token (used to find display to
+ * initialize). */
+{
+ register TkDisplay *dispPtr = ((TkWindow *) tkwin)->dispPtr;
+
+ /*
+ * Fetch commonly-used atoms.
+ */
+
+ dispPtr->multipleAtom = Tk_InternAtom(tkwin, "MULTIPLE");
+ dispPtr->incrAtom = Tk_InternAtom(tkwin, "INCR");
+ dispPtr->targetsAtom = Tk_InternAtom(tkwin, "TARGETS");
+ dispPtr->timestampAtom = Tk_InternAtom(tkwin, "TIMESTAMP");
+ dispPtr->textAtom = Tk_InternAtom(tkwin, "TEXT");
+ dispPtr->compoundTextAtom = Tk_InternAtom(tkwin, "COMPOUND_TEXT");
+ dispPtr->applicationAtom = Tk_InternAtom(tkwin, "TK_APPLICATION");
+ dispPtr->windowAtom = Tk_InternAtom(tkwin, "TK_WINDOW");
+ dispPtr->clipboardAtom = Tk_InternAtom(tkwin, "CLIPBOARD");
+
+ /*
+ * Using UTF8_STRING instead of the XA_UTF8_STRING macro allows us to
+ * support older X servers that didn't have UTF8_STRING yet. This is
+ * necessary on Unix systems. For more information, see:
+ * http://www.cl.cam.ac.uk/~mgk25/unicode.html#x11
+ */
+
+#if !defined(_WIN32)
+ dispPtr->utf8Atom = Tk_InternAtom(tkwin, "UTF8_STRING");
+#else
+ dispPtr->utf8Atom = (Atom) 0;
+#endif
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkSelClearSelection --
+ *
+ * This function is invoked to process a SelectionClear event.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Invokes the clear function for the window which lost the
+ * selection.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TkSelClearSelection(
+ Tk_Window tkwin, /* Window for which event was targeted. */
+ register XEvent *eventPtr) /* X SelectionClear event. */
+{
+ register TkWindow *winPtr = (TkWindow *) tkwin;
+ TkDisplay *dispPtr = winPtr->dispPtr;
+ TkSelectionInfo *infoPtr;
+ TkSelectionInfo *prevPtr;
+
+ /*
+ * Invoke clear function for window that just lost the selection. This
+ * code is a bit tricky, because any callbacks due to selection changes
+ * between windows managed by the process have already been made. Thus,
+ * ignore the event unless it refers to the window that's currently the
+ * selection owner and the event was generated after the server saw the
+ * SetSelectionOwner request.
+ */
+
+ for (infoPtr = dispPtr->selectionInfoPtr, prevPtr = NULL;
+ infoPtr != NULL; infoPtr = infoPtr->nextPtr) {
+ if (infoPtr->selection == eventPtr->xselectionclear.selection) {
+ break;
+ }
+ prevPtr = infoPtr;
+ }
+
+ if (infoPtr != NULL && (infoPtr->owner == tkwin) &&
+ (eventPtr->xselectionclear.serial >= (unsigned) infoPtr->serial)) {
+ if (prevPtr == NULL) {
+ dispPtr->selectionInfoPtr = infoPtr->nextPtr;
+ } else {
+ prevPtr->nextPtr = infoPtr->nextPtr;
+ }
+
+ /*
+ * Because of reentrancy problems, calling clearProc must be done
+ * after the infoPtr has been removed from the selectionInfoPtr list
+ * (clearProc could modify the list, e.g. by creating a new
+ * selection).
+ */
+
+ if (infoPtr->clearProc != NULL) {
+ infoPtr->clearProc(infoPtr->clearData);
+ }
+ ckfree(infoPtr);
+ }
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * SelGetProc --
+ *
+ * This function is invoked to process pieces of the selection as they
+ * arrive during "selection get" commands.
+ *
+ * Results:
+ * Always returns TCL_OK.
+ *
+ * Side effects:
+ * Bytes get appended to the dynamic string pointed to by the clientData
+ * argument.
+ *
+ *--------------------------------------------------------------
+ */
+
+ /* ARGSUSED */
+static int
+SelGetProc(
+ ClientData clientData, /* Dynamic string holding partially assembled
+ * selection. */
+ Tcl_Interp *interp, /* Interpreter used for error reporting (not
+ * used). */
+ const char *portion) /* New information to be appended. */
+{
+ Tcl_DStringAppend(clientData, portion, -1);
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * HandleTclCommand --
+ *
+ * This function acts as selection handler for handlers created by the
+ * "selection handle" command. It invokes a Tcl command to retrieve the
+ * selection.
+ *
+ * Results:
+ * The return value is a count of the number of bytes actually stored at
+ * buffer, or -1 if an error occurs while executing the Tcl command to
+ * retrieve the selection.
+ *
+ * Side effects:
+ * None except for things done by the Tcl command.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+HandleTclCommand(
+ ClientData clientData, /* Information about command to execute. */
+ int offset, /* Return selection bytes starting at this
+ * offset. */
+ char *buffer, /* Place to store converted selection. */
+ int maxBytes) /* Maximum # of bytes to store at buffer. */
+{
+ CommandInfo *cmdInfoPtr = clientData;
+ int length;
+ Tcl_Obj *command;
+ const char *string;
+ Tcl_Interp *interp = cmdInfoPtr->interp;
+ Tcl_InterpState savedState;
+ int extraBytes, charOffset, count, numChars, code;
+ const char *p;
+
+ /*
+ * We must also protect the interpreter and the command from being deleted
+ * too soon.
+ */
+
+ Tcl_Preserve(clientData);
+ Tcl_Preserve(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.
+ */
+
+ command = Tcl_ObjPrintf("%s %d %d",
+ cmdInfoPtr->command, charOffset, maxBytes);
+ Tcl_IncrRefCount(command);
+
+ /*
+ * Execute the command. Be sure to restore the state of the interpreter
+ * after executing the command.
+ */
+
+ savedState = Tcl_SaveInterpState(interp, TCL_OK);
+ code = Tcl_EvalObjEx(interp, command, TCL_EVAL_GLOBAL);
+ Tcl_DecrRefCount(command);
+ if (code == TCL_OK) {
+ /*
+ * TODO: This assumes that bytes are characters; that's not true!
+ */
+
+ string = Tcl_GetStringFromObj(Tcl_GetObjResult(interp), &length);
+ count = (length > maxBytes) ? maxBytes : length;
+ memcpy(buffer, string, (size_t) count);
+ buffer[count] = '\0';
+
+ /*
+ * Update the partial character information for the next retrieval if
+ * the command has not been deleted.
+ */
+
+ if (cmdInfoPtr->interp != NULL) {
+ if (length <= maxBytes) {
+ cmdInfoPtr->charOffset += Tcl_NumUtfChars(string, -1);
+ cmdInfoPtr->buffer[0] = '\0';
+ } else {
+ p = string;
+ string += count;
+ numChars = 0;
+ while (p < string) {
+ p = Tcl_UtfNext(p);
+ numChars++;
+ }
+ cmdInfoPtr->charOffset += numChars;
+ length = p - string;
+ if (length > 0) {
+ strncpy(cmdInfoPtr->buffer, string, (size_t) length);
+ }
+ cmdInfoPtr->buffer[length] = '\0';
+ }
+ cmdInfoPtr->byteOffset += count + extraBytes;
+ }
+ count += extraBytes;
+ } else {
+ /*
+ * Something went wrong. Log errors as background errors, and silently
+ * drop everything else.
+ */
+
+ if (code == TCL_ERROR) {
+ Tcl_AddErrorInfo(interp, "\n (command handling selection)");
+ Tcl_BackgroundException(interp, code);
+ }
+ count = -1;
+ }
+ (void) Tcl_RestoreInterpState(interp, savedState);
+
+ Tcl_Release(clientData);
+ Tcl_Release(interp);
+ return count;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkSelDefaultSelection --
+ *
+ * This function is called to generate selection information for a few
+ * standard targets such as TIMESTAMP and TARGETS. It is invoked only if
+ * no handler has been declared by the application.
+ *
+ * Results:
+ * If "target" is a standard target understood by this function, the
+ * selection is converted to that form and stored as a character string
+ * in buffer. The type of the selection (e.g. STRING or ATOM) is stored
+ * in *typePtr, and the return value is a count of the # of non-NULL
+ * bytes at buffer. If the target wasn't understood, or if there isn't
+ * enough space at buffer to hold the entire selection (no INCR-mode
+ * transfers for this stuff!), then -1 is returned.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TkSelDefaultSelection(
+ TkSelectionInfo *infoPtr, /* Info about selection being retrieved. */
+ Atom target, /* Desired form of selection. */
+ char *buffer, /* Place to put selection characters. */
+ int maxBytes, /* Maximum # of bytes to store at buffer. */
+ Atom *typePtr) /* Store here the type of the selection, for
+ * use in converting to proper X format. */
+{
+ register TkWindow *winPtr = (TkWindow *) infoPtr->owner;
+ TkDisplay *dispPtr = winPtr->dispPtr;
+
+ if (target == dispPtr->timestampAtom) {
+ if (maxBytes < 20) {
+ return -1;
+ }
+ sprintf(buffer, "0x%x", (unsigned int) infoPtr->time);
+ *typePtr = XA_INTEGER;
+ return strlen(buffer);
+ }
+
+ if (target == dispPtr->targetsAtom) {
+ register TkSelHandler *selPtr;
+ int length;
+ Tcl_DString ds;
+
+ if (maxBytes < 50) {
+ return -1;
+ }
+ Tcl_DStringInit(&ds);
+ Tcl_DStringAppend(&ds,
+ "MULTIPLE TARGETS TIMESTAMP TK_APPLICATION TK_WINDOW", -1);
+ for (selPtr = winPtr->selHandlerList; selPtr != NULL;
+ selPtr = selPtr->nextPtr) {
+ if ((selPtr->selection == infoPtr->selection)
+ && (selPtr->target != dispPtr->applicationAtom)
+ && (selPtr->target != dispPtr->windowAtom)) {
+ const char *atomString = Tk_GetAtomName((Tk_Window) winPtr,
+ selPtr->target);
+
+ Tcl_DStringAppendElement(&ds, atomString);
+ }
+ }
+ length = Tcl_DStringLength(&ds);
+ if (length >= maxBytes) {
+ Tcl_DStringFree(&ds);
+ return -1;
+ }
+ memcpy(buffer, Tcl_DStringValue(&ds), (unsigned) (1+length));
+ Tcl_DStringFree(&ds);
+ *typePtr = XA_ATOM;
+ return length;
+ }
+
+ if (target == dispPtr->applicationAtom) {
+ int length;
+ Tk_Uid name = winPtr->mainPtr->winPtr->nameUid;
+
+ length = strlen(name);
+ if (maxBytes <= length) {
+ return -1;
+ }
+ strcpy(buffer, name);
+ *typePtr = XA_STRING;
+ return length;
+ }
+
+ if (target == dispPtr->windowAtom) {
+ int length;
+ char *name = winPtr->pathName;
+
+ length = strlen(name);
+ if (maxBytes <= length) {
+ return -1;
+ }
+ strcpy(buffer, name);
+ *typePtr = XA_STRING;
+ return length;
+ }
+
+ return -1;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * LostSelection --
+ *
+ * This function is invoked when a window has lost ownership of the
+ * selection and the ownership was claimed with the command "selection
+ * own".
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * A Tcl script is executed; it can do almost anything.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+LostSelection(
+ ClientData clientData) /* Pointer to LostCommand structure. */
+{
+ LostCommand *lostPtr = clientData;
+ Tcl_Interp *interp = lostPtr->interp;
+ Tcl_InterpState savedState;
+ int code;
+
+ Tcl_Preserve(interp);
+
+ /*
+ * Execute the command. Save the interpreter's result, if any, and restore
+ * it after executing the command.
+ */
+
+ savedState = Tcl_SaveInterpState(interp, TCL_OK);
+ Tcl_ResetResult(interp);
+ code = Tcl_EvalObjEx(interp, lostPtr->cmdObj, TCL_EVAL_GLOBAL);
+ if (code != TCL_OK) {
+ Tcl_BackgroundException(interp, code);
+ }
+ (void) Tcl_RestoreInterpState(interp, savedState);
+
+ /*
+ * Free the storage for the command, since we're done with it now.
+ */
+
+ Tcl_DecrRefCount(lostPtr->cmdObj);
+ ckfree(lostPtr);
+ Tcl_Release(interp);
+}
+
+/*
+ * Local Variables:
+ * mode: c
+ * c-basic-offset: 4
+ * fill-column: 78
+ * End:
+ */
diff --git a/tk8.6/generic/tkSelect.h b/tk8.6/generic/tkSelect.h
new file mode 100644
index 0000000..74326d0
--- /dev/null
+++ b/tk8.6/generic/tkSelect.h
@@ -0,0 +1,167 @@
+/*
+ * tkSelect.h --
+ *
+ * Declarations of types shared among the files that implement selection
+ * support.
+ *
+ * Copyright (c) 1995 Sun Microsystems, Inc.
+ *
+ * See the file "license.terms" for information on usage and redistribution of
+ * this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ */
+
+#ifndef _TKSELECT
+#define _TKSELECT
+
+/*
+ * When a selection is owned by a window on a given display, one of the
+ * following structures is present on a list of current selections in the
+ * display structure. The structure is used to record the current owner of a
+ * selection for use in later retrieval requests. There is a list of such
+ * structures because a display can have multiple different selections active
+ * at the same time.
+ */
+
+typedef struct TkSelectionInfo {
+ Atom selection; /* Selection name, e.g. XA_PRIMARY. */
+ Tk_Window owner; /* Current owner of this selection. */
+ int serial; /* Serial number of last XSelectionSetOwner
+ * request made to server for this selection
+ * (used to filter out redundant
+ * SelectionClear events). */
+ Time time; /* Timestamp used to acquire selection. */
+ Tk_LostSelProc *clearProc; /* Procedure to call when owner loses
+ * selection. */
+ ClientData clearData; /* Info to pass to clearProc. */
+ struct TkSelectionInfo *nextPtr;
+ /* Next in list of current selections on this
+ * display. NULL means end of list. */
+} TkSelectionInfo;
+
+/*
+ * One of the following structures exists for each selection handler created
+ * for a window by calling Tk_CreateSelHandler. The handlers are linked in a
+ * list rooted in the TkWindow structure.
+ */
+
+typedef struct TkSelHandler {
+ Atom selection; /* Selection name, e.g. XA_PRIMARY. */
+ Atom target; /* Target type for selection conversion, such
+ * as TARGETS or STRING. */
+ Atom format; /* Format in which selection info will be
+ * returned, such as STRING or ATOM. */
+ Tk_SelectionProc *proc; /* Procedure to generate selection in this
+ * format. */
+ ClientData clientData; /* Argument to pass to proc. */
+ int size; /* Size of units returned by proc (8 for
+ * STRING, 32 for almost anything else). */
+ struct TkSelHandler *nextPtr;
+ /* Next selection handler associated with same
+ * window (NULL for end of list). */
+} TkSelHandler;
+
+/*
+ * When the selection is being retrieved, one of the following structures is
+ * present on a list of pending selection retrievals. The structure is used to
+ * communicate between the background procedure that requests the selection
+ * and the foreground event handler that processes the events in which the
+ * selection is returned. There is a list of such structures so that there can
+ * be multiple simultaneous selection retrievals (e.g. on different displays).
+ */
+
+typedef struct TkSelRetrievalInfo {
+ Tcl_Interp *interp; /* Interpreter for error reporting. */
+ TkWindow *winPtr; /* Window used as requestor for selection. */
+ Atom selection; /* Selection being requested. */
+ Atom property; /* Property where selection will appear. */
+ Atom target; /* Desired form for selection. */
+ Tk_GetSelProc *proc; /* Procedure to call to handle pieces of
+ * selection. */
+ ClientData clientData; /* Argument for proc. */
+ int result; /* Initially -1. Set to a Tcl return value
+ * once the selection has been retrieved. */
+ Tcl_TimerToken timeout; /* Token for current timeout procedure. */
+ int idleTime; /* Number of seconds that have gone by without
+ * hearing anything from the selection
+ * owner. */
+ Tcl_EncodingState encState; /* Holds intermediate state during translations
+ * of data that cross buffer boundaries. */
+ int encFlags; /* Encoding translation state flags. */
+ Tcl_DString buf; /* Buffer to hold translation data. */
+ struct TkSelRetrievalInfo *nextPtr;
+ /* Next in list of all pending selection
+ * retrievals. NULL means end of list. */
+} TkSelRetrievalInfo;
+
+/*
+ * The clipboard contains a list of buffers of various types and formats. All
+ * of the buffers of a given type will be returned in sequence when the
+ * CLIPBOARD selection is retrieved. All buffers of a given type on the same
+ * clipboard must have the same format. The TkClipboardTarget structure is
+ * used to record the information about a chain of buffers of the same type.
+ */
+
+typedef struct TkClipboardBuffer {
+ char *buffer; /* Null terminated data buffer. */
+ long length; /* Length of string in buffer. */
+ struct TkClipboardBuffer *nextPtr;
+ /* Next in list of buffers. NULL means end of
+ * list . */
+} TkClipboardBuffer;
+
+typedef struct TkClipboardTarget {
+ Atom type; /* Type conversion supported. */
+ Atom format; /* Representation used for data. */
+ TkClipboardBuffer *firstBufferPtr;
+ /* First in list of data buffers. */
+ TkClipboardBuffer *lastBufferPtr;
+ /* Last in list of clipboard buffers. Used to
+ * speed up appends. */
+ struct TkClipboardTarget *nextPtr;
+ /* Next in list of targets on clipboard. NULL
+ * means end of list. */
+} TkClipboardTarget;
+
+/*
+ * It is possible for a Tk_SelectionProc to delete the handler that it
+ * represents. If this happens, the code that is retrieving the selection
+ * needs to know about it so it doesn't use the now-defunct handler structure.
+ * One structure of the following form is created for each retrieval in
+ * progress, so that the retriever can find out if its handler is deleted. All
+ * of the pending retrievals (if there are more than one) are linked into a
+ * list.
+ */
+
+typedef struct TkSelInProgress {
+ TkSelHandler *selPtr; /* Handler being executed. If this handler is
+ * deleted, the field is set to NULL. */
+ struct TkSelInProgress *nextPtr;
+ /* Next higher nested search. */
+} TkSelInProgress;
+
+/*
+ * Chunk size for retrieving selection. It's defined both in words and in
+ * bytes; the word size is used to allocate buffer space that's guaranteed to
+ * be word-aligned and that has an extra character for the terminating NULL.
+ */
+
+#define TK_SEL_BYTES_AT_ONCE 4000
+#define TK_SEL_WORDS_AT_ONCE 1001
+
+/*
+ * Declarations for procedures that are used by the selection-related files
+ * but shouldn't be used anywhere else in Tk (or by Tk clients):
+ */
+
+MODULE_SCOPE TkSelInProgress *TkSelGetInProgress(void);
+MODULE_SCOPE void TkSelSetInProgress(TkSelInProgress *pendingPtr);
+MODULE_SCOPE void TkSelClearSelection(Tk_Window tkwin, XEvent *eventPtr);
+MODULE_SCOPE int TkSelDefaultSelection(TkSelectionInfo *infoPtr,
+ Atom target, char *buffer, int maxBytes,
+ Atom *typePtr);
+#ifndef TkSelUpdateClipboard
+MODULE_SCOPE void TkSelUpdateClipboard(TkWindow *winPtr,
+ TkClipboardTarget *targetPtr);
+#endif
+
+#endif /* _TKSELECT */
diff --git a/tk8.6/generic/tkSquare.c b/tk8.6/generic/tkSquare.c
new file mode 100644
index 0000000..36d2d6e
--- /dev/null
+++ b/tk8.6/generic/tkSquare.c
@@ -0,0 +1,623 @@
+/*
+ * tkSquare.c --
+ *
+ * This module implements "square" widgets that are object based. A
+ * "square" is a widget that displays a single square that can be moved
+ * around and resized. This file is intended as an example of how to
+ * build a widget; it isn't included in the normal wish, but it is
+ * included in "tktest".
+ *
+ * Copyright (c) 1997 Sun Microsystems, Inc.
+ *
+ * See the file "license.terms" for information on usage and redistribution of
+ * this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ */
+
+#if 0
+#define __NO_OLD_CONFIG
+#endif
+#ifndef USE_TCL_STUBS
+# define USE_TCL_STUBS
+#endif
+#ifndef USE_TK_STUBS
+# define USE_TK_STUBS
+#endif
+#include "tkInt.h"
+
+/*
+ * A data structure of the following type is kept for each square widget
+ * managed by this file:
+ */
+
+typedef struct {
+ Tk_Window tkwin; /* Window that embodies the square. NULL means
+ * window has been deleted but widget record
+ * hasn't been cleaned up yet. */
+ Display *display; /* X's token for the window's display. */
+ Tcl_Interp *interp; /* Interpreter associated with widget. */
+ Tcl_Command widgetCmd; /* Token for square's widget command. */
+ Tk_OptionTable optionTable; /* Token representing the configuration
+ * specifications. */
+ Tcl_Obj *xPtr, *yPtr; /* Position of square's upper-left corner
+ * within widget. */
+ int x, y;
+ Tcl_Obj *sizeObjPtr; /* Width and height of square. */
+
+ /*
+ * Information used when displaying widget:
+ */
+
+ Tcl_Obj *borderWidthPtr; /* Width of 3-D border around whole widget. */
+ Tcl_Obj *bgBorderPtr;
+ Tcl_Obj *fgBorderPtr;
+ Tcl_Obj *reliefPtr;
+ GC gc; /* Graphics context for copying from
+ * off-screen pixmap onto screen. */
+ Tcl_Obj *doubleBufferPtr; /* Non-zero means double-buffer redisplay with
+ * pixmap; zero means draw straight onto the
+ * display. */
+ int updatePending; /* Non-zero means a call to SquareDisplay has
+ * already been scheduled. */
+} Square;
+
+/*
+ * Information used for argv parsing.
+ */
+
+static const Tk_OptionSpec optionSpecs[] = {
+ {TK_OPTION_BORDER, "-background", "background", "Background",
+ "#d9d9d9", Tk_Offset(Square, bgBorderPtr), -1, 0,
+ "white", 0},
+ {TK_OPTION_SYNONYM, "-bd", NULL, NULL, NULL, 0, -1, 0,
+ "-borderwidth", 0},
+ {TK_OPTION_SYNONYM, "-bg", NULL, NULL, NULL, 0, -1, 0,
+ "-background", 0},
+ {TK_OPTION_PIXELS, "-borderwidth", "borderWidth", "BorderWidth",
+ "2", Tk_Offset(Square, borderWidthPtr), -1, 0, NULL, 0},
+ {TK_OPTION_BOOLEAN, "-dbl", "doubleBuffer", "DoubleBuffer",
+ "1", Tk_Offset(Square, doubleBufferPtr), -1, 0 , NULL, 0},
+ {TK_OPTION_SYNONYM, "-fg", NULL, NULL, NULL, 0, -1, 0,
+ "-foreground", 0},
+ {TK_OPTION_BORDER, "-foreground", "foreground", "Foreground",
+ "#b03060", Tk_Offset(Square, fgBorderPtr), -1, 0,
+ "black", 0},
+ {TK_OPTION_PIXELS, "-posx", "posx", "PosX", "0",
+ Tk_Offset(Square, xPtr), -1, 0, NULL, 0},
+ {TK_OPTION_PIXELS, "-posy", "posy", "PosY", "0",
+ Tk_Offset(Square, yPtr), -1, 0, NULL, 0},
+ {TK_OPTION_RELIEF, "-relief", "relief", "Relief",
+ "raised", Tk_Offset(Square, reliefPtr), -1, 0, NULL, 0},
+ {TK_OPTION_PIXELS, "-size", "size", "Size", "20",
+ Tk_Offset(Square, sizeObjPtr), -1, 0, NULL, 0},
+ {TK_OPTION_END, NULL, NULL, NULL, NULL, 0, 0, 0, NULL, 0}
+};
+
+/*
+ * Forward declarations for procedures defined later in this file:
+ */
+
+static void SquareDeletedProc(ClientData clientData);
+static int SquareConfigure(Tcl_Interp *interp, Square *squarePtr);
+static void SquareDestroy(void *memPtr);
+static void SquareDisplay(ClientData clientData);
+static void KeepInWindow(Square *squarePtr);
+static void SquareObjEventProc(ClientData clientData,
+ XEvent *eventPtr);
+static int SquareWidgetObjCmd(ClientData clientData,
+ Tcl_Interp *, int objc, Tcl_Obj * const objv[]);
+
+/*
+ *--------------------------------------------------------------
+ *
+ * SquareCmd --
+ *
+ * This procedure is invoked to process the "square" Tcl command. It
+ * creates a new "square" widget.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * A new widget is created and configured.
+ *
+ *--------------------------------------------------------------
+ */
+
+int
+SquareObjCmd(
+ ClientData clientData, /* NULL. */
+ Tcl_Interp *interp, /* Current interpreter. */
+ int objc, /* Number of arguments. */
+ Tcl_Obj *const objv[]) /* Argument objects. */
+{
+ Square *squarePtr;
+ Tk_Window tkwin;
+ Tk_OptionTable optionTable;
+
+ if (objc < 2) {
+ Tcl_WrongNumArgs(interp, 1, objv, "pathName ?-option value ...?");
+ return TCL_ERROR;
+ }
+
+ tkwin = Tk_CreateWindowFromPath(interp, Tk_MainWindow(interp),
+ Tcl_GetString(objv[1]), NULL);
+ if (tkwin == NULL) {
+ return TCL_ERROR;
+ }
+ Tk_SetClass(tkwin, "Square");
+
+ /*
+ * Create the option table for this widget class. If it has already been
+ * created, the refcount will get bumped and just the pointer will be
+ * returned. The refcount getting bumped does not concern us, because Tk
+ * will ensure the table is deleted when the interpreter is destroyed.
+ */
+
+ optionTable = Tk_CreateOptionTable(interp, optionSpecs);
+
+ /*
+ * Allocate and initialize the widget record. The memset allows us to set
+ * just the non-NULL/0 items.
+ */
+
+ squarePtr = ckalloc(sizeof(Square));
+ memset(squarePtr, 0, sizeof(Square));
+
+ squarePtr->tkwin = tkwin;
+ squarePtr->display = Tk_Display(tkwin);
+ squarePtr->interp = interp;
+ squarePtr->widgetCmd = Tcl_CreateObjCommand(interp,
+ Tk_PathName(squarePtr->tkwin), SquareWidgetObjCmd, squarePtr,
+ SquareDeletedProc);
+ squarePtr->gc = None;
+ squarePtr->optionTable = optionTable;
+
+ if (Tk_InitOptions(interp, (char *) squarePtr, optionTable, tkwin)
+ != TCL_OK) {
+ Tk_DestroyWindow(squarePtr->tkwin);
+ ckfree(squarePtr);
+ return TCL_ERROR;
+ }
+
+ Tk_CreateEventHandler(squarePtr->tkwin, ExposureMask|StructureNotifyMask,
+ SquareObjEventProc, squarePtr);
+ if (Tk_SetOptions(interp, (char *) squarePtr, optionTable, objc - 2,
+ objv + 2, tkwin, NULL, NULL) != TCL_OK) {
+ goto error;
+ }
+ if (SquareConfigure(interp, squarePtr) != TCL_OK) {
+ goto error;
+ }
+
+ Tcl_SetObjResult(interp,
+ Tcl_NewStringObj(Tk_PathName(squarePtr->tkwin), -1));
+ return TCL_OK;
+
+ error:
+ Tk_DestroyWindow(squarePtr->tkwin);
+ return TCL_ERROR;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * SquareWidgetObjCmd --
+ *
+ * This procedure is invoked to process the Tcl command that corresponds
+ * to a widget managed by this module. See the user documentation for
+ * details on what it does.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * See the user documentation.
+ *
+ *--------------------------------------------------------------
+ */
+
+static int
+SquareWidgetObjCmd(
+ ClientData clientData, /* Information about square widget. */
+ Tcl_Interp *interp, /* Current interpreter. */
+ int objc, /* Number of arguments. */
+ Tcl_Obj * const objv[]) /* Argument objects. */
+{
+ Square *squarePtr = clientData;
+ int result = TCL_OK;
+ static const char *const squareOptions[] = {"cget", "configure", NULL};
+ enum {
+ SQUARE_CGET, SQUARE_CONFIGURE
+ };
+ Tcl_Obj *resultObjPtr;
+ int index;
+
+ if (objc < 2) {
+ Tcl_WrongNumArgs(interp, 1, objv, "option ?arg arg...?");
+ return TCL_ERROR;
+ }
+
+ if (Tcl_GetIndexFromObjStruct(interp, objv[1], squareOptions,
+ sizeof(char *), "command", 0, &index) != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ Tcl_Preserve(squarePtr);
+
+ switch (index) {
+ case SQUARE_CGET:
+ if (objc != 3) {
+ Tcl_WrongNumArgs(interp, 2, objv, "option");
+ goto error;
+ }
+ resultObjPtr = Tk_GetOptionValue(interp, (char *) squarePtr,
+ squarePtr->optionTable, objv[2], squarePtr->tkwin);
+ if (resultObjPtr == NULL) {
+ result = TCL_ERROR;
+ } else {
+ Tcl_SetObjResult(interp, resultObjPtr);
+ }
+ break;
+ case SQUARE_CONFIGURE:
+ resultObjPtr = NULL;
+ if (objc == 2) {
+ resultObjPtr = Tk_GetOptionInfo(interp, (char *) squarePtr,
+ squarePtr->optionTable, 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, NULL);
+ if (result == TCL_OK) {
+ result = SquareConfigure(interp, squarePtr);
+ }
+ if (!squarePtr->updatePending) {
+ Tcl_DoWhenIdle(SquareDisplay, squarePtr);
+ squarePtr->updatePending = 1;
+ }
+ }
+ if (resultObjPtr != NULL) {
+ Tcl_SetObjResult(interp, resultObjPtr);
+ }
+ }
+ Tcl_Release(squarePtr);
+ return result;
+
+ error:
+ Tcl_Release(squarePtr);
+ return TCL_ERROR;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * SquareConfigure --
+ *
+ * This procedure is called to process an argv/argc list in conjunction
+ * with the Tk option database to configure (or reconfigure) a square
+ * widget.
+ *
+ * Results:
+ * The return value is a standard Tcl result. If TCL_ERROR is returned,
+ * then the interp's result contains an error message.
+ *
+ * Side effects:
+ * Configuration information, such as colors, border width, etc. get set
+ * for squarePtr; old resources get freed, if there were any.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+SquareConfigure(
+ Tcl_Interp *interp, /* Used for error reporting. */
+ Square *squarePtr) /* Information about widget. */
+{
+ int borderWidth;
+ Tk_3DBorder bgBorder;
+ int doubleBuffer;
+
+ /*
+ * Set the background for the window and create a graphics context for use
+ * during redisplay.
+ */
+
+ bgBorder = Tk_Get3DBorderFromObj(squarePtr->tkwin,
+ squarePtr->bgBorderPtr);
+ Tk_SetWindowBackground(squarePtr->tkwin,
+ Tk_3DBorderColor(bgBorder)->pixel);
+ Tcl_GetBooleanFromObj(NULL, squarePtr->doubleBufferPtr, &doubleBuffer);
+ if ((squarePtr->gc == None) && (doubleBuffer)) {
+ XGCValues gcValues;
+ gcValues.function = GXcopy;
+ gcValues.graphics_exposures = False;
+ squarePtr->gc = Tk_GetGC(squarePtr->tkwin,
+ GCFunction|GCGraphicsExposures, &gcValues);
+ }
+
+ /*
+ * Register the desired geometry for the window. Then arrange for the
+ * window to be redisplayed.
+ */
+
+ Tk_GeometryRequest(squarePtr->tkwin, 200, 150);
+ Tk_GetPixelsFromObj(NULL, squarePtr->tkwin, squarePtr->borderWidthPtr,
+ &borderWidth);
+ Tk_SetInternalBorder(squarePtr->tkwin, borderWidth);
+ if (!squarePtr->updatePending) {
+ Tcl_DoWhenIdle(SquareDisplay, squarePtr);
+ squarePtr->updatePending = 1;
+ }
+ KeepInWindow(squarePtr);
+ return TCL_OK;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * SquareObjEventProc --
+ *
+ * This procedure is invoked by the Tk dispatcher for various events on
+ * squares.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * When the window gets deleted, internal structures get cleaned up. When
+ * it gets exposed, it is redisplayed.
+ *
+ *--------------------------------------------------------------
+ */
+
+static void
+SquareObjEventProc(
+ ClientData clientData, /* Information about window. */
+ XEvent *eventPtr) /* Information about event. */
+{
+ Square *squarePtr = clientData;
+
+ if (eventPtr->type == Expose) {
+ if (!squarePtr->updatePending) {
+ Tcl_DoWhenIdle(SquareDisplay, squarePtr);
+ squarePtr->updatePending = 1;
+ }
+ } else if (eventPtr->type == ConfigureNotify) {
+ KeepInWindow(squarePtr);
+ if (!squarePtr->updatePending) {
+ Tcl_DoWhenIdle(SquareDisplay, squarePtr);
+ squarePtr->updatePending = 1;
+ }
+ } else if (eventPtr->type == DestroyNotify) {
+ if (squarePtr->tkwin != NULL) {
+ Tk_FreeConfigOptions((char *) squarePtr, squarePtr->optionTable,
+ squarePtr->tkwin);
+ if (squarePtr->gc != None) {
+ Tk_FreeGC(squarePtr->display, squarePtr->gc);
+ }
+ squarePtr->tkwin = NULL;
+ Tcl_DeleteCommandFromToken(squarePtr->interp,
+ squarePtr->widgetCmd);
+ }
+ if (squarePtr->updatePending) {
+ Tcl_CancelIdleCall(SquareDisplay, squarePtr);
+ }
+ Tcl_EventuallyFree(squarePtr, (Tcl_FreeProc *) SquareDestroy);
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * SquareDeletedProc --
+ *
+ * This procedure is invoked when a widget command is deleted. If the
+ * widget isn't already in the process of being destroyed, this command
+ * destroys it.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The widget is destroyed.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+SquareDeletedProc(
+ ClientData clientData) /* Pointer to widget record for widget. */
+{
+ Square *squarePtr = clientData;
+ Tk_Window tkwin = squarePtr->tkwin;
+
+ /*
+ * This procedure could be invoked either because the window was destroyed
+ * and the command was then deleted (in which case tkwin is NULL) or
+ * because the command was deleted, and then this procedure destroys the
+ * widget.
+ */
+
+ if (tkwin != NULL) {
+ Tk_DestroyWindow(tkwin);
+ }
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * SquareDisplay --
+ *
+ * This procedure redraws the contents of a square window. It is invoked
+ * as a do-when-idle handler, so it only runs when there's nothing else
+ * for the application to do.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Information appears on the screen.
+ *
+ *--------------------------------------------------------------
+ */
+
+static void
+SquareDisplay(
+ ClientData clientData) /* Information about window. */
+{
+ Square *squarePtr = clientData;
+ Tk_Window tkwin = squarePtr->tkwin;
+ Pixmap pm = None;
+ Drawable d;
+ int borderWidth, size, relief;
+ Tk_3DBorder bgBorder, fgBorder;
+ int doubleBuffer;
+
+ squarePtr->updatePending = 0;
+ if (!Tk_IsMapped(tkwin)) {
+ return;
+ }
+
+ /*
+ * Create a pixmap for double-buffering, if necessary.
+ */
+
+ Tcl_GetBooleanFromObj(NULL, squarePtr->doubleBufferPtr, &doubleBuffer);
+ if (doubleBuffer) {
+ pm = Tk_GetPixmap(Tk_Display(tkwin), Tk_WindowId(tkwin),
+ Tk_Width(tkwin), Tk_Height(tkwin),
+ DefaultDepthOfScreen(Tk_Screen(tkwin)));
+ d = pm;
+ } else {
+ d = Tk_WindowId(tkwin);
+ }
+
+ /*
+ * Redraw the widget's background and border.
+ */
+
+ Tk_GetPixelsFromObj(NULL, squarePtr->tkwin, squarePtr->borderWidthPtr,
+ &borderWidth);
+ bgBorder = Tk_Get3DBorderFromObj(squarePtr->tkwin,
+ squarePtr->bgBorderPtr);
+ Tk_GetReliefFromObj(NULL, squarePtr->reliefPtr, &relief);
+ Tk_Fill3DRectangle(tkwin, d, bgBorder, 0, 0, Tk_Width(tkwin),
+ Tk_Height(tkwin), borderWidth, relief);
+
+ /*
+ * Display the square.
+ */
+
+ Tk_GetPixelsFromObj(NULL, squarePtr->tkwin, squarePtr->sizeObjPtr, &size);
+ fgBorder = Tk_Get3DBorderFromObj(squarePtr->tkwin,
+ squarePtr->fgBorderPtr);
+ Tk_Fill3DRectangle(tkwin, d, fgBorder, squarePtr->x, squarePtr->y, size,
+ size, borderWidth, TK_RELIEF_RAISED);
+
+ /*
+ * If double-buffered, copy to the screen and release the pixmap.
+ */
+
+ if (doubleBuffer) {
+ XCopyArea(Tk_Display(tkwin), pm, Tk_WindowId(tkwin), squarePtr->gc,
+ 0, 0, (unsigned) Tk_Width(tkwin), (unsigned) Tk_Height(tkwin),
+ 0, 0);
+ Tk_FreePixmap(Tk_Display(tkwin), pm);
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * SquareDestroy --
+ *
+ * This procedure is invoked by Tcl_EventuallyFree or Tcl_Release to
+ * clean up the internal structure of a square at a safe time (when
+ * no-one is using it anymore).
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Everything associated with the square is freed up.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+SquareDestroy(
+ void *memPtr) /* Info about square widget. */
+{
+ Square *squarePtr = memPtr;
+
+ ckfree(squarePtr);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * KeepInWindow --
+ *
+ * Adjust the position of the square if necessary to keep it in the
+ * widget's window.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The x and y position of the square are adjusted if necessary to keep
+ * the square in the window.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+KeepInWindow(
+ register Square *squarePtr) /* Pointer to widget record. */
+{
+ int i, bd, relief;
+ int borderWidth, size;
+
+ Tk_GetPixelsFromObj(NULL, squarePtr->tkwin, squarePtr->borderWidthPtr,
+ &borderWidth);
+ Tk_GetPixelsFromObj(NULL, squarePtr->tkwin, squarePtr->xPtr,
+ &squarePtr->x);
+ Tk_GetPixelsFromObj(NULL, squarePtr->tkwin, squarePtr->yPtr,
+ &squarePtr->y);
+ Tk_GetPixelsFromObj(NULL, squarePtr->tkwin, squarePtr->sizeObjPtr, &size);
+ Tk_GetReliefFromObj(NULL, squarePtr->reliefPtr, &relief);
+ bd = 0;
+ if (relief != TK_RELIEF_FLAT) {
+ bd = borderWidth;
+ }
+ i = (Tk_Width(squarePtr->tkwin) - bd) - (squarePtr->x + size);
+ if (i < 0) {
+ squarePtr->x += i;
+ }
+ i = (Tk_Height(squarePtr->tkwin) - bd) - (squarePtr->y + size);
+ if (i < 0) {
+ squarePtr->y += i;
+ }
+ if (squarePtr->x < bd) {
+ squarePtr->x = bd;
+ }
+ if (squarePtr->y < bd) {
+ squarePtr->y = bd;
+ }
+}
+
+/*
+ * Local Variables:
+ * mode: c
+ * c-basic-offset: 4
+ * fill-column: 78
+ * End:
+ */
diff --git a/tk8.6/generic/tkStubInit.c b/tk8.6/generic/tkStubInit.c
new file mode 100644
index 0000000..f08d7f4
--- /dev/null
+++ b/tk8.6/generic/tkStubInit.c
@@ -0,0 +1,1110 @@
+/*
+ * 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.
+ */
+
+#include "tkInt.h"
+
+#if !(defined(_WIN32) || defined(MAC_OSX_TK))
+/* UNIX */
+#define UNIX_TK
+#include "tkUnixInt.h"
+#endif
+
+#ifdef _WIN32
+#include "tkWinInt.h"
+#endif
+
+#if defined(MAC_OSX_TK)
+/* we could have used _TKMACINT */
+#include "tkMacOSXInt.h"
+#endif
+
+/* TODO: These ought to come in some other way */
+#include "tkPlatDecls.h"
+#include "tkIntXlibDecls.h"
+
+static const TkIntStubs tkIntStubs;
+MODULE_SCOPE const TkStubs tkStubs;
+
+/*
+ * Remove macro that might interfere with the definition below.
+ */
+
+#undef Tk_MainEx
+
+#ifdef _WIN32
+
+int
+TkpCmapStressed(Tk_Window tkwin, Colormap colormap)
+{
+ /* dummy implementation, no need to do anything */
+ return 0;
+}
+void
+TkpSync(Display *display)
+{
+ /* dummy implementation, no need to do anything */
+}
+
+void
+TkCreateXEventSource(void)
+{
+ TkWinXInit(Tk_GetHINSTANCE());
+}
+
+# define TkUnixContainerId 0
+# define TkUnixDoOneXEvent 0
+# define TkUnixSetMenubar 0
+# define TkWmCleanup (void (*)(TkDisplay *)) TkpSync
+# define TkSendCleanup (void (*)(TkDisplay *)) TkpSync
+# define TkpTestsendCmd 0
+
+#else /* !_WIN32 */
+
+/*
+ * Make sure that extensions which call XParseColor through the stub
+ * table, call TkParseColor instead. [Bug 3486474]
+ */
+# define XParseColor TkParseColor
+
+# ifdef __CYGWIN__
+
+/*
+ * Trick, so we don't have to include <windows.h> here, which in any
+ * case lacks this function anyway.
+ */
+
+#define GET_MODULE_HANDLE_EX_FLAG_FROM_ADDRESS 0x00000004
+int __stdcall GetModuleHandleExW(unsigned int, const char *, void *);
+
+void *Tk_GetHINSTANCE()
+{
+ void *hInstance = NULL;
+
+ GetModuleHandleExW(GET_MODULE_HANDLE_EX_FLAG_FROM_ADDRESS,
+ (const char *) &tkIntStubs, &hInstance);
+ return hInstance;
+}
+
+void
+TkSetPixmapColormap(
+ Pixmap pixmap,
+ Colormap colormap)
+{
+}
+
+void
+TkpPrintWindowId(
+ char *buf, /* Pointer to string large enough to hold
+ * the hex representation of a pointer. */
+ Window window) /* Window to be printed into buffer. */
+{
+ sprintf(buf, "%#08lx", (unsigned long) (window));
+}
+
+int
+TkPutImage(
+ unsigned long *colors, /* Array of pixel values used by this image.
+ * May be NULL. */
+ int ncolors, /* Number of colors used, or 0. */
+ Display *display,
+ Drawable d, /* Destination drawable. */
+ GC gc,
+ XImage *image, /* Source image. */
+ int src_x, int src_y, /* Offset of subimage. */
+ int dest_x, int dest_y, /* Position of subimage origin in drawable. */
+ unsigned int width, unsigned int height)
+ /* Dimensions of subimage. */
+{
+ return XPutImage(display, d, gc, image, src_x, src_y, dest_x, dest_y, width, height);
+}
+
+TkRegion TkCreateRegion()
+{
+ return (TkRegion) XCreateRegion();
+}
+
+void TkDestroyRegion(TkRegion r)
+{
+ XDestroyRegion((Region)r);
+}
+
+void TkSetRegion(Display *d, GC g, TkRegion r)
+{
+ XSetRegion(d, g, (Region)r);
+}
+
+void TkUnionRectWithRegion(XRectangle *a, TkRegion b, TkRegion c)
+{
+ XUnionRectWithRegion(a, (Region) b, (Region) c);
+}
+
+void TkClipBox(TkRegion a, XRectangle *b)
+{
+ XClipBox((Region) a, b);
+}
+
+void TkIntersectRegion(TkRegion a, TkRegion b, TkRegion c)
+{
+ XIntersectRegion((Region) a, (Region) b, (Region) c);
+}
+
+int TkRectInRegion (TkRegion r, int a, int b, unsigned int c, unsigned int d)
+{
+ return XRectInRegion((Region) r, a, b, c, d);
+}
+
+void TkSubtractRegion (TkRegion a, TkRegion b, TkRegion c)
+{
+ XSubtractRegion((Region) a, (Region) b, (Region) c);
+}
+
+ /* TODO: To be implemented for Cygwin */
+# define Tk_AttachHWND 0
+# define Tk_GetHWND 0
+# define Tk_HWNDToWindow 0
+# define Tk_PointerEvent 0
+# define Tk_TranslateWinEvent 0
+# define TkAlignImageData 0
+# define TkGenerateActivateEvents 0
+# define TkpGetMS 0
+# define TkPointerDeadWindow 0
+# define TkpSetCapture 0
+# define TkpSetCursor 0
+# define TkWinCancelMouseTimer 0
+# define TkWinClipboardRender 0
+# define TkWinEmbeddedEventProc 0
+# define TkWinFillRect 0
+# define TkWinGetBorderPixels 0
+# define TkWinGetDrawableDC 0
+# define TkWinGetModifierState 0
+# define TkWinGetSystemPalette 0
+# define TkWinGetWrapperWindow 0
+# define TkWinHandleMenuEvent 0
+# define TkWinIndexOfColor 0
+# define TkWinReleaseDrawableDC 0
+# define TkWinResendEvent 0
+# define TkWinSelectPalette 0
+# define TkWinSetMenu 0
+# define TkWinSetWindowPos 0
+# define TkWinWmCleanup 0
+# define TkWinXCleanup 0
+# define TkWinXInit 0
+# define TkWinSetForegroundWindow 0
+# define TkWinDialogDebug 0
+# define TkWinGetMenuSystemDefault 0
+# define TkWinGetPlatformId 0
+# define TkWinSetHINSTANCE 0
+# define TkWinGetPlatformTheme 0
+# define TkWinChildProc 0
+
+# elif !defined(MAC_OSX_TK) /* UNIX */
+
+# undef TkClipBox
+# undef TkCreateRegion
+# undef TkDestroyRegion
+# undef TkIntersectRegion
+# undef TkRectInRegion
+# undef TkSetRegion
+# undef TkUnionRectWithRegion
+# undef TkSubtractRegion
+
+# define TkClipBox (void (*) (TkRegion, XRectangle *)) XClipBox
+# define TkCreateRegion (TkRegion (*) ()) XCreateRegion
+# define TkDestroyRegion (void (*) (TkRegion)) XDestroyRegion
+# define TkIntersectRegion (void (*) (TkRegion, TkRegion, TkRegion)) XIntersectRegion
+# define TkRectInRegion (int (*) (TkRegion, int, int, unsigned int, unsigned int)) XRectInRegion
+# define TkSetRegion (void (*) (Display *, GC, TkRegion)) XSetRegion
+# define TkUnionRectWithRegion (void (*) (XRectangle *, TkRegion, TkRegion)) XUnionRectWithRegion
+# define TkSubtractRegion (void (*) (TkRegion, TkRegion, TkRegion)) XSubtractRegion
+# endif
+#endif /* !_WIN32 */
+
+/*
+ * WARNING: The contents of this file is automatically generated by the
+ * tools/genStubs.tcl script. Any modifications to the function declarations
+ * below should be made in the generic/tk.decls script.
+ */
+
+/* !BEGIN!: Do not edit below this line. */
+
+static const TkIntStubs tkIntStubs = {
+ TCL_STUB_MAGIC,
+ 0,
+ TkAllocWindow, /* 0 */
+ TkBezierPoints, /* 1 */
+ TkBezierScreenPoints, /* 2 */
+ 0, /* 3 */
+ TkBindEventProc, /* 4 */
+ TkBindFree, /* 5 */
+ TkBindInit, /* 6 */
+ TkChangeEventWindow, /* 7 */
+ TkClipInit, /* 8 */
+ TkComputeAnchor, /* 9 */
+ 0, /* 10 */
+ 0, /* 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 */
+ 0, /* 76 */
+ TkQueueEventForAllChildren, /* 77 */
+ TkReadBitmapFile, /* 78 */
+ TkScrollWindow, /* 79 */
+ TkSelDeadWindow, /* 80 */
+ TkSelEventProc, /* 81 */
+ TkSelInit, /* 82 */
+ TkSelPropProc, /* 83 */
+ 0, /* 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 */
+ TkClipBox, /* 113 */
+ TkCreateRegion, /* 114 */
+ TkDestroyRegion, /* 115 */
+ TkIntersectRegion, /* 116 */
+ TkRectInRegion, /* 117 */
+ TkSetRegion, /* 118 */
+ TkUnionRectWithRegion, /* 119 */
+ 0, /* 120 */
+#if !(defined(_WIN32) || defined(MAC_OSX_TK)) /* X11 */
+ 0, /* 121 */
+#endif /* X11 */
+#if defined(_WIN32) /* WIN */
+ 0, /* 121 */
+#endif /* WIN */
+#ifdef MAC_OSX_TK /* AQUA */
+ 0, /* 121 */ /* Dummy entry for stubs table backwards compatibility */
+ TkpCreateNativeBitmap, /* 121 */
+#endif /* AQUA */
+#if !(defined(_WIN32) || defined(MAC_OSX_TK)) /* X11 */
+ 0, /* 122 */
+#endif /* X11 */
+#if defined(_WIN32) /* WIN */
+ 0, /* 122 */
+#endif /* WIN */
+#ifdef MAC_OSX_TK /* AQUA */
+ 0, /* 122 */ /* Dummy entry for stubs table backwards compatibility */
+ TkpDefineNativeBitmaps, /* 122 */
+#endif /* AQUA */
+ 0, /* 123 */
+#if !(defined(_WIN32) || defined(MAC_OSX_TK)) /* X11 */
+ 0, /* 124 */
+#endif /* X11 */
+#if defined(_WIN32) /* WIN */
+ 0, /* 124 */
+#endif /* WIN */
+#ifdef MAC_OSX_TK /* AQUA */
+ 0, /* 124 */ /* Dummy entry for stubs table backwards compatibility */
+ TkpGetNativeAppBitmap, /* 124 */
+#endif /* AQUA */
+ 0, /* 125 */
+ 0, /* 126 */
+ 0, /* 127 */
+ 0, /* 128 */
+ 0, /* 129 */
+ 0, /* 130 */
+ 0, /* 131 */
+ 0, /* 132 */
+ 0, /* 133 */
+ 0, /* 134 */
+ TkpDrawHighlightBorder, /* 135 */
+ TkSetFocusWin, /* 136 */
+ TkpSetKeycodeAndState, /* 137 */
+ TkpGetKeySym, /* 138 */
+ TkpInitKeymapInfo, /* 139 */
+ TkPhotoGetValidRegion, /* 140 */
+ TkWmStackorderToplevel, /* 141 */
+ TkFocusFree, /* 142 */
+ TkClipCleanup, /* 143 */
+ TkGCCleanup, /* 144 */
+ TkSubtractRegion, /* 145 */
+ TkStylePkgInit, /* 146 */
+ TkStylePkgFree, /* 147 */
+ TkToplevelWindowForCommand, /* 148 */
+ TkGetOptionSpec, /* 149 */
+ TkMakeRawCurve, /* 150 */
+ TkMakeRawCurvePostscript, /* 151 */
+ TkpDrawFrame, /* 152 */
+ TkCreateThreadExitHandler, /* 153 */
+ TkDeleteThreadExitHandler, /* 154 */
+ 0, /* 155 */
+ TkpTestembedCmd, /* 156 */
+ TkpTesttextCmd, /* 157 */
+ TkSelGetSelection, /* 158 */
+ TkTextGetIndex, /* 159 */
+ TkTextIndexBackBytes, /* 160 */
+ TkTextIndexForwBytes, /* 161 */
+ TkTextMakeByteIndex, /* 162 */
+ TkTextPrintIndex, /* 163 */
+ TkTextSetMark, /* 164 */
+ TkTextXviewCmd, /* 165 */
+ TkTextChanged, /* 166 */
+ TkBTreeNumLines, /* 167 */
+ TkTextInsertDisplayProc, /* 168 */
+ TkStateParseProc, /* 169 */
+ TkStatePrintProc, /* 170 */
+ TkCanvasDashParseProc, /* 171 */
+ TkCanvasDashPrintProc, /* 172 */
+ TkOffsetParseProc, /* 173 */
+ TkOffsetPrintProc, /* 174 */
+ TkPixelParseProc, /* 175 */
+ TkPixelPrintProc, /* 176 */
+ TkOrientParseProc, /* 177 */
+ TkOrientPrintProc, /* 178 */
+ TkSmoothParseProc, /* 179 */
+ TkSmoothPrintProc, /* 180 */
+ TkDrawAngledTextLayout, /* 181 */
+ TkUnderlineAngledTextLayout, /* 182 */
+ TkIntersectAngledTextLayout, /* 183 */
+ TkDrawAngledChars, /* 184 */
+};
+
+static const TkIntPlatStubs tkIntPlatStubs = {
+ TCL_STUB_MAGIC,
+ 0,
+#if defined(_WIN32) || defined(__CYGWIN__) /* WIN */
+ TkAlignImageData, /* 0 */
+ 0, /* 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 */
+ TkWinSetHINSTANCE, /* 34 */
+ TkWinGetPlatformTheme, /* 35 */
+ TkWinChildProc, /* 36 */
+ TkCreateXEventSource, /* 37 */
+ TkpCmapStressed, /* 38 */
+ TkpSync, /* 39 */
+ TkUnixContainerId, /* 40 */
+ TkUnixDoOneXEvent, /* 41 */
+ TkUnixSetMenubar, /* 42 */
+ TkWmCleanup, /* 43 */
+ TkSendCleanup, /* 44 */
+ TkpTestsendCmd, /* 45 */
+#endif /* WIN */
+#ifdef MAC_OSX_TK /* AQUA */
+ TkGenerateActivateEvents, /* 0 */
+ 0, /* 1 */
+ 0, /* 2 */
+ TkPointerDeadWindow, /* 3 */
+ TkpSetCapture, /* 4 */
+ TkpSetCursor, /* 5 */
+ TkpWmSetState, /* 6 */
+ TkAboutDlg, /* 7 */
+ TkMacOSXButtonKeyState, /* 8 */
+ TkMacOSXClearMenubarActive, /* 9 */
+ TkMacOSXDispatchMenuEvent, /* 10 */
+ TkMacOSXInstallCursor, /* 11 */
+ TkMacOSXHandleTearoffMenu, /* 12 */
+ 0, /* 13 */
+ TkMacOSXDoHLEvent, /* 14 */
+ 0, /* 15 */
+ TkMacOSXGetXWindow, /* 16 */
+ TkMacOSXGrowToplevel, /* 17 */
+ TkMacOSXHandleMenuSelect, /* 18 */
+ 0, /* 19 */
+ 0, /* 20 */
+ TkMacOSXInvalidateWindow, /* 21 */
+ TkMacOSXIsCharacterMissing, /* 22 */
+ TkMacOSXMakeRealWindowExist, /* 23 */
+ TkMacOSXMakeStippleMap, /* 24 */
+ TkMacOSXMenuClick, /* 25 */
+ TkMacOSXRegisterOffScreenWindow, /* 26 */
+ TkMacOSXResizable, /* 27 */
+ TkMacOSXSetHelpMenuItemCount, /* 28 */
+ TkMacOSXSetScrollbarGrow, /* 29 */
+ TkMacOSXSetUpClippingRgn, /* 30 */
+ TkMacOSXSetUpGraphicsPort, /* 31 */
+ TkMacOSXUpdateClipRgn, /* 32 */
+ TkMacOSXUnregisterMacWindow, /* 33 */
+ TkMacOSXUseMenuID, /* 34 */
+ TkMacOSXVisableClipRgn, /* 35 */
+ TkMacOSXWinBounds, /* 36 */
+ TkMacOSXWindowOffset, /* 37 */
+ TkSetMacColor, /* 38 */
+ TkSetWMName, /* 39 */
+ TkSuspendClipboard, /* 40 */
+ TkMacOSXZoomToplevel, /* 41 */
+ Tk_TopCoordsToWindow, /* 42 */
+ TkMacOSXContainerId, /* 43 */
+ TkMacOSXGetHostToplevel, /* 44 */
+ TkMacOSXPreprocessMenu, /* 45 */
+ TkpIsWindowFloating, /* 46 */
+ TkMacOSXGetCapture, /* 47 */
+ 0, /* 48 */
+ TkGetTransientMaster, /* 49 */
+ TkGenerateButtonEvent, /* 50 */
+ TkGenWMDestroyEvent, /* 51 */
+ TkMacOSXSetDrawingEnabled, /* 52 */
+ TkpGetMS, /* 53 */
+ TkMacOSXDrawable, /* 54 */
+ TkpScanWindowId, /* 55 */
+#endif /* AQUA */
+#if !(defined(_WIN32) || defined(__CYGWIN__) || defined(MAC_OSX_TK)) /* X11 */
+ TkCreateXEventSource, /* 0 */
+ 0, /* 1 */
+ 0, /* 2 */
+ TkpCmapStressed, /* 3 */
+ TkpSync, /* 4 */
+ TkUnixContainerId, /* 5 */
+ TkUnixDoOneXEvent, /* 6 */
+ TkUnixSetMenubar, /* 7 */
+ TkpScanWindowId, /* 8 */
+ TkWmCleanup, /* 9 */
+ TkSendCleanup, /* 10 */
+ 0, /* 11 */
+ TkpWmSetState, /* 12 */
+ TkpTestsendCmd, /* 13 */
+#endif /* X11 */
+};
+
+static const TkIntXlibStubs tkIntXlibStubs = {
+ TCL_STUB_MAGIC,
+ 0,
+#if defined(_WIN32) || defined(__CYGWIN__) /* WIN */
+ 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 */
+ 0, /* 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 */
+ XFlush, /* 107 */
+ XGrabServer, /* 108 */
+ XUngrabServer, /* 109 */
+ XFree, /* 110 */
+ XNoOp, /* 111 */
+ XSynchronize, /* 112 */
+ XSync, /* 113 */
+ XVisualIDFromVisual, /* 114 */
+#endif /* WIN */
+#ifdef MAC_OSX_TK /* AQUA */
+ 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 */
+ XQueryTree, /* 90 */
+ XSync, /* 91 */
+#endif /* AQUA */
+};
+
+static const TkPlatStubs tkPlatStubs = {
+ TCL_STUB_MAGIC,
+ 0,
+#if defined(_WIN32) || defined(__CYGWIN__) /* WIN */
+ Tk_AttachHWND, /* 0 */
+ Tk_GetHINSTANCE, /* 1 */
+ Tk_GetHWND, /* 2 */
+ Tk_HWNDToWindow, /* 3 */
+ Tk_PointerEvent, /* 4 */
+ Tk_TranslateWinEvent, /* 5 */
+#endif /* WIN */
+#ifdef MAC_OSX_TK /* AQUA */
+ Tk_MacOSXSetEmbedHandler, /* 0 */
+ Tk_MacOSXTurnOffMenus, /* 1 */
+ Tk_MacOSXTkOwnsCursor, /* 2 */
+ TkMacOSXInitMenus, /* 3 */
+ TkMacOSXInitAppleEvents, /* 4 */
+ TkGenWMConfigureEvent, /* 5 */
+ TkMacOSXInvalClipRgns, /* 6 */
+ TkMacOSXGetDrawablePort, /* 7 */
+ TkMacOSXGetRootControl, /* 8 */
+ Tk_MacOSXSetupTkNotifier, /* 9 */
+ Tk_MacOSXIsAppInFront, /* 10 */
+#endif /* AQUA */
+};
+
+static const TkStubHooks tkStubHooks = {
+ &tkPlatStubs,
+ &tkIntStubs,
+ &tkIntPlatStubs,
+ &tkIntXlibStubs
+};
+
+const TkStubs tkStubs = {
+ TCL_STUB_MAGIC,
+ &tkStubHooks,
+ Tk_MainLoop, /* 0 */
+ Tk_3DBorderColor, /* 1 */
+ Tk_3DBorderGC, /* 2 */
+ Tk_3DHorizontalBevel, /* 3 */
+ Tk_3DVerticalBevel, /* 4 */
+ Tk_AddOption, /* 5 */
+ Tk_BindEvent, /* 6 */
+ Tk_CanvasDrawableCoords, /* 7 */
+ Tk_CanvasEventuallyRedraw, /* 8 */
+ Tk_CanvasGetCoord, /* 9 */
+ Tk_CanvasGetTextInfo, /* 10 */
+ Tk_CanvasPsBitmap, /* 11 */
+ Tk_CanvasPsColor, /* 12 */
+ Tk_CanvasPsFont, /* 13 */
+ Tk_CanvasPsPath, /* 14 */
+ Tk_CanvasPsStipple, /* 15 */
+ Tk_CanvasPsY, /* 16 */
+ Tk_CanvasSetStippleOrigin, /* 17 */
+ Tk_CanvasTagsParseProc, /* 18 */
+ Tk_CanvasTagsPrintProc, /* 19 */
+ Tk_CanvasTkwin, /* 20 */
+ Tk_CanvasWindowCoords, /* 21 */
+ Tk_ChangeWindowAttributes, /* 22 */
+ Tk_CharBbox, /* 23 */
+ Tk_ClearSelection, /* 24 */
+ Tk_ClipboardAppend, /* 25 */
+ Tk_ClipboardClear, /* 26 */
+ Tk_ConfigureInfo, /* 27 */
+ Tk_ConfigureValue, /* 28 */
+ Tk_ConfigureWidget, /* 29 */
+ Tk_ConfigureWindow, /* 30 */
+ Tk_ComputeTextLayout, /* 31 */
+ Tk_CoordsToWindow, /* 32 */
+ Tk_CreateBinding, /* 33 */
+ Tk_CreateBindingTable, /* 34 */
+ Tk_CreateErrorHandler, /* 35 */
+ Tk_CreateEventHandler, /* 36 */
+ Tk_CreateGenericHandler, /* 37 */
+ Tk_CreateImageType, /* 38 */
+ Tk_CreateItemType, /* 39 */
+ Tk_CreatePhotoImageFormat, /* 40 */
+ Tk_CreateSelHandler, /* 41 */
+ Tk_CreateWindow, /* 42 */
+ Tk_CreateWindowFromPath, /* 43 */
+ Tk_DefineBitmap, /* 44 */
+ Tk_DefineCursor, /* 45 */
+ Tk_DeleteAllBindings, /* 46 */
+ Tk_DeleteBinding, /* 47 */
+ Tk_DeleteBindingTable, /* 48 */
+ Tk_DeleteErrorHandler, /* 49 */
+ Tk_DeleteEventHandler, /* 50 */
+ Tk_DeleteGenericHandler, /* 51 */
+ Tk_DeleteImage, /* 52 */
+ Tk_DeleteSelHandler, /* 53 */
+ Tk_DestroyWindow, /* 54 */
+ Tk_DisplayName, /* 55 */
+ Tk_DistanceToTextLayout, /* 56 */
+ Tk_Draw3DPolygon, /* 57 */
+ Tk_Draw3DRectangle, /* 58 */
+ Tk_DrawChars, /* 59 */
+ Tk_DrawFocusHighlight, /* 60 */
+ Tk_DrawTextLayout, /* 61 */
+ Tk_Fill3DPolygon, /* 62 */
+ Tk_Fill3DRectangle, /* 63 */
+ Tk_FindPhoto, /* 64 */
+ Tk_FontId, /* 65 */
+ Tk_Free3DBorder, /* 66 */
+ Tk_FreeBitmap, /* 67 */
+ Tk_FreeColor, /* 68 */
+ Tk_FreeColormap, /* 69 */
+ Tk_FreeCursor, /* 70 */
+ Tk_FreeFont, /* 71 */
+ Tk_FreeGC, /* 72 */
+ Tk_FreeImage, /* 73 */
+ Tk_FreeOptions, /* 74 */
+ Tk_FreePixmap, /* 75 */
+ Tk_FreeTextLayout, /* 76 */
+ Tk_FreeXId, /* 77 */
+ Tk_GCForColor, /* 78 */
+ Tk_GeometryRequest, /* 79 */
+ Tk_Get3DBorder, /* 80 */
+ Tk_GetAllBindings, /* 81 */
+ Tk_GetAnchor, /* 82 */
+ Tk_GetAtomName, /* 83 */
+ Tk_GetBinding, /* 84 */
+ Tk_GetBitmap, /* 85 */
+ Tk_GetBitmapFromData, /* 86 */
+ Tk_GetCapStyle, /* 87 */
+ Tk_GetColor, /* 88 */
+ Tk_GetColorByValue, /* 89 */
+ Tk_GetColormap, /* 90 */
+ Tk_GetCursor, /* 91 */
+ Tk_GetCursorFromData, /* 92 */
+ Tk_GetFont, /* 93 */
+ Tk_GetFontFromObj, /* 94 */
+ Tk_GetFontMetrics, /* 95 */
+ Tk_GetGC, /* 96 */
+ Tk_GetImage, /* 97 */
+ Tk_GetImageMasterData, /* 98 */
+ Tk_GetItemTypes, /* 99 */
+ Tk_GetJoinStyle, /* 100 */
+ Tk_GetJustify, /* 101 */
+ Tk_GetNumMainWindows, /* 102 */
+ Tk_GetOption, /* 103 */
+ Tk_GetPixels, /* 104 */
+ Tk_GetPixmap, /* 105 */
+ Tk_GetRelief, /* 106 */
+ Tk_GetRootCoords, /* 107 */
+ Tk_GetScrollInfo, /* 108 */
+ Tk_GetScreenMM, /* 109 */
+ Tk_GetSelection, /* 110 */
+ Tk_GetUid, /* 111 */
+ Tk_GetVisual, /* 112 */
+ Tk_GetVRootGeometry, /* 113 */
+ Tk_Grab, /* 114 */
+ Tk_HandleEvent, /* 115 */
+ Tk_IdToWindow, /* 116 */
+ Tk_ImageChanged, /* 117 */
+ Tk_Init, /* 118 */
+ Tk_InternAtom, /* 119 */
+ Tk_IntersectTextLayout, /* 120 */
+ Tk_MaintainGeometry, /* 121 */
+ Tk_MainWindow, /* 122 */
+ Tk_MakeWindowExist, /* 123 */
+ Tk_ManageGeometry, /* 124 */
+ Tk_MapWindow, /* 125 */
+ Tk_MeasureChars, /* 126 */
+ Tk_MoveResizeWindow, /* 127 */
+ Tk_MoveWindow, /* 128 */
+ Tk_MoveToplevelWindow, /* 129 */
+ Tk_NameOf3DBorder, /* 130 */
+ Tk_NameOfAnchor, /* 131 */
+ Tk_NameOfBitmap, /* 132 */
+ Tk_NameOfCapStyle, /* 133 */
+ Tk_NameOfColor, /* 134 */
+ Tk_NameOfCursor, /* 135 */
+ Tk_NameOfFont, /* 136 */
+ Tk_NameOfImage, /* 137 */
+ Tk_NameOfJoinStyle, /* 138 */
+ Tk_NameOfJustify, /* 139 */
+ Tk_NameOfRelief, /* 140 */
+ Tk_NameToWindow, /* 141 */
+ Tk_OwnSelection, /* 142 */
+ Tk_ParseArgv, /* 143 */
+ Tk_PhotoPutBlock_NoComposite, /* 144 */
+ Tk_PhotoPutZoomedBlock_NoComposite, /* 145 */
+ Tk_PhotoGetImage, /* 146 */
+ Tk_PhotoBlank, /* 147 */
+ Tk_PhotoExpand_Panic, /* 148 */
+ Tk_PhotoGetSize, /* 149 */
+ Tk_PhotoSetSize_Panic, /* 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 */
+ 0, /* 218 */
+ 0, /* 219 */
+ Tk_GetDash, /* 220 */
+ Tk_CreateOutline, /* 221 */
+ Tk_DeleteOutline, /* 222 */
+ Tk_ConfigOutlineGC, /* 223 */
+ Tk_ChangeOutlineGC, /* 224 */
+ Tk_ResetOutlineGC, /* 225 */
+ Tk_CanvasPsOutline, /* 226 */
+ Tk_SetTSOrigin, /* 227 */
+ Tk_CanvasGetCoordFromObj, /* 228 */
+ Tk_CanvasSetOffset, /* 229 */
+ Tk_DitherPhoto, /* 230 */
+ Tk_PostscriptBitmap, /* 231 */
+ Tk_PostscriptColor, /* 232 */
+ Tk_PostscriptFont, /* 233 */
+ Tk_PostscriptImage, /* 234 */
+ Tk_PostscriptPath, /* 235 */
+ Tk_PostscriptStipple, /* 236 */
+ Tk_PostscriptY, /* 237 */
+ Tk_PostscriptPhoto, /* 238 */
+ Tk_CreateClientMessageHandler, /* 239 */
+ Tk_DeleteClientMessageHandler, /* 240 */
+ Tk_CreateAnonymousWindow, /* 241 */
+ Tk_SetClassProcs, /* 242 */
+ Tk_SetInternalBorderEx, /* 243 */
+ Tk_SetMinimumRequestSize, /* 244 */
+ Tk_SetCaretPos, /* 245 */
+ Tk_PhotoPutBlock_Panic, /* 246 */
+ Tk_PhotoPutZoomedBlock_Panic, /* 247 */
+ Tk_CollapseMotionEvents, /* 248 */
+ Tk_RegisterStyleEngine, /* 249 */
+ Tk_GetStyleEngine, /* 250 */
+ Tk_RegisterStyledElement, /* 251 */
+ Tk_GetElementId, /* 252 */
+ Tk_CreateStyle, /* 253 */
+ Tk_GetStyle, /* 254 */
+ Tk_FreeStyle, /* 255 */
+ Tk_NameOfStyle, /* 256 */
+ Tk_AllocStyleFromObj, /* 257 */
+ Tk_GetStyleFromObj, /* 258 */
+ Tk_FreeStyleFromObj, /* 259 */
+ Tk_GetStyledElement, /* 260 */
+ Tk_GetElementSize, /* 261 */
+ Tk_GetElementBox, /* 262 */
+ Tk_GetElementBorderWidth, /* 263 */
+ Tk_DrawElement, /* 264 */
+ Tk_PhotoExpand, /* 265 */
+ Tk_PhotoPutBlock, /* 266 */
+ Tk_PhotoPutZoomedBlock, /* 267 */
+ Tk_PhotoSetSize, /* 268 */
+ Tk_GetUserInactiveTime, /* 269 */
+ Tk_ResetUserInactiveTime, /* 270 */
+ Tk_Interp, /* 271 */
+ Tk_CreateOldImageType, /* 272 */
+ Tk_CreateOldPhotoImageFormat, /* 273 */
+};
+
+/* !END!: Do not edit above this line. */
diff --git a/tk8.6/generic/tkStubLib.c b/tk8.6/generic/tkStubLib.c
new file mode 100644
index 0000000..ea48894
--- /dev/null
+++ b/tk8.6/generic/tkStubLib.c
@@ -0,0 +1,146 @@
+/*
+ * tkStubLib.c --
+ *
+ * Stub object that will be statically linked into extensions that want
+ * to access Tk.
+ *
+ * Copyright (c) 1998-1999 by Scriptics Corporation.
+ * Copyright (c) 1998 Paul Duffin.
+ *
+ * See the file "license.terms" for information on usage and redistribution of
+ * this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ */
+
+#include "tkInt.h"
+
+#ifdef _WIN32
+#include "tkWinInt.h"
+#endif
+
+#ifdef MAC_OSX_TK
+#include "tkMacOSXInt.h"
+#endif
+
+#if !(defined(_WIN32) || defined(MAC_OSX_TK))
+#include "tkUnixInt.h"
+#endif
+
+/* TODO: These ought to come in some other way */
+#include "tkPlatDecls.h"
+#include "tkIntXlibDecls.h"
+
+MODULE_SCOPE const TkStubs *tkStubsPtr;
+MODULE_SCOPE const TkPlatStubs *tkPlatStubsPtr;
+MODULE_SCOPE const TkIntStubs *tkIntStubsPtr;
+MODULE_SCOPE const TkIntPlatStubs *tkIntPlatStubsPtr;
+MODULE_SCOPE const TkIntXlibStubs *tkIntXlibStubsPtr;
+
+const TkStubs *tkStubsPtr = NULL;
+const TkPlatStubs *tkPlatStubsPtr = NULL;
+const TkIntStubs *tkIntStubsPtr = NULL;
+const TkIntPlatStubs *tkIntPlatStubsPtr = NULL;
+const TkIntXlibStubs *tkIntXlibStubsPtr = NULL;
+
+/*
+ * Use our own isdigit to avoid linking to libc on windows
+ */
+
+static int
+isDigit(const int c)
+{
+ return (c >= '0' && c <= '9');
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * 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.
+ *
+ *----------------------------------------------------------------------
+ */
+#undef Tk_InitStubs
+MODULE_SCOPE const char *
+Tk_InitStubs(
+ Tcl_Interp *interp,
+ const char *version,
+ int exact)
+{
+ const char *packageName = "Tk";
+ const char *errMsg = NULL;
+ ClientData clientData = NULL;
+ const char *actualVersion = tclStubsPtr->tcl_PkgRequireEx(interp,
+ packageName, version, 0, &clientData);
+ const TkStubs *stubsPtr = clientData;
+
+ if (actualVersion == NULL) {
+ return NULL;
+ }
+
+ if (exact) {
+ const char *p = version;
+ int count = 0;
+
+ while (*p) {
+ count += !isDigit(*p++);
+ }
+ if (count == 1) {
+ const char *q = actualVersion;
+
+ p = version;
+ while (*p && (*p == *q)) {
+ p++; q++;
+ }
+ if (*p || isDigit(*q)) {
+ /* Construct error message */
+ tclStubsPtr->tcl_PkgRequireEx(interp, packageName, version, 1, NULL);
+ return NULL;
+ }
+ } else {
+ actualVersion = tclStubsPtr->tcl_PkgRequireEx(interp, packageName,
+ version, 1, NULL);
+ if (actualVersion == NULL) {
+ return NULL;
+ }
+ }
+ }
+ if (stubsPtr == NULL) {
+ errMsg = "missing stub table pointer";
+ } else {
+ tkStubsPtr = stubsPtr;
+ if (stubsPtr->hooks) {
+ tkPlatStubsPtr = stubsPtr->hooks->tkPlatStubs;
+ tkIntStubsPtr = stubsPtr->hooks->tkIntStubs;
+ tkIntPlatStubsPtr = stubsPtr->hooks->tkIntPlatStubs;
+ tkIntXlibStubsPtr = stubsPtr->hooks->tkIntXlibStubs;
+ } else {
+ tkPlatStubsPtr = NULL;
+ tkIntStubsPtr = NULL;
+ tkIntPlatStubsPtr = NULL;
+ tkIntXlibStubsPtr = NULL;
+ }
+ return actualVersion;
+ }
+ tclStubsPtr->tcl_ResetResult(interp);
+ tclStubsPtr->tcl_AppendResult(interp, "Error loading ", packageName,
+ " (requested version ", version, ", actual version ",
+ actualVersion, "): ", errMsg, NULL);
+ return NULL;
+}
+
+/*
+ * Local Variables:
+ * mode: c
+ * c-basic-offset: 4
+ * fill-column: 78
+ * End:
+ */
diff --git a/tk8.6/generic/tkStyle.c b/tk8.6/generic/tkStyle.c
new file mode 100644
index 0000000..e7401df
--- /dev/null
+++ b/tk8.6/generic/tkStyle.c
@@ -0,0 +1,1554 @@
+/*
+ * tkStyle.c --
+ *
+ * This file implements the widget styles and themes support.
+ *
+ * Copyright (c) 1990-1993 The Regents of the University of California.
+ * Copyright (c) 1994-1997 Sun Microsystems, Inc.
+ *
+ * See the file "license.terms" for information on usage and redistribution of
+ * this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ */
+
+#include "tkInt.h"
+
+/*
+ * The following structure is used to cache widget option specs matching an
+ * element's required options defined by Tk_ElementOptionSpecs. It also holds
+ * information behind Tk_StyledElement opaque tokens.
+ */
+
+typedef struct StyledWidgetSpec {
+ struct StyledElement *elementPtr;
+ /* Pointer to the element holding this
+ * structure. */
+ Tk_OptionTable optionTable; /* Option table for the widget class using the
+ * element. */
+ const Tk_OptionSpec **optionsPtr;
+ /* Table of option spec pointers, matching the
+ * option list provided during element
+ * registration. Malloc'd. */
+} StyledWidgetSpec;
+
+/*
+ * Elements are declared using static templates. But static information must
+ * be completed by dynamic information only accessible at runtime. For each
+ * registered element, an instance of the following structure is stored in
+ * each style engine and used to cache information about the widget types
+ * (identified by their optionTable) that use the given element.
+ */
+
+typedef struct StyledElement {
+ struct Tk_ElementSpec *specPtr;
+ /* Filled with template provided during
+ * registration. NULL means no implementation
+ * is available for the current engine. */
+ int nbWidgetSpecs; /* Size of the array below. Number of distinct
+ * widget classes (actually, distinct option
+ * tables) that used the element so far. */
+ StyledWidgetSpec *widgetSpecs;
+ /* See above for the structure definition.
+ * Table grows dynamically as new widgets use
+ * the element. Malloc'd. */
+} StyledElement;
+
+/*
+ * The following structure holds information behind Tk_StyleEngine opaque
+ * tokens.
+ */
+
+typedef struct StyleEngine {
+ const char *name; /* Name of engine. Points to a hash key. */
+ StyledElement *elements; /* Table of widget element descriptors. Each
+ * element is indexed by a unique system-wide
+ * ID. Table grows dynamically as new elements
+ * are registered. Malloc'd. */
+ struct StyleEngine *parentPtr;
+ /* Parent engine. Engines may be layered to
+ * form a fallback chain, terminated by the
+ * default system engine. */
+} StyleEngine;
+
+/*
+ * Styles are instances of style engines. The following structure holds
+ * information behind Tk_Style opaque tokens.
+ */
+
+typedef struct Style {
+ const char *name; /* Name of style. Points to a hash key. */
+ StyleEngine *enginePtr; /* Style engine of which the style is an
+ * instance. */
+ ClientData clientData; /* Data provided during registration. */
+} Style;
+
+/*
+ * Each registered element uses an instance of the following structure.
+ */
+
+typedef struct Element {
+ const char *name; /* Name of element. Points to a hash key. */
+ int id; /* Id of element. */
+ int genericId; /* Id of generic element. */
+ int created; /* Boolean, whether the element was created
+ * explicitly (was registered) or implicitly
+ * (by a derived element). */
+} Element;
+
+/*
+ * Thread-local data.
+ */
+
+typedef struct ThreadSpecificData {
+ int nbInit; /* Number of calls to the init proc. */
+ Tcl_HashTable engineTable; /* Map a name to a style engine. Keys are
+ * strings, values are Tk_StyleEngine
+ * pointers. */
+ StyleEngine *defaultEnginePtr;
+ /* Default, core-defined style engine. Global
+ * fallback for all engines. */
+ Tcl_HashTable styleTable; /* Map a name to a style. Keys are strings,
+ * values are Tk_Style pointers.*/
+ int nbElements; /* Size of the below tables. */
+ Tcl_HashTable elementTable; /* Map a name to an element Id. Keys are
+ * strings, values are integer element IDs. */
+ Element *elements; /* Array of Elements. */
+} ThreadSpecificData;
+
+static Tcl_ThreadDataKey dataKey;
+
+/*
+ * Forward declarations for functions defined later in this file:
+ */
+
+static int CreateElement(const char *name, int create);
+static void DupStyleObjProc(Tcl_Obj *srcObjPtr,
+ Tcl_Obj *dupObjPtr);
+static void FreeElement(Element *elementPtr);
+static void FreeStyledElement(StyledElement *elementPtr);
+static void FreeStyleEngine(StyleEngine *enginePtr);
+static void FreeStyleObjProc(Tcl_Obj *objPtr);
+static void FreeWidgetSpec(StyledWidgetSpec *widgetSpecPtr);
+static StyledElement * GetStyledElement(StyleEngine *enginePtr,
+ int elementId);
+static StyledWidgetSpec*GetWidgetSpec(StyledElement *elementPtr,
+ Tk_OptionTable optionTable);
+static void InitElement(Element *elementPtr, const char *name,
+ int id, int genericId, int created);
+static void InitStyle(Style *stylePtr, const char *name,
+ StyleEngine *enginePtr, ClientData clientData);
+static void InitStyledElement(StyledElement *elementPtr);
+static void InitStyleEngine(StyleEngine *enginePtr,
+ const char *name, StyleEngine *parentPtr);
+static void InitWidgetSpec(StyledWidgetSpec *widgetSpecPtr,
+ StyledElement *elementPtr,
+ Tk_OptionTable optionTable);
+static int SetStyleFromAny(Tcl_Interp *interp, Tcl_Obj *objPtr);
+
+/*
+ * The following structure defines the implementation of the "style" Tcl
+ * object, used for drawing. The internalRep.twoPtrValue.ptr1 field of each
+ * style object points to the Style structure for the stylefont, or NULL.
+ */
+
+static const Tcl_ObjType styleObjType = {
+ "style", /* name */
+ FreeStyleObjProc, /* freeIntRepProc */
+ DupStyleObjProc, /* dupIntRepProc */
+ NULL, /* updateStringProc */
+ SetStyleFromAny /* setFromAnyProc */
+};
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * TkStylePkgInit --
+ *
+ * This function is called when an application is created. It initializes
+ * all the structures that are used by the style package on a per
+ * application basis.
+ *
+ * Results:
+ * Stores data in thread-local storage.
+ *
+ * Side effects:
+ * Memory allocated.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+void
+TkStylePkgInit(
+ TkMainInfo *mainPtr) /* The application being created. */
+{
+ ThreadSpecificData *tsdPtr =
+ Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
+
+ if (tsdPtr->nbInit != 0) {
+ return;
+ }
+
+ /*
+ * Initialize tables.
+ */
+
+ Tcl_InitHashTable(&tsdPtr->engineTable, TCL_STRING_KEYS);
+ Tcl_InitHashTable(&tsdPtr->styleTable, TCL_STRING_KEYS);
+ Tcl_InitHashTable(&tsdPtr->elementTable, TCL_STRING_KEYS);
+ tsdPtr->nbElements = 0;
+ tsdPtr->elements = NULL;
+
+ /*
+ * Create the default system engine.
+ */
+
+ tsdPtr->defaultEnginePtr = (StyleEngine *)
+ Tk_RegisterStyleEngine(NULL, NULL);
+
+ /*
+ * Create the default system style.
+ */
+
+ Tk_CreateStyle(NULL, (Tk_StyleEngine) tsdPtr->defaultEnginePtr, NULL);
+
+ tsdPtr->nbInit++;
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * TkStylePkgFree --
+ *
+ * This function is called when an application is deleted. It deletes all
+ * the structures that were used by the style package for this
+ * application.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Memory freed.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+void
+TkStylePkgFree(
+ TkMainInfo *mainPtr) /* The application being deleted. */
+{
+ ThreadSpecificData *tsdPtr =
+ Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
+ Tcl_HashSearch search;
+ Tcl_HashEntry *entryPtr;
+ StyleEngine *enginePtr;
+ int i;
+
+ tsdPtr->nbInit--;
+ if (tsdPtr->nbInit != 0) {
+ return;
+ }
+
+ /*
+ * Free styles.
+ */
+
+ entryPtr = Tcl_FirstHashEntry(&tsdPtr->styleTable, &search);
+ while (entryPtr != NULL) {
+ ckfree(Tcl_GetHashValue(entryPtr));
+ entryPtr = Tcl_NextHashEntry(&search);
+ }
+ Tcl_DeleteHashTable(&tsdPtr->styleTable);
+
+ /*
+ * Free engines.
+ */
+
+ entryPtr = Tcl_FirstHashEntry(&tsdPtr->engineTable, &search);
+ while (entryPtr != NULL) {
+ enginePtr = Tcl_GetHashValue(entryPtr);
+ FreeStyleEngine(enginePtr);
+ ckfree(enginePtr);
+ entryPtr = Tcl_NextHashEntry(&search);
+ }
+ Tcl_DeleteHashTable(&tsdPtr->engineTable);
+
+ /*
+ * Free elements.
+ */
+
+ for (i = 0; i < tsdPtr->nbElements; i++) {
+ FreeElement(tsdPtr->elements+i);
+ }
+ Tcl_DeleteHashTable(&tsdPtr->elementTable);
+ ckfree(tsdPtr->elements);
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * Tk_RegisterStyleEngine --
+ *
+ * This function is called to register a new style engine. Style engines
+ * are stored in thread-local space.
+ *
+ * Results:
+ * The newly allocated engine, or NULL if an engine with the same name
+ * exists.
+ *
+ * Side effects:
+ * Memory allocated. Data added to thread-local table.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+Tk_StyleEngine
+Tk_RegisterStyleEngine(
+ const char *name, /* Name of the engine to create. NULL or empty
+ * means the default system engine. */
+ Tk_StyleEngine parent) /* The engine's parent. NULL means the default
+ * system engine. */
+{
+ ThreadSpecificData *tsdPtr =
+ Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
+ Tcl_HashEntry *entryPtr;
+ int newEntry;
+ StyleEngine *enginePtr;
+
+ /*
+ * Attempt to create a new entry in the engine table.
+ */
+
+ entryPtr = Tcl_CreateHashEntry(&tsdPtr->engineTable,
+ (name != NULL ? name : ""), &newEntry);
+ if (!newEntry) {
+ /*
+ * An engine was already registered by that name.
+ */
+
+ return NULL;
+ }
+
+ /*
+ * Allocate and intitialize a new engine.
+ */
+
+ enginePtr = ckalloc(sizeof(StyleEngine));
+ InitStyleEngine(enginePtr, Tcl_GetHashKey(&tsdPtr->engineTable, entryPtr),
+ (StyleEngine *) parent);
+ Tcl_SetHashValue(entryPtr, enginePtr);
+
+ return (Tk_StyleEngine) enginePtr;
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * InitStyleEngine --
+ *
+ * Initialize a newly allocated style engine.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Memory allocated.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+static void
+InitStyleEngine(
+ StyleEngine *enginePtr, /* Points to an uninitialized engine. */
+ const char *name, /* Name of the registered engine. NULL or empty
+ * means the default system engine. Usually
+ * points to the hash key. */
+ StyleEngine *parentPtr) /* The engine's parent. NULL means the default
+ * system engine. */
+{
+ ThreadSpecificData *tsdPtr =
+ Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
+ int elementId;
+
+ if (name == NULL || *name == '\0') {
+ /*
+ * This is the default style engine.
+ */
+
+ enginePtr->parentPtr = NULL;
+ } else if (parentPtr == NULL) {
+ /*
+ * The default style engine is the parent.
+ */
+
+ enginePtr->parentPtr = tsdPtr->defaultEnginePtr;
+ } else {
+ enginePtr->parentPtr = parentPtr;
+ }
+
+ /*
+ * Allocate and initialize elements array.
+ */
+
+ if (tsdPtr->nbElements > 0) {
+ enginePtr->elements = ckalloc(
+ sizeof(StyledElement) * tsdPtr->nbElements);
+ for (elementId = 0; elementId < tsdPtr->nbElements; elementId++) {
+ InitStyledElement(enginePtr->elements+elementId);
+ }
+ } else {
+ enginePtr->elements = NULL;
+ }
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * FreeStyleEngine --
+ *
+ * Free an engine and its associated data.
+ *
+ * Results:
+ * None
+ *
+ * Side effects:
+ * Memory freed.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+static void
+FreeStyleEngine(
+ StyleEngine *enginePtr) /* The style engine to free. */
+{
+ ThreadSpecificData *tsdPtr =
+ Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
+ int elementId;
+
+ /*
+ * Free allocated elements.
+ */
+
+ for (elementId = 0; elementId < tsdPtr->nbElements; elementId++) {
+ FreeStyledElement(enginePtr->elements+elementId);
+ }
+ ckfree(enginePtr->elements);
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * Tk_GetStyleEngine --
+ *
+ * Retrieve a registered style engine by its name.
+ *
+ * Results:
+ * A pointer to the style engine, or NULL if none found.
+ *
+ * Side effects:
+ * None.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+Tk_StyleEngine
+Tk_GetStyleEngine(
+ const char *name) /* Name of the engine to retrieve. NULL or
+ * empty means the default system engine. */
+{
+ ThreadSpecificData *tsdPtr =
+ Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
+ Tcl_HashEntry *entryPtr;
+
+ if (name == NULL) {
+ return (Tk_StyleEngine) tsdPtr->defaultEnginePtr;
+ }
+
+ entryPtr = Tcl_FindHashEntry(&tsdPtr->engineTable, (name!=NULL?name:""));
+ if (!entryPtr) {
+ return NULL;
+ }
+
+ return Tcl_GetHashValue(entryPtr);
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * InitElement --
+ *
+ * Initialize a newly allocated element.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * None.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+static void
+InitElement(
+ Element *elementPtr, /* Points to an uninitialized element.*/
+ const char *name, /* Name of the registered element. Usually
+ * points to the hash key. */
+ int id, /* Unique element ID. */
+ int genericId, /* ID of generic element. -1 means none. */
+ int created) /* Boolean, whether the element was created
+ * explicitly (was registered) or implicitly
+ * (by a derived element). */
+{
+ elementPtr->name = name;
+ elementPtr->id = id;
+ elementPtr->genericId = genericId;
+ elementPtr->created = (created?1:0);
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * FreeElement --
+ *
+ * Free an element and its associated data.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Memory freed.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+static void
+FreeElement(
+ Element *elementPtr) /* The element to free. */
+{
+ /* Nothing to do. */
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * InitStyledElement --
+ *
+ * Initialize a newly allocated styled element.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * None.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+static void
+InitStyledElement(
+ StyledElement *elementPtr) /* Points to an uninitialized element.*/
+{
+ memset(elementPtr, 0, sizeof(StyledElement));
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * FreeStyledElement --
+ *
+ * Free a styled element and its associated data.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Memory freed.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+static void
+FreeStyledElement(
+ StyledElement *elementPtr) /* The styled element to free. */
+{
+ int i;
+
+ /*
+ * Free allocated widget specs.
+ */
+
+ for (i = 0; i < elementPtr->nbWidgetSpecs; i++) {
+ FreeWidgetSpec(elementPtr->widgetSpecs+i);
+ }
+ ckfree(elementPtr->widgetSpecs);
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * CreateElement --
+ *
+ * Find an existing or create a new element.
+ *
+ * Results:
+ * The unique ID for the created or found element.
+ *
+ * Side effects:
+ * Memory allocated.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+static int
+CreateElement(
+ const char *name, /* Name of the element. */
+ int create) /* Boolean, whether the element is being
+ * created explicitly (being registered) or
+ * implicitly (by a derived element). */
+{
+ ThreadSpecificData *tsdPtr =
+ Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
+ Tcl_HashEntry *entryPtr, *engineEntryPtr;
+ Tcl_HashSearch search;
+ int newEntry, elementId, genericId = -1;
+ char *dot;
+ StyleEngine *enginePtr;
+
+ /*
+ * Find or create the element.
+ */
+
+ entryPtr = Tcl_CreateHashEntry(&tsdPtr->elementTable, name, &newEntry);
+ if (!newEntry) {
+ elementId = PTR2INT(Tcl_GetHashValue(entryPtr));
+ if (create) {
+ tsdPtr->elements[elementId].created = 1;
+ }
+ return elementId;
+ }
+
+ /*
+ * The element didn't exist. If it's a derived element, find or create its
+ * generic element ID.
+ */
+
+ dot = strchr(name, '.');
+ if (dot) {
+ genericId = CreateElement(dot+1, 0);
+ }
+
+ elementId = tsdPtr->nbElements++;
+ Tcl_SetHashValue(entryPtr, INT2PTR(elementId));
+
+ /*
+ * Reallocate element table.
+ */
+
+ tsdPtr->elements = ckrealloc(tsdPtr->elements,
+ sizeof(Element) * tsdPtr->nbElements);
+ InitElement(tsdPtr->elements+elementId,
+ Tcl_GetHashKey(&tsdPtr->elementTable, entryPtr), elementId,
+ genericId, create);
+
+ /*
+ * Reallocate style engines' element table.
+ */
+
+ engineEntryPtr = Tcl_FirstHashEntry(&tsdPtr->engineTable, &search);
+ while (engineEntryPtr != NULL) {
+ enginePtr = Tcl_GetHashValue(engineEntryPtr);
+
+ enginePtr->elements = ckrealloc(enginePtr->elements,
+ sizeof(StyledElement) * tsdPtr->nbElements);
+ InitStyledElement(enginePtr->elements+elementId);
+
+ engineEntryPtr = Tcl_NextHashEntry(&search);
+ }
+
+ return elementId;
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * Tk_GetElementId --
+ *
+ * Find an existing element.
+ *
+ * Results:
+ * The unique ID for the found element, or -1 if not found.
+ *
+ * Side effects:
+ * Generic elements may be created.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+int
+Tk_GetElementId(
+ const char *name) /* Name of the element. */
+{
+ ThreadSpecificData *tsdPtr =
+ Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
+ Tcl_HashEntry *entryPtr;
+ int genericId = -1;
+ char *dot;
+
+ /*
+ * Find the element Id.
+ */
+
+ entryPtr = Tcl_FindHashEntry(&tsdPtr->elementTable, name);
+ if (entryPtr) {
+ return PTR2INT(Tcl_GetHashValue(entryPtr));
+ }
+
+ /*
+ * Element not found. If the given name was derived, then first search for
+ * the generic element. If found, create the new derived element.
+ */
+
+ dot = strchr(name, '.');
+ if (!dot) {
+ return -1;
+ }
+ genericId = Tk_GetElementId(dot+1);
+ if (genericId == -1) {
+ return -1;
+ }
+ if (!tsdPtr->elements[genericId].created) {
+ /*
+ * The generic element was created implicitly and thus has no real
+ * existence.
+ */
+
+ return -1;
+ } else {
+ /*
+ * The generic element was created explicitly. Create the derived
+ * element.
+ */
+
+ return CreateElement(name, 1);
+ }
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * Tk_RegisterStyledElement --
+ *
+ * Register an implementation of a new or existing element for the given
+ * style engine.
+ *
+ * Results:
+ * The unique ID for the created or found element.
+ *
+ * Side effects:
+ * Elements may be created. Memory allocated.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+int
+Tk_RegisterStyledElement(
+ Tk_StyleEngine engine, /* Style engine providing the
+ * implementation. */
+ Tk_ElementSpec *templatePtr)/* Static template information about the
+ * element. */
+{
+ int elementId;
+ StyledElement *elementPtr;
+ Tk_ElementSpec *specPtr;
+ int nbOptions;
+ register Tk_ElementOptionSpec *srcOptions, *dstOptions;
+
+ if (templatePtr->version != TK_STYLE_VERSION_1) {
+ /*
+ * Version mismatch. Do nothing.
+ */
+
+ return -1;
+ }
+
+ if (engine == NULL) {
+ engine = Tk_GetStyleEngine(NULL);
+ }
+
+ /*
+ * Register the element, allocating storage in the various engines if
+ * necessary.
+ */
+
+ elementId = CreateElement(templatePtr->name, 1);
+
+ /*
+ * Initialize the styled element.
+ */
+
+ elementPtr = ((StyleEngine *) engine)->elements+elementId;
+
+ specPtr = ckalloc(sizeof(Tk_ElementSpec));
+ specPtr->version = templatePtr->version;
+ specPtr->name = ckalloc(strlen(templatePtr->name)+1);
+ strcpy(specPtr->name, templatePtr->name);
+ nbOptions = 0;
+ for (nbOptions = 0, srcOptions = templatePtr->options;
+ srcOptions->name != NULL; nbOptions++, srcOptions++) {
+ /* empty body */
+ }
+ specPtr->options =
+ ckalloc(sizeof(Tk_ElementOptionSpec) * (nbOptions+1));
+ for (srcOptions = templatePtr->options, dstOptions = specPtr->options;
+ /* End condition within loop */; srcOptions++, dstOptions++) {
+ if (srcOptions->name == NULL) {
+ dstOptions->name = NULL;
+ break;
+ }
+
+ dstOptions->name = ckalloc(strlen(srcOptions->name)+1);
+ strcpy(dstOptions->name, srcOptions->name);
+ dstOptions->type = srcOptions->type;
+ }
+ specPtr->getSize = templatePtr->getSize;
+ specPtr->getBox = templatePtr->getBox;
+ specPtr->getBorderWidth = templatePtr->getBorderWidth;
+ specPtr->draw = templatePtr->draw;
+
+ elementPtr->specPtr = specPtr;
+ elementPtr->nbWidgetSpecs = 0;
+ elementPtr->widgetSpecs = NULL;
+
+ return elementId;
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * GetStyledElement --
+ *
+ * Get a registered implementation of an existing element for the given
+ * style engine.
+ *
+ * Results:
+ * The styled element descriptor, or NULL if not found.
+ *
+ * Side effects:
+ * None.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+static StyledElement *
+GetStyledElement(
+ StyleEngine *enginePtr, /* Style engine providing the implementation.
+ * NULL means the default system engine. */
+ int elementId) /* Unique element ID */
+{
+ StyledElement *elementPtr;
+ ThreadSpecificData *tsdPtr =
+ Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
+ StyleEngine *enginePtr2;
+
+ if (enginePtr == NULL) {
+ enginePtr = tsdPtr->defaultEnginePtr;
+ }
+
+ while (elementId >= 0 && elementId < tsdPtr->nbElements) {
+ /*
+ * Look for an implemented element through the engine chain.
+ */
+
+ enginePtr2 = enginePtr;
+ do {
+ elementPtr = enginePtr2->elements+elementId;
+ if (elementPtr->specPtr != NULL) {
+ return elementPtr;
+ }
+ enginePtr2 = enginePtr2->parentPtr;
+ } while (enginePtr2 != NULL);
+
+ /*
+ * None found, try with the generic element.
+ */
+
+ elementId = tsdPtr->elements[elementId].genericId;
+ }
+
+ /*
+ * No matching element found.
+ */
+
+ return NULL;
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * InitWidgetSpec --
+ *
+ * Initialize a newly allocated widget spec.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Memory allocated.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+static void
+InitWidgetSpec(
+ StyledWidgetSpec *widgetSpecPtr,
+ /* Points to an uninitialized widget spec. */
+ StyledElement *elementPtr, /* Styled element descriptor. */
+ Tk_OptionTable optionTable) /* The widget's option table. */
+{
+ int i, nbOptions;
+ Tk_ElementOptionSpec *elementOptionPtr;
+ const Tk_OptionSpec *widgetOptionPtr;
+
+ widgetSpecPtr->elementPtr = elementPtr;
+ widgetSpecPtr->optionTable = optionTable;
+
+ /*
+ * Count the number of options.
+ */
+
+ for (nbOptions = 0, elementOptionPtr = elementPtr->specPtr->options;
+ elementOptionPtr->name != NULL; nbOptions++, elementOptionPtr++) {
+ /* empty body */
+ }
+
+ /*
+ * Build the widget option list.
+ */
+
+ widgetSpecPtr->optionsPtr =
+ ckalloc(sizeof(Tk_OptionSpec *) * nbOptions);
+ for (i = 0, elementOptionPtr = elementPtr->specPtr->options;
+ i < nbOptions; i++, elementOptionPtr++) {
+ widgetOptionPtr = TkGetOptionSpec(elementOptionPtr->name, optionTable);
+
+ /*
+ * Check that the widget option type is compatible with one of the
+ * element's required types.
+ */
+
+ if (elementOptionPtr->type == TK_OPTION_END
+ || elementOptionPtr->type == widgetOptionPtr->type) {
+ widgetSpecPtr->optionsPtr[i] = widgetOptionPtr;
+ } else {
+ widgetSpecPtr->optionsPtr[i] = NULL;
+ }
+ }
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * FreeWidgetSpec --
+ *
+ * Free a widget spec and its associated data.
+ *
+ * Results:
+ * None
+ *
+ * Side effects:
+ * Memory freed.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+static void
+FreeWidgetSpec(
+ StyledWidgetSpec *widgetSpecPtr)
+ /* The widget spec to free. */
+{
+ ckfree(widgetSpecPtr->optionsPtr);
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * GetWidgetSpec --
+ *
+ * Return a new or existing widget spec for the given element and widget
+ * type (identified by its option table).
+ *
+ * Results:
+ * A pointer to the matching widget spec.
+ *
+ * Side effects:
+ * Memory may be allocated.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+static StyledWidgetSpec *
+GetWidgetSpec(
+ StyledElement *elementPtr, /* Styled element descriptor. */
+ Tk_OptionTable optionTable) /* The widget's option table. */
+{
+ StyledWidgetSpec *widgetSpecPtr;
+ int i;
+
+ /*
+ * Try to find an existing widget spec.
+ */
+
+ for (i = 0; i < elementPtr->nbWidgetSpecs; i++) {
+ widgetSpecPtr = elementPtr->widgetSpecs+i;
+ if (widgetSpecPtr->optionTable == optionTable) {
+ return widgetSpecPtr;
+ }
+ }
+
+ /*
+ * Create and initialize a new widget spec.
+ */
+
+ i = elementPtr->nbWidgetSpecs++;
+ elementPtr->widgetSpecs = ckrealloc(elementPtr->widgetSpecs,
+ sizeof(StyledWidgetSpec) * elementPtr->nbWidgetSpecs);
+ widgetSpecPtr = elementPtr->widgetSpecs+i;
+ InitWidgetSpec(widgetSpecPtr, elementPtr, optionTable);
+
+ return widgetSpecPtr;
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * Tk_GetStyledElement --
+ *
+ * This function returns a styled instance of the given element.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Cached data may be allocated or updated.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+Tk_StyledElement
+Tk_GetStyledElement(
+ Tk_Style style, /* The widget style. */
+ int elementId, /* Unique element ID. */
+ Tk_OptionTable optionTable) /* Option table for the widget. */
+{
+ Style *stylePtr = (Style *) style;
+ StyledElement *elementPtr;
+
+ /*
+ * Get an element implementation and call corresponding hook.
+ */
+
+ elementPtr = GetStyledElement((stylePtr?stylePtr->enginePtr:NULL),
+ elementId);
+ if (!elementPtr) {
+ return NULL;
+ }
+
+ return (Tk_StyledElement) GetWidgetSpec(elementPtr, optionTable);
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * Tk_GetElementSize --
+ *
+ * This function computes the size of the given widget element according
+ * to its style.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Cached data may be allocated or updated.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+void
+Tk_GetElementSize(
+ Tk_Style style, /* The widget style. */
+ Tk_StyledElement element, /* The styled element, previously returned by
+ * Tk_GetStyledElement. */
+ char *recordPtr, /* The widget record. */
+ Tk_Window tkwin, /* The widget window. */
+ int width, int height, /* Requested size. */
+ int inner, /* If TRUE, compute the outer size according
+ * to the requested minimum inner size. If
+ * FALSE, compute the inner size according to
+ * the requested maximum outer size. */
+ int *widthPtr, int *heightPtr)
+ /* Returned size. */
+{
+ Style *stylePtr = (Style *) style;
+ StyledWidgetSpec *widgetSpecPtr = (StyledWidgetSpec *) element;
+
+ widgetSpecPtr->elementPtr->specPtr->getSize(stylePtr->clientData,
+ recordPtr, widgetSpecPtr->optionsPtr, tkwin, width, height, inner,
+ widthPtr, heightPtr);
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * Tk_GetElementBox --
+ *
+ * This function computes the bounding or inscribed box coordinates of
+ * the given widget element according to its style and within the given
+ * limits.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Cached data may be allocated or updated.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+void
+Tk_GetElementBox(
+ Tk_Style style, /* The widget style. */
+ Tk_StyledElement element, /* The styled element, previously returned by
+ * Tk_GetStyledElement. */
+ char *recordPtr, /* The widget record. */
+ Tk_Window tkwin, /* The widget window. */
+ int x, int y, /* Top left corner of available area. */
+ int width, int height, /* Size of available area. */
+ int inner, /* Boolean. If TRUE, compute the bounding box
+ * according to the requested inscribed box
+ * size. If FALSE, compute the inscribed box
+ * according to the requested bounding box. */
+ int *xPtr, int *yPtr, /* Returned top left corner. */
+ int *widthPtr, int *heightPtr)
+ /* Returned size. */
+{
+ Style *stylePtr = (Style *) style;
+ StyledWidgetSpec *widgetSpecPtr = (StyledWidgetSpec *) element;
+
+ widgetSpecPtr->elementPtr->specPtr->getBox(stylePtr->clientData,
+ recordPtr, widgetSpecPtr->optionsPtr, tkwin, x, y, width, height,
+ inner, xPtr, yPtr, widthPtr, heightPtr);
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * Tk_GetElementBorderWidth --
+ *
+ * This function computes the border widthof the given widget element
+ * according to its style and within the given limits.
+ *
+ * Results:
+ * Border width in pixels. This value is uniform for all four sides.
+ *
+ * Side effects:
+ * Cached data may be allocated or updated.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+int
+Tk_GetElementBorderWidth(
+ Tk_Style style, /* The widget style. */
+ Tk_StyledElement element, /* The styled element, previously returned by
+ * Tk_GetStyledElement. */
+ char *recordPtr, /* The widget record. */
+ Tk_Window tkwin) /* The widget window. */
+{
+ Style *stylePtr = (Style *) style;
+ StyledWidgetSpec *widgetSpecPtr = (StyledWidgetSpec *) element;
+
+ return widgetSpecPtr->elementPtr->specPtr->getBorderWidth(
+ stylePtr->clientData, recordPtr, widgetSpecPtr->optionsPtr, tkwin);
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * Tk_DrawElement --
+ *
+ * This function draw the given widget element in a given drawable area.
+ *
+ * Results:
+ * None
+ *
+ * Side effects:
+ * Cached data may be allocated or updated.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+void
+Tk_DrawElement(
+ Tk_Style style, /* The widget style. */
+ Tk_StyledElement element, /* The styled element, previously returned by
+ * Tk_GetStyledElement. */
+ char *recordPtr, /* The widget record. */
+ Tk_Window tkwin, /* The widget window. */
+ Drawable d, /* Where to draw element. */
+ int x, int y, /* Top left corner of element. */
+ int width, int height, /* Size of element. */
+ int state) /* Drawing state flags. */
+{
+ Style *stylePtr = (Style *) style;
+ StyledWidgetSpec *widgetSpecPtr = (StyledWidgetSpec *) element;
+
+ widgetSpecPtr->elementPtr->specPtr->draw(stylePtr->clientData,
+ recordPtr, widgetSpecPtr->optionsPtr, tkwin, d, x, y, width,
+ height, state);
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * Tk_CreateStyle --
+ *
+ * This function is called to create a new style as an instance of the
+ * given engine. Styles are stored in thread-local space.
+ *
+ * Results:
+ * The newly allocated style, or NULL if the style already exists.
+ *
+ * Side effects:
+ * Memory allocated. Data added to thread-local table.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+Tk_Style
+Tk_CreateStyle(
+ const char *name, /* Name of the style to create. NULL or empty
+ * means the default system style. */
+ Tk_StyleEngine engine, /* The style engine. */
+ ClientData clientData) /* Private data passed as is to engine code. */
+{
+ ThreadSpecificData *tsdPtr =
+ Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
+ Tcl_HashEntry *entryPtr;
+ int newEntry;
+ Style *stylePtr;
+
+ /*
+ * Attempt to create a new entry in the style table.
+ */
+
+ entryPtr = Tcl_CreateHashEntry(&tsdPtr->styleTable, (name?name:""),
+ &newEntry);
+ if (!newEntry) {
+ /*
+ * A style was already registered by that name.
+ */
+
+ return NULL;
+ }
+
+ /*
+ * Allocate and intitialize a new style.
+ */
+
+ stylePtr = ckalloc(sizeof(Style));
+ InitStyle(stylePtr, Tcl_GetHashKey(&tsdPtr->styleTable, entryPtr),
+ (engine!=NULL ? (StyleEngine*) engine : tsdPtr->defaultEnginePtr),
+ clientData);
+ Tcl_SetHashValue(entryPtr, stylePtr);
+
+ return (Tk_Style) stylePtr;
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * Tk_NameOfStyle --
+ *
+ * Given a style, return its registered name.
+ *
+ * Results:
+ * The return value is the name that was passed to Tk_CreateStyle() to
+ * create the style. The storage for the returned string is private (it
+ * points to the corresponding hash key) The caller should not modify
+ * this string.
+ *
+ * Side effects:
+ * None.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+const char *
+Tk_NameOfStyle(
+ Tk_Style style) /* Style whose name is desired. */
+{
+ Style *stylePtr = (Style *) style;
+
+ return stylePtr->name;
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * InitStyle --
+ *
+ * Initialize a newly allocated style.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * None.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+static void
+InitStyle(
+ Style *stylePtr, /* Points to an uninitialized style. */
+ const char *name, /* Name of the registered style. NULL or empty
+ * means the default system style. Usually
+ * points to the hash key. */
+ StyleEngine *enginePtr, /* The style engine. */
+ ClientData clientData) /* Private data passed as is to engine code. */
+{
+ stylePtr->name = name;
+ stylePtr->enginePtr = enginePtr;
+ stylePtr->clientData = clientData;
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * Tk_GetStyle --
+ *
+ * Retrieve a registered style by its name.
+ *
+ * Results:
+ * A pointer to the style engine, or NULL if none found. In the latter
+ * case and if the interp is not NULL, an error message is left in the
+ * interp's result.
+ *
+ * Side effects:
+ * None.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+Tk_Style
+Tk_GetStyle(
+ Tcl_Interp *interp, /* Interp for error return. */
+ const char *name) /* Name of the style to retrieve. NULL or empty
+ * means the default system style. */
+{
+ ThreadSpecificData *tsdPtr =
+ Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
+ Tcl_HashEntry *entryPtr;
+ Style *stylePtr;
+
+ /*
+ * Search for a corresponding entry in the style table.
+ */
+
+ entryPtr = Tcl_FindHashEntry(&tsdPtr->styleTable, (name!=NULL?name:""));
+ if (entryPtr == NULL) {
+ if (interp != NULL) {
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "style \"%s\" doesn't exist", name));
+ Tcl_SetErrorCode(interp, "TK", "LOOKUP", "STYLE", name, NULL);
+ }
+ return (Tk_Style) NULL;
+ }
+ stylePtr = Tcl_GetHashValue(entryPtr);
+
+ return (Tk_Style) stylePtr;
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * Tk_FreeStyle --
+ *
+ * No-op. Present only for stubs compatibility.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+void
+Tk_FreeStyle(
+ Tk_Style style)
+{
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * Tk_AllocStyleFromObj --
+ *
+ * Map the string name of a style to a corresponding Tk_Style. The style
+ * must have already been created by Tk_CreateStyle.
+ *
+ * Results:
+ * The return value is a token for the style that matches objPtr, or NULL
+ * if none found. If NULL is returned, an error message will be left in
+ * interp's result object.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+Tk_Style
+Tk_AllocStyleFromObj(
+ Tcl_Interp *interp, /* Interp for error return. */
+ Tcl_Obj *objPtr) /* Object containing name of the style to
+ * retrieve. */
+{
+ Style *stylePtr;
+
+ if (objPtr->typePtr != &styleObjType) {
+ SetStyleFromAny(interp, objPtr);
+ }
+ stylePtr = objPtr->internalRep.twoPtrValue.ptr1;
+
+ return (Tk_Style) stylePtr;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_GetStyleFromObj --
+ *
+ * Find the style that corresponds to a given object. The style must have
+ * already been created by Tk_CreateStyle.
+ *
+ * Results:
+ * The return value is a token for the style that matches objPtr, or NULL
+ * if none found.
+ *
+ * Side effects:
+ * If the object is not already a style ref, the conversion will free any
+ * old internal representation.
+ *
+ *----------------------------------------------------------------------
+ */
+
+Tk_Style
+Tk_GetStyleFromObj(
+ Tcl_Obj *objPtr) /* The object from which to get the style. */
+{
+ if (objPtr->typePtr != &styleObjType) {
+ SetStyleFromAny(NULL, objPtr);
+ }
+
+ return objPtr->internalRep.twoPtrValue.ptr1;
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * Tk_FreeStyleFromObj --
+ *
+ * No-op. Present only for stubs compatibility.
+ *
+ *---------------------------------------------------------------------------
+ */
+void
+Tk_FreeStyleFromObj(
+ Tcl_Obj *objPtr)
+{
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * SetStyleFromAny --
+ *
+ * Convert the internal representation of a Tcl object to the style
+ * internal form.
+ *
+ * Results:
+ * Always returns TCL_OK. If an error occurs is returned (e.g. the style
+ * doesn't exist), an error message will be left in interp's result.
+ *
+ * Side effects:
+ * The object is left with its typePtr pointing to styleObjType.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+SetStyleFromAny(
+ Tcl_Interp *interp, /* Used for error reporting if not NULL. */
+ Tcl_Obj *objPtr) /* The object to convert. */
+{
+ const Tcl_ObjType *typePtr;
+ const char *name;
+
+ /*
+ * Free the old internalRep before setting the new one.
+ */
+
+ name = Tcl_GetString(objPtr);
+ typePtr = objPtr->typePtr;
+ if ((typePtr != NULL) && (typePtr->freeIntRepProc != NULL)) {
+ typePtr->freeIntRepProc(objPtr);
+ }
+
+ objPtr->typePtr = &styleObjType;
+ objPtr->internalRep.twoPtrValue.ptr1 = Tk_GetStyle(interp, name);
+
+ return TCL_OK;
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * FreeStyleObjProc --
+ *
+ * This proc is called to release an object reference to a style. Called
+ * when the object's internal rep is released.
+ *
+ * Results:
+ * None.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+static void
+FreeStyleObjProc(
+ Tcl_Obj *objPtr) /* The object we are releasing. */
+{
+ objPtr->internalRep.twoPtrValue.ptr1 = NULL;
+ objPtr->typePtr = NULL;
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * DupStyleObjProc --
+ *
+ * When a cached style object is duplicated, this is called to update the
+ * internal reps.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+static void
+DupStyleObjProc(
+ Tcl_Obj *srcObjPtr, /* The object we are copying from. */
+ Tcl_Obj *dupObjPtr) /* The object we are copying to. */
+{
+ dupObjPtr->typePtr = srcObjPtr->typePtr;
+ dupObjPtr->internalRep.twoPtrValue.ptr1 =
+ srcObjPtr->internalRep.twoPtrValue.ptr1;
+}
+
+/*
+ * Local Variables:
+ * mode: c
+ * c-basic-offset: 4
+ * fill-column: 78
+ * End:
+ */
diff --git a/tk8.6/generic/tkTest.c b/tk8.6/generic/tkTest.c
new file mode 100644
index 0000000..fa9e073
--- /dev/null
+++ b/tk8.6/generic/tkTest.c
@@ -0,0 +1,2076 @@
+/*
+ * tkTest.c --
+ *
+ * This file contains C command functions for a bunch of additional Tcl
+ * commands that are used for testing out Tcl's C interfaces. These
+ * commands are not normally included in Tcl applications; they're only
+ * used for testing.
+ *
+ * Copyright (c) 1993-1994 The Regents of the University of California.
+ * Copyright (c) 1994-1997 Sun Microsystems, Inc.
+ * Copyright (c) 1998-1999 by Scriptics Corporation.
+ *
+ * See the file "license.terms" for information on usage and redistribution of
+ * this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ */
+
+#undef STATIC_BUILD
+#ifndef USE_TCL_STUBS
+# define USE_TCL_STUBS
+#endif
+#ifndef USE_TK_STUBS
+# define USE_TK_STUBS
+#endif
+#include "tkInt.h"
+#include "tkText.h"
+
+#ifdef _WIN32
+#include "tkWinInt.h"
+#endif
+
+#if defined(MAC_OSX_TK)
+#include "tkMacOSXInt.h"
+#include "tkScrollbar.h"
+#endif
+
+#ifdef __UNIX__
+#include "tkUnixInt.h"
+#endif
+
+/*
+ * TCL_STORAGE_CLASS is set unconditionally to DLLEXPORT because the
+ * Tcltest_Init declaration is in the source file itself, which is only
+ * accessed when we are building a library.
+ */
+
+#undef TCL_STORAGE_CLASS
+#define TCL_STORAGE_CLASS DLLEXPORT
+EXTERN int Tktest_Init(Tcl_Interp *interp);
+/*
+ * The following data structure represents the master for a test image:
+ */
+
+typedef struct TImageMaster {
+ Tk_ImageMaster master; /* Tk's token for image master. */
+ Tcl_Interp *interp; /* Interpreter for application. */
+ int width, height; /* Dimensions of image. */
+ char *imageName; /* Name of image (malloc-ed). */
+ char *varName; /* Name of variable in which to log events for
+ * image (malloc-ed). */
+} TImageMaster;
+
+/*
+ * The following data structure represents a particular use of a particular
+ * test image.
+ */
+
+typedef struct TImageInstance {
+ TImageMaster *masterPtr; /* Pointer to master for image. */
+ XColor *fg; /* Foreground color for drawing in image. */
+ GC gc; /* Graphics context for drawing in image. */
+} TImageInstance;
+
+/*
+ * The type record for test images:
+ */
+
+static int ImageCreate(Tcl_Interp *interp,
+ const char *name, int argc, Tcl_Obj *const objv[],
+ const Tk_ImageType *typePtr, Tk_ImageMaster master,
+ ClientData *clientDataPtr);
+static ClientData ImageGet(Tk_Window tkwin, ClientData clientData);
+static void ImageDisplay(ClientData clientData,
+ Display *display, Drawable drawable,
+ int imageX, int imageY, int width,
+ int height, int drawableX,
+ int drawableY);
+static void ImageFree(ClientData clientData, Display *display);
+static void ImageDelete(ClientData clientData);
+
+static Tk_ImageType imageType = {
+ "test", /* name */
+ ImageCreate, /* createProc */
+ ImageGet, /* getProc */
+ ImageDisplay, /* displayProc */
+ ImageFree, /* freeProc */
+ ImageDelete, /* deleteProc */
+ NULL, /* postscriptPtr */
+ NULL, /* nextPtr */
+ NULL
+};
+
+/*
+ * One of the following structures describes each of the interpreters created
+ * by the "testnewapp" command. This information is used by the
+ * "testdeleteinterps" command to destroy all of those interpreters.
+ */
+
+typedef struct NewApp {
+ Tcl_Interp *interp; /* Token for interpreter. */
+ struct NewApp *nextPtr; /* Next in list of new interpreters. */
+} NewApp;
+
+static NewApp *newAppPtr = NULL;/* First in list of all new interpreters. */
+
+/*
+ * 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 functions defined later in this file:
+ */
+
+static int ImageObjCmd(ClientData dummy,
+ Tcl_Interp *interp, int objc,
+ Tcl_Obj * const objv[]);
+static int TestbitmapObjCmd(ClientData dummy,
+ Tcl_Interp *interp, int objc,
+ Tcl_Obj * const objv[]);
+static int TestborderObjCmd(ClientData dummy,
+ Tcl_Interp *interp, int objc,
+ Tcl_Obj * const objv[]);
+static int TestcolorObjCmd(ClientData dummy,
+ Tcl_Interp *interp, int objc,
+ Tcl_Obj * const objv[]);
+static int TestcursorObjCmd(ClientData dummy,
+ Tcl_Interp *interp, int objc,
+ Tcl_Obj * const objv[]);
+static int TestdeleteappsObjCmd(ClientData dummy,
+ Tcl_Interp *interp, int objc,
+ Tcl_Obj * const objv[]);
+static int TestfontObjCmd(ClientData dummy,
+ Tcl_Interp *interp, int objc,
+ Tcl_Obj *const objv[]);
+static int TestmakeexistObjCmd(ClientData dummy,
+ Tcl_Interp *interp, int objc,
+ Tcl_Obj *const objv[]);
+#if !(defined(_WIN32) || defined(MAC_OSX_TK) || defined(__CYGWIN__))
+static int TestmenubarObjCmd(ClientData dummy,
+ Tcl_Interp *interp, int objc,
+ Tcl_Obj *const objv[]);
+#endif
+#if defined(_WIN32) || defined(MAC_OSX_TK)
+static int TestmetricsObjCmd(ClientData dummy,
+ Tcl_Interp *interp, int objc,
+ Tcl_Obj * const objv[]);
+#endif
+static int TestobjconfigObjCmd(ClientData dummy,
+ Tcl_Interp *interp, int objc,
+ Tcl_Obj * const objv[]);
+static int CustomOptionSet(ClientData clientData,
+ Tcl_Interp *interp, Tk_Window tkwin,
+ Tcl_Obj **value, char *recordPtr,
+ int internalOffset, char *saveInternalPtr,
+ int flags);
+static Tcl_Obj * CustomOptionGet(ClientData clientData,
+ Tk_Window tkwin, char *recordPtr,
+ int internalOffset);
+static void CustomOptionRestore(ClientData clientData,
+ Tk_Window tkwin, char *internalPtr,
+ char *saveInternalPtr);
+static void CustomOptionFree(ClientData clientData,
+ Tk_Window tkwin, char *internalPtr);
+static int TestpropObjCmd(ClientData dummy,
+ Tcl_Interp *interp, int objc,
+ Tcl_Obj * const objv[]);
+#if !(defined(_WIN32) || defined(MAC_OSX_TK) || defined(__CYGWIN__))
+static int TestwrapperObjCmd(ClientData dummy,
+ Tcl_Interp *interp, int objc,
+ Tcl_Obj * const objv[]);
+#endif
+static void TrivialCmdDeletedProc(ClientData clientData);
+static int TrivialConfigObjCmd(ClientData dummy,
+ Tcl_Interp *interp, int objc,
+ Tcl_Obj * const objv[]);
+static void TrivialEventProc(ClientData clientData,
+ XEvent *eventPtr);
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tktest_Init --
+ *
+ * This function performs intialization for the Tk test suite exensions.
+ *
+ * Results:
+ * Returns a standard Tcl completion code, and leaves an error message in
+ * the interp's result if an error occurs.
+ *
+ * Side effects:
+ * Creates several test commands.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tktest_Init(
+ Tcl_Interp *interp) /* Interpreter for application. */
+{
+ static int initialized = 0;
+
+ if (Tcl_InitStubs(interp, "8.1", 0) == NULL) {
+ return TCL_ERROR;
+ }
+ if (Tk_InitStubs(interp, TK_VERSION, 0) == NULL) {
+ return TCL_ERROR;
+ }
+
+ /*
+ * Create additional commands for testing Tk.
+ */
+
+ if (Tcl_PkgProvideEx(interp, "Tktest", TK_PATCH_LEVEL, NULL) == TCL_ERROR) {
+ return TCL_ERROR;
+ }
+
+ Tcl_CreateObjCommand(interp, "square", SquareObjCmd, NULL, NULL);
+ Tcl_CreateObjCommand(interp, "testbitmap", TestbitmapObjCmd,
+ (ClientData) Tk_MainWindow(interp), NULL);
+ Tcl_CreateObjCommand(interp, "testborder", TestborderObjCmd,
+ (ClientData) Tk_MainWindow(interp), NULL);
+ Tcl_CreateObjCommand(interp, "testcolor", TestcolorObjCmd,
+ (ClientData) Tk_MainWindow(interp), NULL);
+ Tcl_CreateObjCommand(interp, "testcursor", TestcursorObjCmd,
+ (ClientData) Tk_MainWindow(interp), NULL);
+ Tcl_CreateObjCommand(interp, "testdeleteapps", TestdeleteappsObjCmd,
+ (ClientData) Tk_MainWindow(interp), NULL);
+ Tcl_CreateObjCommand(interp, "testembed", TkpTestembedCmd,
+ (ClientData) Tk_MainWindow(interp), NULL);
+ Tcl_CreateObjCommand(interp, "testobjconfig", TestobjconfigObjCmd,
+ (ClientData) Tk_MainWindow(interp), NULL);
+ Tcl_CreateObjCommand(interp, "testfont", TestfontObjCmd,
+ (ClientData) Tk_MainWindow(interp), NULL);
+ Tcl_CreateObjCommand(interp, "testmakeexist", TestmakeexistObjCmd,
+ (ClientData) Tk_MainWindow(interp), NULL);
+ Tcl_CreateObjCommand(interp, "testprop", TestpropObjCmd,
+ (ClientData) Tk_MainWindow(interp), NULL);
+ Tcl_CreateObjCommand(interp, "testtext", TkpTesttextCmd,
+ (ClientData) Tk_MainWindow(interp), NULL);
+
+#if defined(_WIN32) || defined(MAC_OSX_TK)
+ Tcl_CreateObjCommand(interp, "testmetrics", TestmetricsObjCmd,
+ (ClientData) Tk_MainWindow(interp), NULL);
+#elif !defined(__CYGWIN__)
+ Tcl_CreateObjCommand(interp, "testmenubar", TestmenubarObjCmd,
+ (ClientData) Tk_MainWindow(interp), NULL);
+ Tcl_CreateObjCommand(interp, "testsend", TkpTestsendCmd,
+ (ClientData) Tk_MainWindow(interp), NULL);
+ Tcl_CreateObjCommand(interp, "testwrapper", TestwrapperObjCmd,
+ (ClientData) Tk_MainWindow(interp), NULL);
+#endif /* _WIN32 || MAC_OSX_TK */
+
+ /*
+ * Create test image type.
+ */
+
+ if (!initialized) {
+ initialized = 1;
+ Tk_CreateImageType(&imageType);
+ }
+
+ /*
+ * Enable testing of legacy interfaces.
+ */
+
+ if (TkOldTestInit(interp) != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ /*
+ * And finally add any platform specific test commands.
+ */
+
+ return TkplatformtestInit(interp);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TestbitmapObjCmd --
+ *
+ * This function 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 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 function 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 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 function 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 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 function 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 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;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TestdeleteappsObjCmd --
+ *
+ * This function implements the "testdeleteapps" command. It cleans up
+ * all the interpreters left behind by the "testnewapp" command.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * All the intepreters created by previous calls to "testnewapp" get
+ * deleted.
+ *
+ *----------------------------------------------------------------------
+ */
+
+ /* ARGSUSED */
+static int
+TestdeleteappsObjCmd(
+ ClientData clientData, /* Main window for application. */
+ Tcl_Interp *interp, /* Current interpreter. */
+ int objc, /* Number of arguments. */
+ Tcl_Obj *const objv[]) /* Argument strings. */
+{
+ NewApp *nextPtr;
+
+ while (newAppPtr != NULL) {
+ nextPtr = newAppPtr->nextPtr;
+ Tcl_DeleteInterp(newAppPtr->interp);
+ ckfree(newAppPtr);
+ newAppPtr = nextPtr;
+ }
+
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TestobjconfigObjCmd --
+ *
+ * This function implements the "testobjconfig" command, which is used to
+ * test the functions in tkConfig.c.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+ /* ARGSUSED */
+static int
+TestobjconfigObjCmd(
+ ClientData clientData, /* Main window for application. */
+ Tcl_Interp *interp, /* Current interpreter. */
+ int objc, /* Number of arguments. */
+ Tcl_Obj *const objv[]) /* Argument objects. */
+{
+ static const char *const options[] = {
+ "alltypes", "chain1", "chain2", "chain3", "configerror", "delete", "info",
+ "internal", "new", "notenoughparams", "twowindows", NULL
+ };
+ enum {
+ ALL_TYPES, CHAIN1, CHAIN2, CHAIN3, CONFIG_ERROR,
+ DEL, /* Can't use DELETE: VC++ compiler barfs. */
+ INFO, INTERNAL, NEW, NOT_ENOUGH_PARAMS, TWO_WINDOWS
+ };
+ static Tk_OptionTable tables[11];
+ /* Holds pointers to option tables created by
+ * commands below; indexed with same values as
+ * "options" array. */
+ static const Tk_ObjCustomOption CustomOption = {
+ "custom option",
+ CustomOptionSet,
+ CustomOptionGet,
+ CustomOptionRestore,
+ CustomOptionFree,
+ INT2PTR(1)
+ };
+ Tk_Window mainWin = (Tk_Window) clientData;
+ Tk_Window tkwin;
+ int index, result = TCL_OK;
+
+ /*
+ * Structures used by the "chain1" subcommand and also shared by the
+ * "chain2" subcommand:
+ */
+
+ typedef struct ExtensionWidgetRecord {
+ TrivialCommandHeader header;
+ Tcl_Obj *base1ObjPtr;
+ Tcl_Obj *base2ObjPtr;
+ Tcl_Obj *extension3ObjPtr;
+ Tcl_Obj *extension4ObjPtr;
+ Tcl_Obj *extension5ObjPtr;
+ } ExtensionWidgetRecord;
+ static const Tk_OptionSpec baseSpecs[] = {
+ {TK_OPTION_STRING, "-one", "one", "One", "one",
+ Tk_Offset(ExtensionWidgetRecord, base1ObjPtr), -1, 0, NULL, 0},
+ {TK_OPTION_STRING, "-two", "two", "Two", "two",
+ Tk_Offset(ExtensionWidgetRecord, base2ObjPtr), -1, 0, NULL, 0},
+ {TK_OPTION_END, NULL, NULL, NULL, NULL, 0, 0, 0, NULL, 0}
+ };
+
+ if (objc < 2) {
+ Tcl_WrongNumArgs(interp, 1, objv, "command");
+ return TCL_ERROR;
+ }
+
+ if (Tcl_GetIndexFromObjStruct(interp, objv[1], options,
+ sizeof(char *), "command", 0, &index)!= TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ switch (index) {
+ case ALL_TYPES: {
+ typedef struct TypesRecord {
+ TrivialCommandHeader header;
+ Tcl_Obj *booleanPtr;
+ Tcl_Obj *integerPtr;
+ Tcl_Obj *doublePtr;
+ Tcl_Obj *stringPtr;
+ Tcl_Obj *stringTablePtr;
+ Tcl_Obj *colorPtr;
+ Tcl_Obj *fontPtr;
+ Tcl_Obj *bitmapPtr;
+ Tcl_Obj *borderPtr;
+ Tcl_Obj *reliefPtr;
+ Tcl_Obj *cursorPtr;
+ Tcl_Obj *activeCursorPtr;
+ Tcl_Obj *justifyPtr;
+ Tcl_Obj *anchorPtr;
+ Tcl_Obj *pixelPtr;
+ Tcl_Obj *mmPtr;
+ Tcl_Obj *customPtr;
+ } TypesRecord;
+ TypesRecord *recordPtr;
+ static const char *const stringTable[] = {
+ "one", "two", "three", "four", NULL
+ };
+ static const 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, stringTable, 0x10},
+ {TK_OPTION_COLOR, "-color", "color", "Color",
+ "red", Tk_Offset(TypesRecord, colorPtr), -1,
+ TK_CONFIG_NULL_OK, "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, "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", NULL, NULL, "left",
+ Tk_Offset(TypesRecord, justifyPtr), -1,
+ TK_CONFIG_NULL_OK, 0, 0x800},
+ {TK_OPTION_ANCHOR, "-anchor", "anchor", "Anchor", NULL,
+ Tk_Offset(TypesRecord, anchorPtr), -1,
+ TK_CONFIG_NULL_OK, 0, 0x1000},
+ {TK_OPTION_PIXELS, "-pixel", "pixel", "Pixel",
+ "1", Tk_Offset(TypesRecord, pixelPtr), -1,
+ TK_CONFIG_NULL_OK, 0, 0x2000},
+ {TK_OPTION_CUSTOM, "-custom", NULL, NULL,
+ "", Tk_Offset(TypesRecord, customPtr), -1,
+ TK_CONFIG_NULL_OK, &CustomOption, 0x4000},
+ {TK_OPTION_SYNONYM, "-synonym", NULL, NULL,
+ NULL, 0, -1, 0, "-color", 0x8000},
+ {TK_OPTION_END, NULL, NULL, NULL, NULL, 0, 0, 0, NULL, 0}
+ };
+ Tk_OptionTable optionTable;
+ Tk_Window tkwin;
+
+ optionTable = Tk_CreateOptionTable(interp, typesSpecs);
+ tables[index] = optionTable;
+ tkwin = Tk_CreateWindowFromPath(interp, (Tk_Window) clientData,
+ Tcl_GetString(objv[2]), NULL);
+ if (tkwin == NULL) {
+ return TCL_ERROR;
+ }
+ Tk_SetClass(tkwin, "Test");
+
+ recordPtr = ckalloc(sizeof(TypesRecord));
+ recordPtr->header.interp = interp;
+ recordPtr->header.optionTable = optionTable;
+ recordPtr->header.tkwin = tkwin;
+ recordPtr->booleanPtr = NULL;
+ recordPtr->integerPtr = NULL;
+ recordPtr->doublePtr = NULL;
+ recordPtr->stringPtr = NULL;
+ recordPtr->colorPtr = NULL;
+ recordPtr->fontPtr = NULL;
+ recordPtr->bitmapPtr = NULL;
+ recordPtr->borderPtr = NULL;
+ recordPtr->reliefPtr = NULL;
+ recordPtr->cursorPtr = NULL;
+ recordPtr->justifyPtr = NULL;
+ recordPtr->anchorPtr = NULL;
+ recordPtr->pixelPtr = NULL;
+ recordPtr->mmPtr = NULL;
+ recordPtr->stringTablePtr = NULL;
+ recordPtr->customPtr = NULL;
+ result = Tk_InitOptions(interp, (char *) recordPtr, optionTable,
+ tkwin);
+ if (result == TCL_OK) {
+ recordPtr->header.widgetCmd = Tcl_CreateObjCommand(interp,
+ Tcl_GetString(objv[2]), TrivialConfigObjCmd,
+ (ClientData) recordPtr, TrivialCmdDeletedProc);
+ Tk_CreateEventHandler(tkwin, StructureNotifyMask,
+ TrivialEventProc, (ClientData) recordPtr);
+ result = Tk_SetOptions(interp, (char *) recordPtr, optionTable,
+ objc-3, objv+3, tkwin, NULL, NULL);
+ if (result != TCL_OK) {
+ Tk_DestroyWindow(tkwin);
+ }
+ } else {
+ Tk_DestroyWindow(tkwin);
+ ckfree(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_GetString(objv[2]), NULL);
+ if (tkwin == NULL) {
+ return TCL_ERROR;
+ }
+ Tk_SetClass(tkwin, "Test");
+ optionTable = Tk_CreateOptionTable(interp, baseSpecs);
+ tables[index] = optionTable;
+
+ recordPtr = 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, NULL, NULL);
+ if (result != TCL_OK) {
+ Tk_FreeConfigOptions((char *) recordPtr, optionTable, tkwin);
+ }
+ }
+ if (result == TCL_OK) {
+ recordPtr->header.widgetCmd = Tcl_CreateObjCommand(interp,
+ Tcl_GetString(objv[2]), TrivialConfigObjCmd,
+ (ClientData) recordPtr, TrivialCmdDeletedProc);
+ Tk_CreateEventHandler(tkwin, StructureNotifyMask,
+ TrivialEventProc, (ClientData) recordPtr);
+ Tcl_SetObjResult(interp, objv[2]);
+ }
+ break;
+ }
+
+ case CHAIN2:
+ case CHAIN3: {
+ ExtensionWidgetRecord *recordPtr;
+ static const Tk_OptionSpec extensionSpecs[] = {
+ {TK_OPTION_STRING, "-three", "three", "Three", "three",
+ Tk_Offset(ExtensionWidgetRecord, extension3ObjPtr), -1, 0, NULL, 0},
+ {TK_OPTION_STRING, "-four", "four", "Four", "four",
+ Tk_Offset(ExtensionWidgetRecord, extension4ObjPtr), -1, 0, NULL, 0},
+ {TK_OPTION_STRING, "-two", "two", "Two", "two and a half",
+ Tk_Offset(ExtensionWidgetRecord, base2ObjPtr), -1, 0, NULL, 0},
+ {TK_OPTION_STRING,
+ "-oneAgain", "oneAgain", "OneAgain", "one again",
+ Tk_Offset(ExtensionWidgetRecord, extension5ObjPtr), -1, 0, NULL, 0},
+ {TK_OPTION_END, NULL, NULL, NULL, NULL, 0, -1, 0,
+ (ClientData) baseSpecs, 0}
+ };
+ Tk_Window tkwin;
+ Tk_OptionTable optionTable;
+
+ tkwin = Tk_CreateWindowFromPath(interp, (Tk_Window) clientData,
+ Tcl_GetString(objv[2]), NULL);
+ if (tkwin == NULL) {
+ return TCL_ERROR;
+ }
+ Tk_SetClass(tkwin, "Test");
+ optionTable = Tk_CreateOptionTable(interp, extensionSpecs);
+ tables[index] = optionTable;
+
+ recordPtr = 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, NULL, NULL);
+ if (result != TCL_OK) {
+ Tk_FreeConfigOptions((char *) recordPtr, optionTable, tkwin);
+ }
+ }
+ if (result == TCL_OK) {
+ recordPtr->header.widgetCmd = Tcl_CreateObjCommand(interp,
+ Tcl_GetString(objv[2]), 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 const Tk_OptionSpec errorSpecs[] = {
+ {TK_OPTION_INT, "-int", "integer", "Integer", "bogus",
+ Tk_Offset(ErrorWidgetRecord, intPtr), 0, 0, NULL, 0},
+ {TK_OPTION_END, NULL, NULL, NULL, NULL, 0, 0, 0, NULL, 0}
+ };
+ 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_GetIndexFromObjStruct(interp, objv[2], options,
+ sizeof(char *), "table", 0, &index) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (tables[index] != NULL) {
+ Tk_DeleteOptionTable(tables[index]);
+ /* Make sure that Tk_DeleteOptionTable() is never done
+ * twice for the same table. */
+ tables[index] = NULL;
+ }
+ break;
+
+ case INFO:
+ if (objc != 3) {
+ Tcl_WrongNumArgs(interp, 2, objv, "tableName");
+ return TCL_ERROR;
+ }
+ if (Tcl_GetIndexFromObjStruct(interp, objv[2], options,
+ sizeof(char *), "table", 0, &index) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ Tcl_SetObjResult(interp, TkDebugConfig(interp, tables[index]));
+ break;
+
+ case INTERNAL: {
+ /*
+ * This command is similar to the "alltypes" command except that it
+ * stores all the configuration options as internal forms instead of
+ * objects.
+ */
+
+ typedef struct InternalRecord {
+ TrivialCommandHeader header;
+ int boolean;
+ int integer;
+ double doubleValue;
+ char *string;
+ int index;
+ XColor *colorPtr;
+ Tk_Font tkfont;
+ Pixmap bitmap;
+ Tk_3DBorder border;
+ int relief;
+ Tk_Cursor cursor;
+ Tk_Justify justify;
+ Tk_Anchor anchor;
+ int pixels;
+ double mm;
+ Tk_Window tkwin;
+ char *custom;
+ } InternalRecord;
+ InternalRecord *recordPtr;
+ static const char *const internalStringTable[] = {
+ "one", "two", "three", "four", NULL
+ };
+ static const 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, internalStringTable, 0x10},
+ {TK_OPTION_COLOR, "-color", "color", "Color", "red",
+ -1, Tk_Offset(InternalRecord, colorPtr),
+ TK_CONFIG_NULL_OK, "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, "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", NULL, NULL, "left",
+ -1, Tk_Offset(InternalRecord, justify),
+ TK_CONFIG_NULL_OK, 0, 0x800},
+ {TK_OPTION_ANCHOR, "-anchor", "anchor", "Anchor", 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", NULL,
+ -1, Tk_Offset(InternalRecord, tkwin),
+ TK_CONFIG_NULL_OK, 0, 0},
+ {TK_OPTION_CUSTOM, "-custom", NULL, NULL, "",
+ -1, Tk_Offset(InternalRecord, custom),
+ TK_CONFIG_NULL_OK, &CustomOption, 0x4000},
+ {TK_OPTION_SYNONYM, "-synonym", NULL, NULL,
+ NULL, -1, -1, 0, "-color", 0x8000},
+ {TK_OPTION_END, NULL, NULL, NULL, NULL, 0, 0, 0, NULL, 0}
+ };
+ Tk_OptionTable optionTable;
+ Tk_Window tkwin;
+
+ optionTable = Tk_CreateOptionTable(interp, internalSpecs);
+ tables[index] = optionTable;
+ tkwin = Tk_CreateWindowFromPath(interp, (Tk_Window) clientData,
+ Tcl_GetString(objv[2]), NULL);
+ if (tkwin == NULL) {
+ return TCL_ERROR;
+ }
+ Tk_SetClass(tkwin, "Test");
+
+ recordPtr = ckalloc(sizeof(InternalRecord));
+ recordPtr->header.interp = interp;
+ recordPtr->header.optionTable = optionTable;
+ recordPtr->header.tkwin = tkwin;
+ recordPtr->boolean = 0;
+ recordPtr->integer = 0;
+ recordPtr->doubleValue = 0.0;
+ recordPtr->string = NULL;
+ recordPtr->index = 0;
+ recordPtr->colorPtr = NULL;
+ recordPtr->tkfont = NULL;
+ recordPtr->bitmap = None;
+ recordPtr->border = NULL;
+ recordPtr->relief = TK_RELIEF_FLAT;
+ recordPtr->cursor = NULL;
+ recordPtr->justify = TK_JUSTIFY_LEFT;
+ recordPtr->anchor = TK_ANCHOR_N;
+ recordPtr->pixels = 0;
+ recordPtr->mm = 0.0;
+ recordPtr->tkwin = NULL;
+ recordPtr->custom = NULL;
+ result = Tk_InitOptions(interp, (char *) recordPtr, optionTable,
+ tkwin);
+ if (result == TCL_OK) {
+ recordPtr->header.widgetCmd = Tcl_CreateObjCommand(interp,
+ Tcl_GetString(objv[2]), TrivialConfigObjCmd,
+ recordPtr, TrivialCmdDeletedProc);
+ Tk_CreateEventHandler(tkwin, StructureNotifyMask,
+ TrivialEventProc, recordPtr);
+ result = Tk_SetOptions(interp, (char *) recordPtr, optionTable,
+ objc - 3, objv + 3, tkwin, NULL, NULL);
+ if (result != TCL_OK) {
+ Tk_DestroyWindow(tkwin);
+ }
+ } else {
+ Tk_DestroyWindow(tkwin);
+ ckfree(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 const Tk_OptionSpec smallSpecs[] = {
+ {TK_OPTION_INT, "-one", "one", "One", "1",
+ Tk_Offset(FiveRecord, one), -1, 0, NULL, 0},
+ {TK_OPTION_INT, "-two", "two", "Two", "2",
+ Tk_Offset(FiveRecord, two), -1, 0, NULL, 0},
+ {TK_OPTION_INT, "-three", "three", "Three", "3",
+ Tk_Offset(FiveRecord, three), -1, 0, NULL, 0},
+ {TK_OPTION_INT, "-four", "four", "Four", "4",
+ Tk_Offset(FiveRecord, four), -1, 0, NULL, 0},
+ {TK_OPTION_STRING, "-five", NULL, NULL, NULL,
+ Tk_Offset(FiveRecord, five), -1, 0, NULL, 0},
+ {TK_OPTION_END, NULL, NULL, NULL, NULL, 0, 0, 0, NULL, 0}
+ };
+
+ if (objc < 3) {
+ Tcl_WrongNumArgs(interp, 1, objv, "new name ?-option value ...?");
+ return TCL_ERROR;
+ }
+
+ recordPtr = 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, NULL, NULL);
+ if (result == TCL_OK) {
+ recordPtr->header.widgetCmd = Tcl_CreateObjCommand(interp,
+ Tcl_GetString(objv[2]), TrivialConfigObjCmd,
+ (ClientData) recordPtr, TrivialCmdDeletedProc);
+ } else {
+ Tk_FreeConfigOptions((char *) recordPtr,
+ recordPtr->header.optionTable, (Tk_Window) NULL);
+ }
+ }
+ if (result != TCL_OK) {
+ ckfree(recordPtr);
+ }
+
+ break;
+ }
+ case NOT_ENOUGH_PARAMS: {
+ typedef struct NotEnoughRecord {
+ Tcl_Obj *fooObjPtr;
+ } NotEnoughRecord;
+ NotEnoughRecord record;
+ static const Tk_OptionSpec errorSpecs[] = {
+ {TK_OPTION_INT, "-foo", "foo", "Foo", "0",
+ Tk_Offset(NotEnoughRecord, fooObjPtr), 0, 0, NULL, 0},
+ {TK_OPTION_END, NULL, NULL, NULL, NULL, 0, 0, 0, NULL, 0}
+ };
+ Tcl_Obj *newObjPtr = Tcl_NewStringObj("-foo", -1);
+ Tk_OptionTable optionTable;
+
+ record.fooObjPtr = NULL;
+
+ tkwin = Tk_CreateWindowFromPath(interp, mainWin, ".config", 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, NULL, 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 const Tk_OptionSpec slaveSpecs[] = {
+ {TK_OPTION_WINDOW, "-window", "window", "Window", ".bar",
+ Tk_Offset(SlaveRecord, windowPtr), -1, TK_CONFIG_NULL_OK, NULL, 0},
+ {TK_OPTION_END, NULL, NULL, NULL, NULL, 0, 0, 0, NULL, 0}
+ };
+ Tk_Window tkwin = Tk_CreateWindowFromPath(interp,
+ (Tk_Window) clientData, Tcl_GetString(objv[2]), NULL);
+
+ if (tkwin == NULL) {
+ return TCL_ERROR;
+ }
+ Tk_SetClass(tkwin, "Test");
+
+ recordPtr = 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, NULL, NULL);
+ if (result == TCL_OK) {
+ recordPtr->header.widgetCmd = Tcl_CreateObjCommand(interp,
+ Tcl_GetString(objv[2]), TrivialConfigObjCmd,
+ recordPtr, TrivialCmdDeletedProc);
+ Tk_CreateEventHandler(tkwin, StructureNotifyMask,
+ TrivialEventProc, recordPtr);
+ Tcl_SetObjResult(interp, objv[2]);
+ } else {
+ Tk_FreeConfigOptions((char *) recordPtr,
+ recordPtr->header.optionTable, tkwin);
+ }
+ }
+ if (result != TCL_OK) {
+ Tk_DestroyWindow(tkwin);
+ ckfree(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 clientData, /* Main window for application. */
+ Tcl_Interp *interp, /* Current interpreter. */
+ int objc, /* Number of arguments. */
+ Tcl_Obj *const objv[]) /* Argument objects. */
+{
+ int result = TCL_OK;
+ static const char *const options[] = {
+ "cget", "configure", "csave", 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_GetIndexFromObjStruct(interp, objv[1], options,
+ sizeof(char *), "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, 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, NULL, &mask);
+ if (result == TCL_OK) {
+ Tcl_SetObjResult(interp, Tcl_NewIntObj(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_SetObjResult(interp, Tcl_NewIntObj(mask));
+ }
+ break;
+ }
+ done:
+ Tcl_Release(clientData);
+ return result;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TrivialCmdDeletedProc --
+ *
+ * This function 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) /* 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 function. 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 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 function implements the "testfont" command, which is used to test
+ * TkFont objects.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+ /* ARGSUSED */
+static int
+TestfontObjCmd(
+ ClientData clientData, /* Main window for application. */
+ Tcl_Interp *interp, /* Current interpreter. */
+ int objc, /* Number of arguments. */
+ Tcl_Obj *const objv[]) /* Argument objects. */
+{
+ static const char *const options[] = {"counts", "subfonts", 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_GetIndexFromObjStruct(interp, objv[1], options,
+ sizeof(char *), "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 function is called by the Tk image code to create "test" images.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * The data structure for a new image is allocated.
+ *
+ *----------------------------------------------------------------------
+ */
+
+ /* ARGSUSED */
+static int
+ImageCreate(
+ Tcl_Interp *interp, /* Interpreter for application containing
+ * image. */
+ const 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). */
+ const 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;
+ const 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]), "\"", NULL);
+ return TCL_ERROR;
+ }
+ if ((i+1) == objc) {
+ Tcl_AppendResult(interp, "no value given for \"",
+ Tcl_GetString(objv[i]), "\" option", NULL);
+ return TCL_ERROR;
+ }
+ varName = Tcl_GetString(objv[i+1]);
+ }
+
+ timPtr = ckalloc(sizeof(TImageMaster));
+ timPtr->master = master;
+ timPtr->interp = interp;
+ timPtr->width = 30;
+ timPtr->height = 15;
+ timPtr->imageName = ckalloc(strlen(name) + 1);
+ strcpy(timPtr->imageName, name);
+ timPtr->varName = ckalloc(strlen(varName) + 1);
+ strcpy(timPtr->varName, varName);
+ Tcl_CreateObjCommand(interp, name, ImageObjCmd, timPtr, NULL);
+ *clientDataPtr = timPtr;
+ Tk_ImageChanged(master, 0, 0, 30, 15, 30, 15);
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ImageObjCmd --
+ *
+ * This function implements the commands corresponding to individual
+ * images.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * Forces windows to be created.
+ *
+ *----------------------------------------------------------------------
+ */
+
+ /* ARGSUSED */
+static int
+ImageObjCmd(
+ ClientData clientData, /* Main window for application. */
+ Tcl_Interp *interp, /* Current interpreter. */
+ int objc, /* Number of arguments. */
+ Tcl_Obj *const objv[]) /* Argument strings. */
+{
+ TImageMaster *timPtr = (TImageMaster *) clientData;
+ int x, y, width, height;
+
+ if (objc < 2) {
+ Tcl_WrongNumArgs(interp, 1, objv, "option ?arg ...?");
+ return TCL_ERROR;
+ }
+ if (strcmp(Tcl_GetString(objv[1]), "changed") == 0) {
+ if (objc != 8) {
+ Tcl_WrongNumArgs(interp, 1, objv, "changed x y width height"
+ " imageWidth imageHeight");
+ return TCL_ERROR;
+ }
+ if ((Tcl_GetIntFromObj(interp, objv[2], &x) != TCL_OK)
+ || (Tcl_GetIntFromObj(interp, objv[3], &y) != TCL_OK)
+ || (Tcl_GetIntFromObj(interp, objv[4], &width) != TCL_OK)
+ || (Tcl_GetIntFromObj(interp, objv[5], &height) != TCL_OK)
+ || (Tcl_GetIntFromObj(interp, objv[6], &timPtr->width) != TCL_OK)
+ || (Tcl_GetIntFromObj(interp, objv[7], &timPtr->height) != TCL_OK)) {
+ return TCL_ERROR;
+ }
+ Tk_ImageChanged(timPtr->master, x, y, width, height, timPtr->width,
+ timPtr->height);
+ } else {
+ Tcl_AppendResult(interp, "bad option \"", Tcl_GetString(objv[1]),
+ "\": must be changed", NULL);
+ return TCL_ERROR;
+ }
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ImageGet --
+ *
+ * This function is called by Tk to set things up for using a test image
+ * in a particular widget.
+ *
+ * Results:
+ * The return value is a token for the image instance, which is used in
+ * future callbacks to ImageDisplay and ImageFree.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static ClientData
+ImageGet(
+ Tk_Window tkwin, /* Token for window in which image will be
+ * used. */
+ ClientData clientData) /* Pointer to TImageMaster for image. */
+{
+ TImageMaster *timPtr = (TImageMaster *) clientData;
+ TImageInstance *instPtr;
+ char buffer[100];
+ XGCValues gcValues;
+
+ sprintf(buffer, "%s get", timPtr->imageName);
+ Tcl_SetVar2(timPtr->interp, timPtr->varName, NULL, buffer,
+ TCL_GLOBAL_ONLY|TCL_APPEND_VALUE|TCL_LIST_ELEMENT);
+
+ instPtr = ckalloc(sizeof(TImageInstance));
+ instPtr->masterPtr = timPtr;
+ instPtr->fg = Tk_GetColor(timPtr->interp, tkwin, "#ff0000");
+ gcValues.foreground = instPtr->fg->pixel;
+ instPtr->gc = Tk_GetGC(tkwin, GCForeground, &gcValues);
+ return instPtr;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ImageDisplay --
+ *
+ * This function is invoked to redisplay part or all of an image in a
+ * given drawable.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The image gets partially redrawn, as an "X" that shows the exact
+ * redraw area.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+ImageDisplay(
+ ClientData clientData, /* Pointer to TImageInstance for image. */
+ Display *display, /* Display to use for drawing. */
+ Drawable drawable, /* Where to redraw image. */
+ int imageX, int imageY, /* Origin of area to redraw, relative to
+ * origin of image. */
+ int width, int height, /* Dimensions of area to redraw. */
+ int drawableX, int drawableY)
+ /* Coordinates in drawable corresponding to
+ * imageX and imageY. */
+{
+ TImageInstance *instPtr = (TImageInstance *) clientData;
+ char buffer[200 + TCL_INTEGER_SPACE * 6];
+
+ sprintf(buffer, "%s display %d %d %d %d %d %d",
+ instPtr->masterPtr->imageName, imageX, imageY, width, height,
+ drawableX, drawableY);
+ Tcl_SetVar2(instPtr->masterPtr->interp, instPtr->masterPtr->varName, NULL,
+ buffer, TCL_GLOBAL_ONLY|TCL_APPEND_VALUE|TCL_LIST_ELEMENT);
+ if (width > (instPtr->masterPtr->width - imageX)) {
+ width = instPtr->masterPtr->width - imageX;
+ }
+ if (height > (instPtr->masterPtr->height - imageY)) {
+ height = instPtr->masterPtr->height - imageY;
+ }
+ XDrawRectangle(display, drawable, instPtr->gc, drawableX, drawableY,
+ (unsigned) (width-1), (unsigned) (height-1));
+ XDrawLine(display, drawable, instPtr->gc, drawableX, drawableY,
+ (int) (drawableX + width - 1), (int) (drawableY + height - 1));
+ XDrawLine(display, drawable, instPtr->gc, drawableX,
+ (int) (drawableY + height - 1),
+ (int) (drawableX + width - 1), drawableY);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ImageFree --
+ *
+ * This function is called when an instance of an image is no longer
+ * used.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Information related to the instance is freed.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+ImageFree(
+ ClientData clientData, /* Pointer to TImageInstance for instance. */
+ Display *display) /* Display where image was to be drawn. */
+{
+ TImageInstance *instPtr = (TImageInstance *) clientData;
+ char buffer[200];
+
+ sprintf(buffer, "%s free", instPtr->masterPtr->imageName);
+ Tcl_SetVar2(instPtr->masterPtr->interp, instPtr->masterPtr->varName, NULL,
+ buffer, TCL_GLOBAL_ONLY|TCL_APPEND_VALUE|TCL_LIST_ELEMENT);
+ Tk_FreeColor(instPtr->fg);
+ Tk_FreeGC(display, instPtr->gc);
+ ckfree(instPtr);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ImageDelete --
+ *
+ * This function is called to clean up a test image when an application
+ * goes away.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Information about the image is deleted.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+ImageDelete(
+ ClientData clientData) /* Pointer to TImageMaster for image. When
+ * this function is called, no more instances
+ * exist. */
+{
+ TImageMaster *timPtr = (TImageMaster *) clientData;
+ char buffer[100];
+
+ sprintf(buffer, "%s delete", timPtr->imageName);
+ Tcl_SetVar2(timPtr->interp, timPtr->varName, NULL, buffer,
+ TCL_GLOBAL_ONLY|TCL_APPEND_VALUE|TCL_LIST_ELEMENT);
+
+ Tcl_DeleteCommand(timPtr->interp, timPtr->imageName);
+ ckfree(timPtr->imageName);
+ ckfree(timPtr->varName);
+ ckfree(timPtr);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TestmakeexistObjCmd --
+ *
+ * This function implements the "testmakeexist" command. It calls
+ * Tk_MakeWindowExist on each of its arguments to force the windows to be
+ * created.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * Forces windows to be created.
+ *
+ *----------------------------------------------------------------------
+ */
+
+ /* ARGSUSED */
+static int
+TestmakeexistObjCmd(
+ ClientData clientData, /* Main window for application. */
+ Tcl_Interp *interp, /* Current interpreter. */
+ int objc, /* Number of arguments. */
+ Tcl_Obj *const objv[]) /* Argument strings. */
+{
+ Tk_Window mainWin = (Tk_Window) clientData;
+ int i;
+ Tk_Window tkwin;
+
+ for (i = 1; i < objc; i++) {
+ tkwin = Tk_NameToWindow(interp, Tcl_GetString(objv[i]), mainWin);
+ if (tkwin == NULL) {
+ return TCL_ERROR;
+ }
+ Tk_MakeWindowExist(tkwin);
+ }
+
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TestmenubarObjCmd --
+ *
+ * This function implements the "testmenubar" command. It is used to test
+ * the Unix facilities for creating space above a toplevel window for a
+ * menubar.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * Changes menubar related stuff.
+ *
+ *----------------------------------------------------------------------
+ */
+
+ /* ARGSUSED */
+#if !(defined(_WIN32) || defined(MAC_OSX_TK) || defined(__CYGWIN__))
+static int
+TestmenubarObjCmd(
+ ClientData clientData, /* Main window for application. */
+ Tcl_Interp *interp, /* Current interpreter. */
+ int objc, /* Number of arguments. */
+ Tcl_Obj *const objv[]) /* Argument strings. */
+{
+#ifdef __UNIX__
+ Tk_Window mainWin = (Tk_Window) clientData;
+ Tk_Window tkwin, menubar;
+
+ if (objc < 2) {
+ Tcl_WrongNumArgs(interp, 1, objv, "option ?arg ...?");
+ return TCL_ERROR;
+ }
+
+ if (strcmp(Tcl_GetString(objv[1]), "window") == 0) {
+ if (objc != 4) {
+ Tcl_WrongNumArgs(interp, 1, objv, "windows toplevel menubar");
+ return TCL_ERROR;
+ }
+ tkwin = Tk_NameToWindow(interp, Tcl_GetString(objv[2]), mainWin);
+ if (tkwin == NULL) {
+ return TCL_ERROR;
+ }
+ if (Tcl_GetString(objv[3])[0] == 0) {
+ TkUnixSetMenubar(tkwin, NULL);
+ } else {
+ menubar = Tk_NameToWindow(interp, Tcl_GetString(objv[3]), mainWin);
+ if (menubar == NULL) {
+ return TCL_ERROR;
+ }
+ TkUnixSetMenubar(tkwin, menubar);
+ }
+ } else {
+ Tcl_AppendResult(interp, "bad option \"", Tcl_GetString(objv[1]),
+ "\": must be window", NULL);
+ return TCL_ERROR;
+ }
+
+ return TCL_OK;
+#else
+ Tcl_AppendResult(interp, "testmenubar is supported only under Unix", NULL);
+ return TCL_ERROR;
+#endif
+}
+#endif
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TestmetricsObjCmd --
+ *
+ * This function implements the testmetrics command. It provides a way to
+ * determine the size of various widget components.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+#if defined(_WIN32) || defined(MAC_OSX_TK)
+static int
+TestmetricsObjCmd(
+ ClientData clientData, /* Main window for application. */
+ Tcl_Interp *interp, /* Current interpreter. */
+ int objc, /* Number of arguments. */
+ Tcl_Obj *const objv[]) /* Argument strings. */
+{
+ char buf[TCL_INTEGER_SPACE];
+ int val;
+
+#ifdef _WIN32
+ if (objc < 2) {
+ Tcl_WrongNumArgs(interp, 1, objv, "option ?arg ...?");
+ return TCL_ERROR;
+ }
+#else
+ Tk_Window tkwin = (Tk_Window) clientData;
+ TkWindow *winPtr;
+
+ if (objc != 3) {
+ Tcl_WrongNumArgs(interp, 1, objv, "option window");
+ return TCL_ERROR;
+ }
+
+ winPtr = (TkWindow *) Tk_NameToWindow(interp, Tcl_GetString(objv[2]), tkwin);
+ if (winPtr == NULL) {
+ return TCL_ERROR;
+ }
+#endif
+
+ if (strcmp(Tcl_GetString(objv[1]), "cyvscroll") == 0) {
+#ifdef _WIN32
+ val = GetSystemMetrics(SM_CYVSCROLL);
+#else
+ val = ((TkScrollbar *) winPtr->instanceData)->width;
+#endif
+ } else if (strcmp(Tcl_GetString(objv[1]), "cxhscroll") == 0) {
+#ifdef _WIN32
+ val = GetSystemMetrics(SM_CXHSCROLL);
+#else
+ val = ((TkScrollbar *) winPtr->instanceData)->width;
+#endif
+ } else {
+ Tcl_AppendResult(interp, "bad option \"", Tcl_GetString(objv[1]),
+ "\": must be cxhscroll or cyvscroll", NULL);
+ return TCL_ERROR;
+ }
+ sprintf(buf, "%d", val);
+ Tcl_AppendResult(interp, buf, NULL);
+ return TCL_OK;
+}
+#endif
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TestpropObjCmd --
+ *
+ * This function implements the "testprop" command. It fetches and prints
+ * the value of a property on a window.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+ /* ARGSUSED */
+static int
+TestpropObjCmd(
+ ClientData clientData, /* Main window for application. */
+ Tcl_Interp *interp, /* Current interpreter. */
+ int objc, /* Number of arguments. */
+ Tcl_Obj *const objv[]) /* Argument strings. */
+{
+ Tk_Window mainWin = (Tk_Window) clientData;
+ int result, actualFormat;
+ unsigned long bytesAfter, length, value;
+ Atom actualType, propName;
+ unsigned char *property, *p;
+ char *end;
+ Window w;
+ char buffer[30];
+
+ if (objc != 3) {
+ Tcl_WrongNumArgs(interp, 1, objv, "window property");
+ return TCL_ERROR;
+ }
+
+ w = strtoul(Tcl_GetString(objv[1]), &end, 0);
+ propName = Tk_InternAtom(mainWin, Tcl_GetString(objv[2]));
+ property = NULL;
+ result = XGetWindowProperty(Tk_Display(mainWin),
+ w, propName, 0, 100000, False, AnyPropertyType,
+ &actualType, &actualFormat, &length,
+ &bytesAfter, &property);
+ if ((result == Success) && (actualType != None)) {
+ if ((actualFormat == 8) && (actualType == XA_STRING)) {
+ for (p = property; ((unsigned long)(p-property)) < length; p++) {
+ if (*p == 0) {
+ *p = '\n';
+ }
+ }
+ Tcl_SetObjResult(interp, Tcl_NewStringObj((/*!unsigned*/char*)property, -1));
+ } else {
+ for (p = property; length > 0; length--) {
+ if (actualFormat == 32) {
+ value = *((long *) p);
+ p += sizeof(long);
+ } else if (actualFormat == 16) {
+ value = 0xffff & (*((short *) p));
+ p += sizeof(short);
+ } else {
+ value = 0xff & *p;
+ p += 1;
+ }
+ sprintf(buffer, "0x%lx", value);
+ Tcl_AppendElement(interp, buffer);
+ }
+ }
+ }
+ if (property != NULL) {
+ XFree(property);
+ }
+ return TCL_OK;
+}
+
+#if !(defined(_WIN32) || defined(MAC_OSX_TK) || defined(__CYGWIN__))
+/*
+ *----------------------------------------------------------------------
+ *
+ * TestwrapperObjCmd --
+ *
+ * This function implements the "testwrapper" command. It provides a way
+ * from Tcl to determine the extra window Tk adds in between the toplevel
+ * window and the window decorations.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+ /* ARGSUSED */
+static int
+TestwrapperObjCmd(
+ ClientData clientData, /* Main window for application. */
+ Tcl_Interp *interp, /* Current interpreter. */
+ int objc, /* Number of arguments. */
+ Tcl_Obj *const objv[]) /* Argument strings. */
+{
+ TkWindow *winPtr, *wrapperPtr;
+ Tk_Window tkwin;
+
+ if (objc != 2) {
+ Tcl_WrongNumArgs(interp, 1, objv, "window");
+ return TCL_ERROR;
+ }
+
+ tkwin = (Tk_Window) clientData;
+ winPtr = (TkWindow *) Tk_NameToWindow(interp, Tcl_GetString(objv[1]), tkwin);
+ if (winPtr == NULL) {
+ return TCL_ERROR;
+ }
+
+ wrapperPtr = TkpGetWrapperWindow(winPtr);
+ if (wrapperPtr != NULL) {
+ char buf[TCL_INTEGER_SPACE];
+
+ TkpPrintWindowId(buf, Tk_WindowId(wrapperPtr));
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(buf, -1));
+ }
+ return TCL_OK;
+}
+#endif
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * CustomOptionSet, CustomOptionGet, CustomOptionRestore, CustomOptionFree --
+ *
+ * Handlers for object-based custom configuration options. See
+ * Testobjconfigcommand.
+ *
+ * Results:
+ * See user documentation for expected results from these functions.
+ * CustomOptionSet Standard Tcl Result.
+ * CustomOptionGet Tcl_Obj * containing value.
+ * CustomOptionRestore None.
+ * CustomOptionFree None.
+ *
+ * Side effects:
+ * Depends on the function.
+ * CustomOptionSet Sets option value to new setting.
+ * CustomOptionGet Creates a new Tcl_Obj.
+ * CustomOptionRestore Resets option value to original value.
+ * CustomOptionFree Free storage for internal rep of
+ * option.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+CustomOptionSet(
+ ClientData clientData,
+ Tcl_Interp *interp,
+ Tk_Window tkwin,
+ Tcl_Obj **value,
+ char *recordPtr,
+ int internalOffset,
+ char *saveInternalPtr,
+ int flags)
+{
+ int objEmpty;
+ char *newStr, *string, *internalPtr;
+
+ objEmpty = 0;
+
+ if (internalOffset >= 0) {
+ internalPtr = recordPtr + internalOffset;
+ } else {
+ internalPtr = NULL;
+ }
+
+ /*
+ * See if the object is empty.
+ */
+
+ if (value == NULL) {
+ objEmpty = 1;
+ CLANG_ASSERT(value);
+ } else if ((*value)->bytes != NULL) {
+ objEmpty = ((*value)->length == 0);
+ } else {
+ (void)Tcl_GetString(*value);
+ objEmpty = ((*value)->length == 0);
+ }
+
+ if ((flags & TK_OPTION_NULL_OK) && objEmpty) {
+ *value = NULL;
+ } else {
+ string = Tcl_GetString(*value);
+ Tcl_UtfToUpper(string);
+ if (strcmp(string, "BAD") == 0) {
+ Tcl_SetObjResult(interp, Tcl_NewStringObj("expected good value, got \"BAD\"", -1));
+ return TCL_ERROR;
+ }
+ }
+ if (internalPtr != NULL) {
+ if (*value != NULL) {
+ string = Tcl_GetString(*value);
+ newStr = ckalloc((*value)->length + 1);
+ strcpy(newStr, string);
+ } else {
+ newStr = NULL;
+ }
+ *((char **) saveInternalPtr) = *((char **) internalPtr);
+ *((char **) internalPtr) = newStr;
+ }
+
+ return TCL_OK;
+}
+
+static Tcl_Obj *
+CustomOptionGet(
+ ClientData clientData,
+ Tk_Window tkwin,
+ char *recordPtr,
+ int internalOffset)
+{
+ return (Tcl_NewStringObj(*(char **)(recordPtr + internalOffset), -1));
+}
+
+static void
+CustomOptionRestore(
+ ClientData clientData,
+ Tk_Window tkwin,
+ char *internalPtr,
+ char *saveInternalPtr)
+{
+ *(char **)internalPtr = *(char **)saveInternalPtr;
+ return;
+}
+
+static void
+CustomOptionFree(
+ ClientData clientData,
+ Tk_Window tkwin,
+ char *internalPtr)
+{
+ if (*(char **)internalPtr != NULL) {
+ ckfree(*(char **)internalPtr);
+ }
+}
+
+/*
+ * Local Variables:
+ * mode: c
+ * c-basic-offset: 4
+ * fill-column: 78
+ * End:
+ */
diff --git a/tk8.6/generic/tkText.c b/tk8.6/generic/tkText.c
new file mode 100644
index 0000000..5ad527a
--- /dev/null
+++ b/tk8.6/generic/tkText.c
@@ -0,0 +1,6912 @@
+/*
+ * tkText.c --
+ *
+ * This module provides a big chunk of the implementation of multi-line
+ * editable text widgets for Tk. Among other things, it provides the Tcl
+ * command interfaces to text widgets. The B-tree representation of text
+ * and its actual display are implemented elsewhere.
+ *
+ * Copyright (c) 1992-1994 The Regents of the University of California.
+ * Copyright (c) 1994-1996 Sun Microsystems, Inc.
+ * Copyright (c) 1999 by Scriptics Corporation.
+ *
+ * See the file "license.terms" for information on usage and redistribution of
+ * this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ */
+
+#include "default.h"
+#include "tkInt.h"
+#include "tkUndo.h"
+
+#if defined(MAC_OSX_TK)
+#define Style TkStyle
+#define DInfo TkDInfo
+#endif
+
+/*
+ * For compatibility with Tk 4.0 through 8.4.x, we allow tabs to be
+ * mis-specified with non-increasing values. These are converted into tabs
+ * which are the equivalent of at least a character width apart.
+ */
+
+#if (TK_MAJOR_VERSION < 9)
+#define _TK_ALLOW_DECREASING_TABS
+#endif
+
+#include "tkText.h"
+
+/*
+ * Used to avoid having to allocate and deallocate arrays on the fly for
+ * commonly used functions. Must be > 0.
+ */
+
+#define PIXEL_CLIENTS 5
+
+/*
+ * The 'TkTextState' enum in tkText.h is used to define a type for the -state
+ * option of the Text widget. These values are used as indices into the string
+ * table below.
+ */
+
+static const char *const stateStrings[] = {
+ "disabled", "normal", NULL
+};
+
+/*
+ * The 'TkWrapMode' enum in tkText.h is used to define a type for the -wrap
+ * option of the Text widget. These values are used as indices into the string
+ * table below.
+ */
+
+static const char *const wrapStrings[] = {
+ "char", "none", "word", NULL
+};
+
+/*
+ * The 'TkTextTabStyle' enum in tkText.h is used to define a type for the
+ * -tabstyle option of the Text widget. These values are used as indices into
+ * the string table below.
+ */
+
+static const char *const tabStyleStrings[] = {
+ "tabular", "wordprocessor", NULL
+};
+
+/*
+ * The 'TkTextInsertUnfocussed' enum in tkText.h is used to define a type for
+ * the -insertunfocussed option of the Text widget. These values are used as
+ * indice into the string table below.
+ */
+
+static const char *const insertUnfocussedStrings[] = {
+ "hollow", "none", "solid", NULL
+};
+
+/*
+ * The following functions and custom option type are used to define the
+ * "line" option type, and thereby handle the text widget '-startline',
+ * '-endline' configuration options which are of that type.
+ *
+ * We do not need a 'freeProc' because all changes to these two options are
+ * handled through the TK_TEXT_LINE_RANGE flag in the optionSpecs list, and
+ * the internal storage is just a pointer, which therefore doesn't need
+ * freeing.
+ */
+
+static int SetLineStartEnd(ClientData clientData,
+ Tcl_Interp *interp, Tk_Window tkwin,
+ Tcl_Obj **value, char *recordPtr,
+ int internalOffset, char *oldInternalPtr,
+ int flags);
+static Tcl_Obj * GetLineStartEnd(ClientData clientData,
+ Tk_Window tkwin, char *recordPtr,
+ int internalOffset);
+static void RestoreLineStartEnd(ClientData clientData,
+ Tk_Window tkwin, char *internalPtr,
+ char *oldInternalPtr);
+static int ObjectIsEmpty(Tcl_Obj *objPtr);
+
+static const Tk_ObjCustomOption lineOption = {
+ "line", /* name */
+ SetLineStartEnd, /* setProc */
+ GetLineStartEnd, /* getProc */
+ RestoreLineStartEnd, /* restoreProc */
+ NULL, /* freeProc */
+ 0
+};
+
+/*
+ * Information used to parse text configuration options:
+ */
+
+static const Tk_OptionSpec optionSpecs[] = {
+ {TK_OPTION_BOOLEAN, "-autoseparators", "autoSeparators",
+ "AutoSeparators", DEF_TEXT_AUTO_SEPARATORS, -1,
+ Tk_Offset(TkText, autoSeparators),
+ TK_OPTION_DONT_SET_DEFAULT, 0, 0},
+ {TK_OPTION_BORDER, "-background", "background", "Background",
+ DEF_TEXT_BG_COLOR, -1, Tk_Offset(TkText, border),
+ 0, DEF_TEXT_BG_MONO, 0},
+ {TK_OPTION_SYNONYM, "-bd", NULL, NULL,
+ NULL, 0, -1, 0, "-borderwidth",
+ TK_TEXT_LINE_GEOMETRY},
+ {TK_OPTION_SYNONYM, "-bg", NULL, NULL,
+ NULL, 0, -1, 0, "-background", 0},
+ {TK_OPTION_BOOLEAN, "-blockcursor", "blockCursor",
+ "BlockCursor", DEF_TEXT_BLOCK_CURSOR, -1,
+ Tk_Offset(TkText, insertCursorType), 0, 0, 0},
+ {TK_OPTION_PIXELS, "-borderwidth", "borderWidth", "BorderWidth",
+ DEF_TEXT_BORDER_WIDTH, -1, Tk_Offset(TkText, borderWidth),
+ 0, 0, TK_TEXT_LINE_GEOMETRY},
+ {TK_OPTION_CURSOR, "-cursor", "cursor", "Cursor",
+ DEF_TEXT_CURSOR, -1, Tk_Offset(TkText, cursor),
+ TK_OPTION_NULL_OK, 0, 0},
+ {TK_OPTION_CUSTOM, "-endline", NULL, NULL,
+ NULL, -1, Tk_Offset(TkText, end), TK_OPTION_NULL_OK,
+ &lineOption, TK_TEXT_LINE_RANGE},
+ {TK_OPTION_BOOLEAN, "-exportselection", "exportSelection",
+ "ExportSelection", DEF_TEXT_EXPORT_SELECTION, -1,
+ Tk_Offset(TkText, exportSelection), 0, 0, 0},
+ {TK_OPTION_SYNONYM, "-fg", "foreground", NULL,
+ NULL, 0, -1, 0, "-foreground", 0},
+ {TK_OPTION_FONT, "-font", "font", "Font",
+ DEF_TEXT_FONT, -1, Tk_Offset(TkText, tkfont), 0, 0,
+ TK_TEXT_LINE_GEOMETRY},
+ {TK_OPTION_COLOR, "-foreground", "foreground", "Foreground",
+ DEF_TEXT_FG, -1, Tk_Offset(TkText, fgColor), 0,
+ 0, 0},
+ {TK_OPTION_PIXELS, "-height", "height", "Height",
+ DEF_TEXT_HEIGHT, -1, Tk_Offset(TkText, height), 0, 0, 0},
+ {TK_OPTION_COLOR, "-highlightbackground", "highlightBackground",
+ "HighlightBackground", DEF_TEXT_HIGHLIGHT_BG,
+ -1, Tk_Offset(TkText, highlightBgColorPtr),
+ 0, 0, 0},
+ {TK_OPTION_COLOR, "-highlightcolor", "highlightColor", "HighlightColor",
+ DEF_TEXT_HIGHLIGHT, -1, Tk_Offset(TkText, highlightColorPtr),
+ 0, 0, 0},
+ {TK_OPTION_PIXELS, "-highlightthickness", "highlightThickness",
+ "HighlightThickness", DEF_TEXT_HIGHLIGHT_WIDTH, -1,
+ Tk_Offset(TkText, highlightWidth), 0, 0, TK_TEXT_LINE_GEOMETRY},
+ {TK_OPTION_BORDER, "-inactiveselectbackground","inactiveSelectBackground",
+ "Foreground",
+ DEF_TEXT_INACTIVE_SELECT_COLOR,
+ -1, Tk_Offset(TkText, inactiveSelBorder),
+ TK_OPTION_NULL_OK, DEF_TEXT_SELECT_MONO, 0},
+ {TK_OPTION_BORDER, "-insertbackground", "insertBackground", "Foreground",
+ DEF_TEXT_INSERT_BG,
+ -1, Tk_Offset(TkText, insertBorder),
+ 0, 0, 0},
+ {TK_OPTION_PIXELS, "-insertborderwidth", "insertBorderWidth",
+ "BorderWidth", DEF_TEXT_INSERT_BD_COLOR, -1,
+ Tk_Offset(TkText, insertBorderWidth), 0,
+ (ClientData) DEF_TEXT_INSERT_BD_MONO, 0},
+ {TK_OPTION_INT, "-insertofftime", "insertOffTime", "OffTime",
+ DEF_TEXT_INSERT_OFF_TIME, -1, Tk_Offset(TkText, insertOffTime),
+ 0, 0, 0},
+ {TK_OPTION_INT, "-insertontime", "insertOnTime", "OnTime",
+ DEF_TEXT_INSERT_ON_TIME, -1, Tk_Offset(TkText, insertOnTime),
+ 0, 0, 0},
+ {TK_OPTION_STRING_TABLE,
+ "-insertunfocussed", "insertUnfocussed", "InsertUnfocussed",
+ DEF_TEXT_INSERT_UNFOCUSSED, -1, Tk_Offset(TkText, insertUnfocussed),
+ 0, insertUnfocussedStrings, 0},
+ {TK_OPTION_PIXELS, "-insertwidth", "insertWidth", "InsertWidth",
+ DEF_TEXT_INSERT_WIDTH, -1, Tk_Offset(TkText, insertWidth),
+ 0, 0, 0},
+ {TK_OPTION_INT, "-maxundo", "maxUndo", "MaxUndo",
+ DEF_TEXT_MAX_UNDO, -1, Tk_Offset(TkText, maxUndo),
+ TK_OPTION_DONT_SET_DEFAULT, 0, 0},
+ {TK_OPTION_PIXELS, "-padx", "padX", "Pad",
+ DEF_TEXT_PADX, -1, Tk_Offset(TkText, padX), 0, 0,
+ TK_TEXT_LINE_GEOMETRY},
+ {TK_OPTION_PIXELS, "-pady", "padY", "Pad",
+ DEF_TEXT_PADY, -1, Tk_Offset(TkText, padY), 0, 0, 0},
+ {TK_OPTION_RELIEF, "-relief", "relief", "Relief",
+ DEF_TEXT_RELIEF, -1, Tk_Offset(TkText, relief), 0, 0, 0},
+ {TK_OPTION_BORDER, "-selectbackground", "selectBackground", "Foreground",
+ DEF_TEXT_SELECT_COLOR, -1, Tk_Offset(TkText, selBorder),
+ 0, DEF_TEXT_SELECT_MONO, 0},
+ {TK_OPTION_PIXELS, "-selectborderwidth", "selectBorderWidth",
+ "BorderWidth", DEF_TEXT_SELECT_BD_COLOR,
+ Tk_Offset(TkText, selBorderWidthPtr),
+ Tk_Offset(TkText, selBorderWidth),
+ TK_OPTION_NULL_OK, DEF_TEXT_SELECT_BD_MONO, 0},
+ {TK_OPTION_COLOR, "-selectforeground", "selectForeground", "Background",
+ DEF_TEXT_SELECT_FG_COLOR, -1, Tk_Offset(TkText, selFgColorPtr),
+ TK_OPTION_NULL_OK, DEF_TEXT_SELECT_FG_MONO, 0},
+ {TK_OPTION_BOOLEAN, "-setgrid", "setGrid", "SetGrid",
+ DEF_TEXT_SET_GRID, -1, Tk_Offset(TkText, setGrid), 0, 0, 0},
+ {TK_OPTION_PIXELS, "-spacing1", "spacing1", "Spacing",
+ DEF_TEXT_SPACING1, -1, Tk_Offset(TkText, spacing1),
+ 0, 0 , TK_TEXT_LINE_GEOMETRY },
+ {TK_OPTION_PIXELS, "-spacing2", "spacing2", "Spacing",
+ DEF_TEXT_SPACING2, -1, Tk_Offset(TkText, spacing2),
+ 0, 0 , TK_TEXT_LINE_GEOMETRY },
+ {TK_OPTION_PIXELS, "-spacing3", "spacing3", "Spacing",
+ DEF_TEXT_SPACING3, -1, Tk_Offset(TkText, spacing3),
+ 0, 0 , TK_TEXT_LINE_GEOMETRY },
+ {TK_OPTION_CUSTOM, "-startline", NULL, NULL,
+ NULL, -1, Tk_Offset(TkText, start), TK_OPTION_NULL_OK,
+ &lineOption, TK_TEXT_LINE_RANGE},
+ {TK_OPTION_STRING_TABLE, "-state", "state", "State",
+ DEF_TEXT_STATE, -1, Tk_Offset(TkText, state),
+ 0, stateStrings, 0},
+ {TK_OPTION_STRING, "-tabs", "tabs", "Tabs",
+ DEF_TEXT_TABS, Tk_Offset(TkText, tabOptionPtr), -1,
+ TK_OPTION_NULL_OK, 0, TK_TEXT_LINE_GEOMETRY},
+ {TK_OPTION_STRING_TABLE, "-tabstyle", "tabStyle", "TabStyle",
+ DEF_TEXT_TABSTYLE, -1, Tk_Offset(TkText, tabStyle),
+ 0, tabStyleStrings, TK_TEXT_LINE_GEOMETRY},
+ {TK_OPTION_STRING, "-takefocus", "takeFocus", "TakeFocus",
+ DEF_TEXT_TAKE_FOCUS, -1, Tk_Offset(TkText, takeFocus),
+ TK_OPTION_NULL_OK, 0, 0},
+ {TK_OPTION_BOOLEAN, "-undo", "undo", "Undo",
+ DEF_TEXT_UNDO, -1, Tk_Offset(TkText, undo),
+ TK_OPTION_DONT_SET_DEFAULT, 0 , 0},
+ {TK_OPTION_INT, "-width", "width", "Width",
+ DEF_TEXT_WIDTH, -1, Tk_Offset(TkText, width), 0, 0,
+ TK_TEXT_LINE_GEOMETRY},
+ {TK_OPTION_STRING_TABLE, "-wrap", "wrap", "Wrap",
+ DEF_TEXT_WRAP, -1, Tk_Offset(TkText, wrapMode),
+ 0, wrapStrings, TK_TEXT_LINE_GEOMETRY},
+ {TK_OPTION_STRING, "-xscrollcommand", "xScrollCommand", "ScrollCommand",
+ DEF_TEXT_XSCROLL_COMMAND, -1, Tk_Offset(TkText, xScrollCmd),
+ TK_OPTION_NULL_OK, 0, 0},
+ {TK_OPTION_STRING, "-yscrollcommand", "yScrollCommand", "ScrollCommand",
+ DEF_TEXT_YSCROLL_COMMAND, -1, Tk_Offset(TkText, yScrollCmd),
+ TK_OPTION_NULL_OK, 0, 0},
+ {TK_OPTION_END, NULL, NULL, NULL, 0, 0, 0, 0, 0, 0}
+};
+
+/*
+ * These three typedefs, the structure and the SearchPerform, SearchCore
+ * functions below are used for line-based searches of the text widget, and,
+ * in particular, to handle multi-line matching even though the text widget is
+ * a single-line based data structure. They are completely abstracted away
+ * from the Text widget internals, however, so could easily be re-used with
+ * any line-based entity to provide multi-line matching.
+ *
+ * We have abstracted this code away from the text widget to try to keep Tk as
+ * modular as possible.
+ */
+
+struct SearchSpec; /* Forward declaration. */
+
+typedef ClientData SearchAddLineProc(int lineNum,
+ struct SearchSpec *searchSpecPtr,
+ Tcl_Obj *theLine, int *lenPtr,
+ int *extraLinesPtr);
+typedef int SearchMatchProc(int lineNum,
+ struct SearchSpec *searchSpecPtr,
+ ClientData clientData, Tcl_Obj *theLine,
+ int matchOffset, int matchLength);
+typedef int SearchLineIndexProc(Tcl_Interp *interp,
+ Tcl_Obj *objPtr, struct SearchSpec *searchSpecPtr,
+ int *linePosPtr, int *offsetPosPtr);
+
+typedef struct SearchSpec {
+ int exact; /* Whether search is exact or regexp. */
+ int noCase; /* Case-insenstivive? */
+ int noLineStop; /* If not set, a regexp search will use the
+ * TCL_REG_NLSTOP flag. */
+ int overlap; /* If set, results from multiple searches
+ * (-all) are allowed to overlap each
+ * other. */
+ int strictLimits; /* If set, matches must be completely inside
+ * the from,to range. Otherwise the limits
+ * only apply to the start of each match. */
+ int all; /* Whether all or the first match should be
+ * reported. */
+ int startLine; /* First line to examine. */
+ int startOffset; /* Index in first line to start at. */
+ int stopLine; /* Last line to examine, or -1 when we search
+ * all available text. */
+ int stopOffset; /* Index to stop at, provided stopLine is not
+ * -1. */
+ int numLines; /* Total lines which are available. */
+ int backwards; /* Searching forwards or backwards. */
+ Tcl_Obj *varPtr; /* If non-NULL, store length(s) of match(es)
+ * in this variable. */
+ Tcl_Obj *countPtr; /* Keeps track of currently found lengths. */
+ Tcl_Obj *resPtr; /* Keeps track of currently found locations */
+ int searchElide; /* Search in hidden text as well. */
+ SearchAddLineProc *addLineProc;
+ /* Function to call when we need to add
+ * another line to the search string so far */
+ SearchMatchProc *foundMatchProc;
+ /* Function to call when we have found a
+ * match. */
+ SearchLineIndexProc *lineIndexProc;
+ /* Function to call when we have found a
+ * match. */
+ ClientData clientData; /* Information about structure being searched,
+ * in this case a text widget. */
+} SearchSpec;
+
+/*
+ * The text-widget-independent functions which actually perform the search,
+ * handling both regexp and exact searches.
+ */
+
+static int SearchCore(Tcl_Interp *interp,
+ SearchSpec *searchSpecPtr, Tcl_Obj *patObj);
+static int SearchPerform(Tcl_Interp *interp,
+ SearchSpec *searchSpecPtr, Tcl_Obj *patObj,
+ Tcl_Obj *fromPtr, Tcl_Obj *toPtr);
+
+/*
+ * Boolean variable indicating whether or not special debugging code should be
+ * executed.
+ */
+
+int tkTextDebug = 0;
+
+/*
+ * Forward declarations for functions defined later in this file:
+ */
+
+static int ConfigureText(Tcl_Interp *interp,
+ TkText *textPtr, int objc, Tcl_Obj *const objv[]);
+static int DeleteIndexRange(TkSharedText *sharedPtr,
+ TkText *textPtr, const TkTextIndex *indexPtr1,
+ const TkTextIndex *indexPtr2, int viewUpdate);
+static int CountIndices(const TkText *textPtr,
+ const TkTextIndex *indexPtr1,
+ const TkTextIndex *indexPtr2,
+ TkTextCountType type);
+static void DestroyText(TkText *textPtr);
+static int InsertChars(TkSharedText *sharedTextPtr,
+ TkText *textPtr, TkTextIndex *indexPtr,
+ Tcl_Obj *stringPtr, int viewUpdate);
+static void TextBlinkProc(ClientData clientData);
+static void TextCmdDeletedProc(ClientData clientData);
+static int CreateWidget(TkSharedText *sharedPtr, Tk_Window tkwin,
+ Tcl_Interp *interp, const TkText *parent,
+ int objc, Tcl_Obj *const objv[]);
+static void TextEventProc(ClientData clientData,
+ XEvent *eventPtr);
+static int TextFetchSelection(ClientData clientData, int offset,
+ char *buffer, int maxBytes);
+static int TextIndexSortProc(const void *first,
+ const void *second);
+static int TextInsertCmd(TkSharedText *sharedTextPtr,
+ TkText *textPtr, Tcl_Interp *interp,
+ int objc, Tcl_Obj *const objv[],
+ const TkTextIndex *indexPtr, int viewUpdate);
+static int TextReplaceCmd(TkText *textPtr, Tcl_Interp *interp,
+ const TkTextIndex *indexFromPtr,
+ const TkTextIndex *indexToPtr,
+ int objc, Tcl_Obj *const objv[], int viewUpdate);
+static int TextSearchCmd(TkText *textPtr, Tcl_Interp *interp,
+ int objc, Tcl_Obj *const objv[]);
+static int TextEditCmd(TkText *textPtr, Tcl_Interp *interp,
+ int objc, Tcl_Obj *const objv[]);
+static int TextWidgetObjCmd(ClientData clientData,
+ Tcl_Interp *interp,
+ int objc, Tcl_Obj *const objv[]);
+static int SharedTextObjCmd(ClientData clientData,
+ Tcl_Interp *interp,
+ int objc, Tcl_Obj *const objv[]);
+static void TextWorldChangedCallback(ClientData instanceData);
+static void TextWorldChanged(TkText *textPtr, int mask);
+static int TextDumpCmd(TkText *textPtr, Tcl_Interp *interp,
+ int objc, Tcl_Obj *const objv[]);
+static int DumpLine(Tcl_Interp *interp, TkText *textPtr,
+ int what, TkTextLine *linePtr, int start, int end,
+ int lineno, Tcl_Obj *command);
+static int DumpSegment(TkText *textPtr, Tcl_Interp *interp,
+ const char *key, const char *value,
+ Tcl_Obj *command, const TkTextIndex *index,
+ int what);
+static int TextEditUndo(TkText *textPtr);
+static int TextEditRedo(TkText *textPtr);
+static Tcl_Obj * TextGetText(const TkText *textPtr,
+ const TkTextIndex *index1,
+ const TkTextIndex *index2, int visibleOnly);
+static void GenerateModifiedEvent(TkText *textPtr);
+static void GenerateUndoStackEvent(TkText *textPtr);
+static void UpdateDirtyFlag(TkSharedText *sharedPtr);
+static void RunAfterSyncCmd(ClientData clientData);
+static void TextPushUndoAction(TkText *textPtr,
+ Tcl_Obj *undoString, int insert,
+ const TkTextIndex *index1Ptr,
+ const TkTextIndex *index2Ptr);
+static int TextSearchIndexInLine(const SearchSpec *searchSpecPtr,
+ TkTextLine *linePtr, int byteIndex);
+static int TextPeerCmd(TkText *textPtr, Tcl_Interp *interp,
+ int objc, Tcl_Obj *const objv[]);
+static TkUndoProc TextUndoRedoCallback;
+
+/*
+ * Declarations of the three search procs required by the multi-line search
+ * routines.
+ */
+
+static SearchMatchProc TextSearchFoundMatch;
+static SearchAddLineProc TextSearchAddNextLine;
+static SearchLineIndexProc TextSearchGetLineIndex;
+
+/*
+ * The structure below defines text class behavior by means of functions that
+ * can be invoked from generic window code.
+ */
+
+static const Tk_ClassProcs textClass = {
+ sizeof(Tk_ClassProcs), /* size */
+ TextWorldChangedCallback, /* worldChangedProc */
+ NULL, /* createProc */
+ NULL /* modalProc */
+};
+
+/*
+ *--------------------------------------------------------------
+ *
+ * Tk_TextObjCmd --
+ *
+ * This function is invoked to process the "text" Tcl command. See the
+ * user documentation for details on what it does.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * See the user documentation.
+ *
+ *--------------------------------------------------------------
+ */
+
+int
+Tk_TextObjCmd(
+ 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 = clientData;
+
+ if (objc < 2) {
+ Tcl_WrongNumArgs(interp, 1, objv, "pathName ?-option value ...?");
+ return TCL_ERROR;
+ }
+
+ return CreateWidget(NULL, tkwin, interp, NULL, objc, objv);
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * CreateWidget --
+ *
+ * This function is invoked to process the "text" Tcl command, (when
+ * called by Tk_TextObjCmd) and the "$text peer create" text widget
+ * sub-command (called from TextPeerCmd).
+ *
+ * See the user documentation for details on what it does.
+ *
+ * Results:
+ * A standard Tcl result, places the name of the widget created into the
+ * interp's result.
+ *
+ * Side effects:
+ * See the user documentation.
+ *
+ *--------------------------------------------------------------
+ */
+
+static int
+CreateWidget(
+ TkSharedText *sharedPtr, /* Shared widget info, or NULL. */
+ Tk_Window tkwin, /* Main window associated with interpreter. */
+ Tcl_Interp *interp, /* Current interpreter. */
+ const TkText *parent, /* If non-NULL then take default start, end
+ * from this parent. */
+ int objc, /* Number of arguments. */
+ Tcl_Obj *const objv[]) /* Argument objects. */
+{
+ register TkText *textPtr;
+ Tk_OptionTable optionTable;
+ TkTextIndex startIndex;
+ Tk_Window newWin;
+
+ /*
+ * Create the window.
+ */
+
+ newWin = Tk_CreateWindowFromPath(interp, tkwin, Tcl_GetString(objv[1]),
+ NULL);
+ if (newWin == NULL) {
+ return TCL_ERROR;
+ }
+
+ /*
+ * Create the text widget and initialize everything to zero, then set the
+ * necessary initial (non-NULL) values. It is important that the 'set' tag
+ * and 'insert', 'current' mark pointers are all NULL to start.
+ */
+
+ textPtr = ckalloc(sizeof(TkText));
+ memset(textPtr, 0, sizeof(TkText));
+
+ textPtr->tkwin = newWin;
+ textPtr->display = Tk_Display(newWin);
+ textPtr->interp = interp;
+ textPtr->widgetCmd = Tcl_CreateObjCommand(interp,
+ Tk_PathName(textPtr->tkwin), TextWidgetObjCmd,
+ textPtr, TextCmdDeletedProc);
+
+ if (sharedPtr == NULL) {
+ sharedPtr = ckalloc(sizeof(TkSharedText));
+ memset(sharedPtr, 0, sizeof(TkSharedText));
+
+ sharedPtr->refCount = 0;
+ sharedPtr->peers = NULL;
+ sharedPtr->tree = TkBTreeCreate(sharedPtr);
+
+ Tcl_InitHashTable(&sharedPtr->tagTable, TCL_STRING_KEYS);
+ Tcl_InitHashTable(&sharedPtr->markTable, TCL_STRING_KEYS);
+ Tcl_InitHashTable(&sharedPtr->windowTable, TCL_STRING_KEYS);
+ Tcl_InitHashTable(&sharedPtr->imageTable, TCL_STRING_KEYS);
+ sharedPtr->undoStack = TkUndoInitStack(interp,0);
+ sharedPtr->undo = 1;
+ sharedPtr->isDirty = 0;
+ sharedPtr->dirtyMode = TK_TEXT_DIRTY_NORMAL;
+ sharedPtr->autoSeparators = 1;
+ sharedPtr->lastEditMode = TK_TEXT_EDIT_OTHER;
+ sharedPtr->stateEpoch = 0;
+ }
+
+ /*
+ * Add the new widget to the shared list.
+ */
+
+ textPtr->sharedTextPtr = sharedPtr;
+ sharedPtr->refCount++;
+ textPtr->next = sharedPtr->peers;
+ sharedPtr->peers = textPtr;
+
+ /*
+ * This refCount will be held until DestroyText is called. Note also that
+ * the later call to 'TkTextCreateDInfo' will add more refCounts.
+ */
+
+ textPtr->refCount = 1;
+
+ /*
+ * Specify start and end lines in the B-tree. The default is the same as
+ * the parent, but this can be adjusted to display more or less if the
+ * start, end where given as configuration options.
+ */
+
+ if (parent != NULL) {
+ textPtr->start = parent->start;
+ textPtr->end = parent->end;
+ } else {
+ textPtr->start = NULL;
+ textPtr->end = NULL;
+ }
+
+ textPtr->state = TK_TEXT_STATE_NORMAL;
+ textPtr->relief = TK_RELIEF_FLAT;
+ textPtr->cursor = None;
+ textPtr->charWidth = 1;
+ textPtr->charHeight = 10;
+ textPtr->wrapMode = TEXT_WRAPMODE_CHAR;
+ textPtr->prevWidth = Tk_Width(newWin);
+ textPtr->prevHeight = Tk_Height(newWin);
+
+ /*
+ * Register with the B-tree. In some sense it would be best if we could do
+ * this later (after configuration options), so that any changes to
+ * start,end do not require a total recalculation.
+ */
+
+ TkBTreeAddClient(sharedPtr->tree, textPtr, textPtr->charHeight);
+
+ /*
+ * This will add refCounts to textPtr.
+ */
+
+ TkTextCreateDInfo(textPtr);
+ TkTextMakeByteIndex(textPtr->sharedTextPtr->tree, textPtr, 0, 0,
+ &startIndex);
+ TkTextSetYView(textPtr, &startIndex, 0);
+ textPtr->exportSelection = 1;
+ textPtr->pickEvent.type = LeaveNotify;
+ textPtr->undo = textPtr->sharedTextPtr->undo;
+ textPtr->maxUndo = textPtr->sharedTextPtr->maxUndo;
+ textPtr->autoSeparators = textPtr->sharedTextPtr->autoSeparators;
+ textPtr->tabOptionPtr = NULL;
+
+ /*
+ * Create the "sel" tag and the "current" and "insert" marks.
+ */
+
+ textPtr->selBorder = NULL;
+ textPtr->inactiveSelBorder = NULL;
+ textPtr->selBorderWidth = 0;
+ textPtr->selBorderWidthPtr = NULL;
+ textPtr->selFgColorPtr = NULL;
+
+ /*
+ * Note: it is important that textPtr->selTagPtr is NULL before this
+ * initial call.
+ */
+
+ textPtr->selTagPtr = TkTextCreateTag(textPtr, "sel", NULL);
+ textPtr->selTagPtr->reliefString =
+ ckalloc(sizeof(DEF_TEXT_SELECT_RELIEF));
+ strcpy(textPtr->selTagPtr->reliefString, DEF_TEXT_SELECT_RELIEF);
+ Tk_GetRelief(interp, DEF_TEXT_SELECT_RELIEF, &textPtr->selTagPtr->relief);
+ textPtr->currentMarkPtr = TkTextSetMark(textPtr, "current", &startIndex);
+ textPtr->insertMarkPtr = TkTextSetMark(textPtr, "insert", &startIndex);
+
+ /*
+ * Create the option table for this widget class. If it has already been
+ * created, the cached pointer will be returned.
+ */
+
+ optionTable = Tk_CreateOptionTable(interp, optionSpecs);
+
+ Tk_SetClass(textPtr->tkwin, "Text");
+ Tk_SetClassProcs(textPtr->tkwin, &textClass, textPtr);
+ textPtr->optionTable = optionTable;
+
+ Tk_CreateEventHandler(textPtr->tkwin,
+ ExposureMask|StructureNotifyMask|FocusChangeMask,
+ TextEventProc, textPtr);
+ Tk_CreateEventHandler(textPtr->tkwin, KeyPressMask|KeyReleaseMask
+ |ButtonPressMask|ButtonReleaseMask|EnterWindowMask
+ |LeaveWindowMask|PointerMotionMask|VirtualEventMask,
+ TkTextBindProc, textPtr);
+ Tk_CreateSelHandler(textPtr->tkwin, XA_PRIMARY, XA_STRING,
+ TextFetchSelection, textPtr, XA_STRING);
+
+ if (Tk_InitOptions(interp, (char *) textPtr, optionTable, textPtr->tkwin)
+ != TCL_OK) {
+ Tk_DestroyWindow(textPtr->tkwin);
+ return TCL_ERROR;
+ }
+ if (ConfigureText(interp, textPtr, objc-2, objv+2) != TCL_OK) {
+ Tk_DestroyWindow(textPtr->tkwin);
+ return TCL_ERROR;
+ }
+
+ Tcl_SetObjResult(interp, TkNewWindowObj(textPtr->tkwin));
+ return TCL_OK;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * TextWidgetObjCmd --
+ *
+ * This function is invoked to process the Tcl command that corresponds
+ * to a text widget. See the user documentation for details on what it
+ * does.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * See the user documentation.
+ *
+ *--------------------------------------------------------------
+ */
+
+static int
+TextWidgetObjCmd(
+ ClientData clientData, /* Information about text widget. */
+ Tcl_Interp *interp, /* Current interpreter. */
+ int objc, /* Number of arguments. */
+ Tcl_Obj *const objv[]) /* Argument objects. */
+{
+ register TkText *textPtr = clientData;
+ int result = TCL_OK;
+ int index;
+
+ static const char *const optionStrings[] = {
+ "bbox", "cget", "compare", "configure", "count", "debug", "delete",
+ "dlineinfo", "dump", "edit", "get", "image", "index", "insert",
+ "mark", "peer", "pendingsync", "replace", "scan", "search",
+ "see", "sync", "tag", "window", "xview", "yview", NULL
+ };
+ enum options {
+ TEXT_BBOX, TEXT_CGET, TEXT_COMPARE, TEXT_CONFIGURE, TEXT_COUNT,
+ TEXT_DEBUG, TEXT_DELETE, TEXT_DLINEINFO, TEXT_DUMP, TEXT_EDIT,
+ TEXT_GET, TEXT_IMAGE, TEXT_INDEX, TEXT_INSERT, TEXT_MARK,
+ TEXT_PEER, TEXT_PENDINGSYNC, TEXT_REPLACE, TEXT_SCAN,
+ TEXT_SEARCH, TEXT_SEE, TEXT_SYNC, TEXT_TAG, TEXT_WINDOW,
+ TEXT_XVIEW, TEXT_YVIEW
+ };
+
+ if (objc < 2) {
+ Tcl_WrongNumArgs(interp, 1, objv, "option ?arg ...?");
+ return TCL_ERROR;
+ }
+
+ if (Tcl_GetIndexFromObjStruct(interp, objv[1], optionStrings,
+ sizeof(char *), "option", 0, &index) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ textPtr->refCount++;
+
+ switch ((enum options) index) {
+ case TEXT_BBOX: {
+ int x, y, width, height;
+ const TkTextIndex *indexPtr;
+
+ if (objc != 3) {
+ Tcl_WrongNumArgs(interp, 2, objv, "index");
+ result = TCL_ERROR;
+ goto done;
+ }
+ indexPtr = TkTextGetIndexFromObj(interp, textPtr, objv[2]);
+ if (indexPtr == NULL) {
+ result = TCL_ERROR;
+ goto done;
+ }
+ if (TkTextIndexBbox(textPtr, indexPtr, &x, &y, &width, &height,
+ NULL) == 0) {
+ Tcl_Obj *listObj = Tcl_NewListObj(0, NULL);
+
+ Tcl_ListObjAppendElement(interp, listObj, Tcl_NewIntObj(x));
+ Tcl_ListObjAppendElement(interp, listObj, Tcl_NewIntObj(y));
+ Tcl_ListObjAppendElement(interp, listObj, Tcl_NewIntObj(width));
+ Tcl_ListObjAppendElement(interp, listObj, Tcl_NewIntObj(height));
+
+ Tcl_SetObjResult(interp, listObj);
+ }
+ break;
+ }
+ case TEXT_CGET:
+ if (objc != 3) {
+ Tcl_WrongNumArgs(interp, 2, objv, "option");
+ result = TCL_ERROR;
+ goto done;
+ } else {
+ Tcl_Obj *objPtr = Tk_GetOptionValue(interp, (char *) textPtr,
+ textPtr->optionTable, objv[2], textPtr->tkwin);
+
+ if (objPtr == NULL) {
+ result = TCL_ERROR;
+ goto done;
+ }
+ Tcl_SetObjResult(interp, objPtr);
+ result = TCL_OK;
+ }
+ break;
+ case TEXT_COMPARE: {
+ int relation, value;
+ const char *p;
+ const TkTextIndex *index1Ptr, *index2Ptr;
+
+ if (objc != 5) {
+ Tcl_WrongNumArgs(interp, 2, objv, "index1 op index2");
+ result = TCL_ERROR;
+ goto done;
+ }
+ index1Ptr = TkTextGetIndexFromObj(interp, textPtr, objv[2]);
+ index2Ptr = TkTextGetIndexFromObj(interp, textPtr, objv[4]);
+ if (index1Ptr == NULL || index2Ptr == NULL) {
+ result = TCL_ERROR;
+ goto done;
+ }
+ relation = TkTextIndexCmp(index1Ptr, index2Ptr);
+ p = Tcl_GetString(objv[3]);
+ if (p[0] == '<') {
+ value = (relation < 0);
+ if ((p[1] == '=') && (p[2] == 0)) {
+ value = (relation <= 0);
+ } else if (p[1] != 0) {
+ goto compareError;
+ }
+ } else if (p[0] == '>') {
+ value = (relation > 0);
+ if ((p[1] == '=') && (p[2] == 0)) {
+ value = (relation >= 0);
+ } else if (p[1] != 0) {
+ goto compareError;
+ }
+ } else if ((p[0] == '=') && (p[1] == '=') && (p[2] == 0)) {
+ value = (relation == 0);
+ } else if ((p[0] == '!') && (p[1] == '=') && (p[2] == 0)) {
+ value = (relation != 0);
+ } else {
+ goto compareError;
+ }
+ Tcl_SetObjResult(interp, Tcl_NewBooleanObj(value));
+ break;
+
+ compareError:
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "bad comparison operator \"%s\": must be"
+ " <, <=, ==, >=, >, or !=", Tcl_GetString(objv[3])));
+ Tcl_SetErrorCode(interp, "TK", "VALUE", "COMPARISON", NULL);
+ result = TCL_ERROR;
+ goto done;
+ }
+ case TEXT_CONFIGURE:
+ if (objc <= 3) {
+ Tcl_Obj *objPtr = Tk_GetOptionInfo(interp, (char *) textPtr,
+ textPtr->optionTable, ((objc == 3) ? objv[2] : NULL),
+ textPtr->tkwin);
+
+ if (objPtr == NULL) {
+ result = TCL_ERROR;
+ goto done;
+ }
+ Tcl_SetObjResult(interp, objPtr);
+ } else {
+ result = ConfigureText(interp, textPtr, objc-2, objv+2);
+ }
+ break;
+ case TEXT_COUNT: {
+ const TkTextIndex *indexFromPtr, *indexToPtr;
+ int i, found = 0, update = 0;
+ Tcl_Obj *objPtr = NULL;
+
+ if (objc < 4) {
+ Tcl_WrongNumArgs(interp, 2, objv,
+ "?-option value ...? index1 index2");
+ result = TCL_ERROR;
+ goto done;
+ }
+
+ indexFromPtr = TkTextGetIndexFromObj(interp, textPtr, objv[objc-2]);
+ if (indexFromPtr == NULL) {
+ result = TCL_ERROR;
+ goto done;
+ }
+ indexToPtr = TkTextGetIndexFromObj(interp, textPtr, objv[objc-1]);
+ if (indexToPtr == NULL) {
+ result = TCL_ERROR;
+ goto done;
+ }
+
+ for (i = 2; i < objc-2; i++) {
+ int value, length;
+ const char *option = Tcl_GetString(objv[i]);
+ char c;
+
+ length = objv[i]->length;
+ if (length < 2 || option[0] != '-') {
+ goto badOption;
+ }
+ c = option[1];
+ if (c == 'c' && !strncmp("-chars", option, (unsigned) length)) {
+ value = CountIndices(textPtr, indexFromPtr, indexToPtr,
+ COUNT_CHARS);
+ } else if (c == 'd' && (length > 8)
+ && !strncmp("-displaychars", option, (unsigned) length)) {
+ value = CountIndices(textPtr, indexFromPtr, indexToPtr,
+ COUNT_DISPLAY_CHARS);
+ } else if (c == 'd' && (length > 8)
+ && !strncmp("-displayindices", option,(unsigned)length)) {
+ value = CountIndices(textPtr, indexFromPtr, indexToPtr,
+ COUNT_DISPLAY_INDICES);
+ } else if (c == 'd' && (length > 8)
+ && !strncmp("-displaylines", option, (unsigned) length)) {
+ TkTextLine *fromPtr, *lastPtr;
+ TkTextIndex index, index2;
+
+ int compare = TkTextIndexCmp(indexFromPtr, indexToPtr);
+ value = 0;
+
+ if (compare == 0) {
+ goto countDone;
+ }
+
+ if (compare > 0) {
+ const TkTextIndex *tmpPtr = indexFromPtr;
+
+ indexFromPtr = indexToPtr;
+ indexToPtr = tmpPtr;
+ }
+
+ lastPtr = TkBTreeFindLine(textPtr->sharedTextPtr->tree,
+ textPtr,
+ TkBTreeNumLines(textPtr->sharedTextPtr->tree,textPtr));
+ fromPtr = indexFromPtr->linePtr;
+ if (fromPtr == lastPtr) {
+ goto countDone;
+ }
+
+ /*
+ * Caution: we must NEVER call TkTextUpdateOneLine with the
+ * last artificial line in the widget.
+ */
+
+ index = *indexFromPtr;
+ index.byteIndex = 0;
+
+ /*
+ * We're going to count up all display lines in the logical
+ * line of 'indexFromPtr' up to, but not including the logical
+ * line of 'indexToPtr' (except if this line is elided), and
+ * then subtract off what came in too much from elided lines,
+ * also subtract off what we didn't want from 'from' and add
+ * on what we didn't count from 'to'.
+ */
+
+ while (TkTextIndexCmp(&index,indexToPtr) < 0) {
+ value += TkTextUpdateOneLine(textPtr, index.linePtr,
+ 0, &index, 0);
+ }
+
+ index2 = index;
+
+ /*
+ * Now we need to adjust the count to:
+ * - subtract off the number of display lines between
+ * indexToPtr and index2, since we might have skipped past
+ * indexToPtr, if we have several logical lines in a
+ * single display line
+ * - subtract off the number of display lines overcounted
+ * in the first logical line
+ * - add on the number of display lines in the last logical
+ * line
+ * This logic is still ok if both indexFromPtr and indexToPtr
+ * are in the same logical line.
+ */
+
+ index = *indexToPtr;
+ index.byteIndex = 0;
+ while (TkTextIndexCmp(&index,&index2) < 0) {
+ value -= TkTextUpdateOneLine(textPtr, index.linePtr,
+ 0, &index, 0);
+ }
+ index.linePtr = indexFromPtr->linePtr;
+ index.byteIndex = 0;
+ while (1) {
+ TkTextFindDisplayLineEnd(textPtr, &index, 1, NULL);
+ if (TkTextIndexCmp(&index,indexFromPtr) >= 0) {
+ break;
+ }
+ TkTextIndexForwBytes(textPtr, &index, 1, &index);
+ value--;
+
+ }
+ if (indexToPtr->linePtr != lastPtr) {
+ index.linePtr = indexToPtr->linePtr;
+ index.byteIndex = 0;
+ while (1) {
+ TkTextFindDisplayLineEnd(textPtr, &index, 1, NULL);
+ if (TkTextIndexCmp(&index,indexToPtr) >= 0) {
+ break;
+ }
+ TkTextIndexForwBytes(textPtr, &index, 1, &index);
+ value++;
+ }
+ }
+
+ if (compare > 0) {
+ value = -value;
+ }
+ } else if (c == 'i'
+ && !strncmp("-indices", option, (unsigned) length)) {
+ value = CountIndices(textPtr, indexFromPtr, indexToPtr,
+ COUNT_INDICES);
+ } else if (c == 'l'
+ && !strncmp("-lines", option, (unsigned) length)) {
+ value = TkBTreeLinesTo(textPtr, indexToPtr->linePtr)
+ - TkBTreeLinesTo(textPtr, indexFromPtr->linePtr);
+ } else if (c == 'u'
+ && !strncmp("-update", option, (unsigned) length)) {
+ update = 1;
+ continue;
+ } else if (c == 'x'
+ && !strncmp("-xpixels", option, (unsigned) length)) {
+ int x1, x2;
+ TkTextIndex index;
+
+ index = *indexFromPtr;
+ TkTextFindDisplayLineEnd(textPtr, &index, 0, &x1);
+ index = *indexToPtr;
+ TkTextFindDisplayLineEnd(textPtr, &index, 0, &x2);
+ value = x2 - x1;
+ } else if (c == 'y'
+ && !strncmp("-ypixels", option, (unsigned) length)) {
+ if (update) {
+ TkTextUpdateLineMetrics(textPtr,
+ TkBTreeLinesTo(textPtr, indexFromPtr->linePtr),
+ TkBTreeLinesTo(textPtr, indexToPtr->linePtr), -1);
+ }
+ value = TkTextIndexYPixels(textPtr, indexToPtr)
+ - TkTextIndexYPixels(textPtr, indexFromPtr);
+ } else {
+ goto badOption;
+ }
+
+ countDone:
+ found++;
+ if (found == 1) {
+ Tcl_SetObjResult(interp, Tcl_NewIntObj(value));
+ } else {
+ if (found == 2) {
+ /*
+ * Move the first item we put into the result into the
+ * first element of the list object.
+ */
+
+ objPtr = Tcl_NewObj();
+ Tcl_ListObjAppendElement(NULL, objPtr,
+ Tcl_GetObjResult(interp));
+ }
+ Tcl_ListObjAppendElement(NULL, objPtr, Tcl_NewIntObj(value));
+ }
+ }
+
+ if (found == 0) {
+ /*
+ * Use the default '-indices'.
+ */
+
+ int value = CountIndices(textPtr, indexFromPtr, indexToPtr,
+ COUNT_INDICES);
+
+ Tcl_SetObjResult(interp, Tcl_NewIntObj(value));
+ } else if (found > 1) {
+ Tcl_SetObjResult(interp, objPtr);
+ }
+ break;
+
+ badOption:
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "bad option \"%s\" must be -chars, -displaychars, "
+ "-displayindices, -displaylines, -indices, -lines, -update, "
+ "-xpixels, or -ypixels", Tcl_GetString(objv[i])));
+ Tcl_SetErrorCode(interp, "TK", "TEXT", "INDEX_OPTION", NULL);
+ result = TCL_ERROR;
+ goto done;
+ }
+ case TEXT_DEBUG:
+ if (objc > 3) {
+ Tcl_WrongNumArgs(interp, 2, objv, "boolean");
+ result = TCL_ERROR;
+ goto done;
+ }
+ if (objc == 2) {
+ Tcl_SetObjResult(interp, Tcl_NewBooleanObj(tkBTreeDebug));
+ } else {
+ if (Tcl_GetBooleanFromObj(interp, objv[2],
+ &tkBTreeDebug) != TCL_OK) {
+ result = TCL_ERROR;
+ goto done;
+ }
+ tkTextDebug = tkBTreeDebug;
+ }
+ break;
+ case TEXT_DELETE:
+ if (objc < 3) {
+ Tcl_WrongNumArgs(interp, 2, objv, "index1 ?index2 ...?");
+ result = TCL_ERROR;
+ goto done;
+ }
+ if (textPtr->state == TK_TEXT_STATE_NORMAL) {
+ if (objc < 5) {
+ /*
+ * Simple case requires no predetermination of indices.
+ */
+
+ const TkTextIndex *indexPtr1, *indexPtr2;
+
+ /*
+ * Parse the starting and stopping indices.
+ */
+
+ indexPtr1 = TkTextGetIndexFromObj(textPtr->interp, textPtr,
+ objv[2]);
+ if (indexPtr1 == NULL) {
+ result = TCL_ERROR;
+ goto done;
+ }
+ if (objc == 4) {
+ indexPtr2 = TkTextGetIndexFromObj(textPtr->interp,
+ textPtr, objv[3]);
+ if (indexPtr2 == NULL) {
+ result = TCL_ERROR;
+ goto done;
+ }
+ } else {
+ indexPtr2 = NULL;
+ }
+ DeleteIndexRange(NULL, textPtr, indexPtr1, indexPtr2, 1);
+ } else {
+ /*
+ * Multi-index pair case requires that we prevalidate the
+ * indices and sort from last to first so that deletes occur
+ * in the exact (unshifted) text. It also needs to handle
+ * partial and fully overlapping ranges. We have to do this
+ * with multiple passes.
+ */
+
+ TkTextIndex *indices, *ixStart, *ixEnd, *lastStart;
+ char *useIdx;
+ int i;
+
+ objc -= 2;
+ objv += 2;
+ indices = ckalloc((objc + 1) * sizeof(TkTextIndex));
+
+ /*
+ * First pass verifies that all indices are valid.
+ */
+
+ for (i = 0; i < objc; i++) {
+ const TkTextIndex *indexPtr =
+ TkTextGetIndexFromObj(interp, textPtr, objv[i]);
+
+ if (indexPtr == NULL) {
+ result = TCL_ERROR;
+ ckfree(indices);
+ goto done;
+ }
+ indices[i] = *indexPtr;
+ }
+
+ /*
+ * Pad out the pairs evenly to make later code easier.
+ */
+
+ if (objc & 1) {
+ indices[i] = indices[i-1];
+ TkTextIndexForwChars(NULL, &indices[i], 1, &indices[i],
+ COUNT_INDICES);
+ objc++;
+ }
+ useIdx = ckalloc(objc);
+ memset(useIdx, 0, (unsigned) objc);
+
+ /*
+ * Do a decreasing order sort so that we delete the end ranges
+ * first to maintain index consistency.
+ */
+
+ qsort(indices, (unsigned) objc / 2,
+ 2 * sizeof(TkTextIndex), TextIndexSortProc);
+ lastStart = NULL;
+
+ /*
+ * Second pass will handle bogus ranges (end < start) and
+ * overlapping ranges.
+ */
+
+ for (i = 0; i < objc; i += 2) {
+ ixStart = &indices[i];
+ ixEnd = &indices[i+1];
+ if (TkTextIndexCmp(ixEnd, ixStart) <= 0) {
+ continue;
+ }
+ if (lastStart) {
+ if (TkTextIndexCmp(ixStart, lastStart) == 0) {
+ /*
+ * Start indices were equal, and the sort placed
+ * the longest range first, so skip this one.
+ */
+
+ continue;
+ } else if (TkTextIndexCmp(lastStart, ixEnd) < 0) {
+ /*
+ * The next pair has a start range before the end
+ * point of the last range. Constrain the delete
+ * range, but use the pointer values.
+ */
+
+ *ixEnd = *lastStart;
+ if (TkTextIndexCmp(ixEnd, ixStart) <= 0) {
+ continue;
+ }
+ }
+ }
+ lastStart = ixStart;
+ useIdx[i] = 1;
+ }
+
+ /*
+ * Final pass take the input from the previous and deletes the
+ * ranges which are flagged to be deleted.
+ */
+
+ for (i = 0; i < objc; i += 2) {
+ if (useIdx[i]) {
+ /*
+ * We don't need to check the return value because all
+ * indices are preparsed above.
+ */
+
+ DeleteIndexRange(NULL, textPtr, &indices[i],
+ &indices[i+1], 1);
+ }
+ }
+ ckfree(indices);
+ }
+ }
+ break;
+ case TEXT_DLINEINFO: {
+ int x, y, width, height, base;
+ const TkTextIndex *indexPtr;
+
+ if (objc != 3) {
+ Tcl_WrongNumArgs(interp, 2, objv, "index");
+ result = TCL_ERROR;
+ goto done;
+ }
+ indexPtr = TkTextGetIndexFromObj(interp, textPtr, objv[2]);
+ if (indexPtr == NULL) {
+ result = TCL_ERROR;
+ goto done;
+ }
+ if (TkTextDLineInfo(textPtr, indexPtr, &x, &y, &width, &height,
+ &base) == 0) {
+ Tcl_Obj *listObj = Tcl_NewListObj(0, NULL);
+
+ Tcl_ListObjAppendElement(interp, listObj, Tcl_NewIntObj(x));
+ Tcl_ListObjAppendElement(interp, listObj, Tcl_NewIntObj(y));
+ Tcl_ListObjAppendElement(interp, listObj, Tcl_NewIntObj(width));
+ Tcl_ListObjAppendElement(interp, listObj, Tcl_NewIntObj(height));
+ Tcl_ListObjAppendElement(interp, listObj, Tcl_NewIntObj(base));
+
+ Tcl_SetObjResult(interp, listObj);
+ }
+ break;
+ }
+ case TEXT_DUMP:
+ result = TextDumpCmd(textPtr, interp, objc, objv);
+ break;
+ case TEXT_EDIT:
+ result = TextEditCmd(textPtr, interp, objc, objv);
+ break;
+ case TEXT_GET: {
+ Tcl_Obj *objPtr = NULL;
+ int i, found = 0, visible = 0;
+ const char *name;
+ int length;
+
+ if (objc < 3) {
+ Tcl_WrongNumArgs(interp, 2, objv,
+ "?-displaychars? ?--? index1 ?index2 ...?");
+ result = TCL_ERROR;
+ goto done;
+ }
+
+ /*
+ * Simple, restrictive argument parsing. The only options are -- and
+ * -displaychars (or any unique prefix).
+ */
+
+ i = 2;
+ if (objc > 3) {
+ name = Tcl_GetString(objv[i]);
+ length = objv[i]->length;
+ if (length > 1 && name[0] == '-') {
+ if (strncmp("-displaychars", name, (unsigned) length) == 0) {
+ i++;
+ visible = 1;
+ name = Tcl_GetString(objv[i]);
+ length = objv[i]->length;
+ }
+ if ((i < objc-1) && (length == 2) && !strcmp("--", name)) {
+ i++;
+ }
+ }
+ }
+
+ for (; i < objc; i += 2) {
+ const TkTextIndex *index1Ptr, *index2Ptr;
+ TkTextIndex index2;
+
+ index1Ptr = TkTextGetIndexFromObj(interp, textPtr, objv[i]);
+ if (index1Ptr == NULL) {
+ if (objPtr) {
+ Tcl_DecrRefCount(objPtr);
+ }
+ result = TCL_ERROR;
+ goto done;
+ }
+
+ if (i+1 == objc) {
+ TkTextIndexForwChars(NULL, index1Ptr, 1, &index2,
+ COUNT_INDICES);
+ index2Ptr = &index2;
+ } else {
+ index2Ptr = TkTextGetIndexFromObj(interp, textPtr, objv[i+1]);
+ if (index2Ptr == NULL) {
+ if (objPtr) {
+ Tcl_DecrRefCount(objPtr);
+ }
+ result = TCL_ERROR;
+ goto done;
+ }
+ }
+
+ if (TkTextIndexCmp(index1Ptr, index2Ptr) < 0) {
+ /*
+ * We want to move the text we get from the window into the
+ * result, but since this could in principle be a megabyte or
+ * more, we want to do it efficiently!
+ */
+
+ Tcl_Obj *get = TextGetText(textPtr, index1Ptr, index2Ptr,
+ visible);
+
+ found++;
+ if (found == 1) {
+ Tcl_SetObjResult(interp, get);
+ } else {
+ if (found == 2) {
+ /*
+ * Move the first item we put into the result into the
+ * first element of the list object.
+ */
+
+ objPtr = Tcl_NewObj();
+ Tcl_ListObjAppendElement(NULL, objPtr,
+ Tcl_GetObjResult(interp));
+ }
+ Tcl_ListObjAppendElement(NULL, objPtr, get);
+ }
+ }
+ }
+ if (found > 1) {
+ Tcl_SetObjResult(interp, objPtr);
+ }
+ break;
+ }
+ case TEXT_IMAGE:
+ result = TkTextImageCmd(textPtr, interp, objc, objv);
+ break;
+ case TEXT_INDEX: {
+ const TkTextIndex *indexPtr;
+
+ if (objc != 3) {
+ Tcl_WrongNumArgs(interp, 2, objv, "index");
+ result = TCL_ERROR;
+ goto done;
+ }
+
+ indexPtr = TkTextGetIndexFromObj(interp, textPtr, objv[2]);
+ if (indexPtr == NULL) {
+ result = TCL_ERROR;
+ goto done;
+ }
+ Tcl_SetObjResult(interp, TkTextNewIndexObj(textPtr, indexPtr));
+ break;
+ }
+ case TEXT_INSERT: {
+ const TkTextIndex *indexPtr;
+
+ if (objc < 4) {
+ Tcl_WrongNumArgs(interp, 2, objv,
+ "index chars ?tagList chars tagList ...?");
+ result = TCL_ERROR;
+ goto done;
+ }
+ indexPtr = TkTextGetIndexFromObj(interp, textPtr, objv[2]);
+ if (indexPtr == NULL) {
+ result = TCL_ERROR;
+ goto done;
+ }
+ if (textPtr->state == TK_TEXT_STATE_NORMAL) {
+ result = TextInsertCmd(NULL, textPtr, interp, objc-3, objv+3,
+ indexPtr, 1);
+ }
+ break;
+ }
+ case TEXT_MARK:
+ result = TkTextMarkCmd(textPtr, interp, objc, objv);
+ break;
+ case TEXT_PEER:
+ result = TextPeerCmd(textPtr, interp, objc, objv);
+ break;
+ case TEXT_PENDINGSYNC: {
+ if (objc != 2) {
+ Tcl_WrongNumArgs(interp, 2, objv, NULL);
+ result = TCL_ERROR;
+ goto done;
+ }
+ Tcl_SetObjResult(interp,
+ Tcl_NewBooleanObj(TkTextPendingsync(textPtr)));
+ break;
+ }
+ case TEXT_REPLACE: {
+ const TkTextIndex *indexFromPtr, *indexToPtr;
+
+ if (objc < 5) {
+ Tcl_WrongNumArgs(interp, 2, objv,
+ "index1 index2 chars ?tagList chars tagList ...?");
+ result = TCL_ERROR;
+ goto done;
+ }
+ indexFromPtr = TkTextGetIndexFromObj(interp, textPtr, objv[2]);
+ if (indexFromPtr == NULL) {
+ result = TCL_ERROR;
+ goto done;
+ }
+ indexToPtr = TkTextGetIndexFromObj(interp, textPtr, objv[3]);
+ if (indexToPtr == NULL) {
+ result = TCL_ERROR;
+ goto done;
+ }
+ if (TkTextIndexCmp(indexFromPtr, indexToPtr) > 0) {
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "index \"%s\" before \"%s\" in the text",
+ Tcl_GetString(objv[3]), Tcl_GetString(objv[2])));
+ Tcl_SetErrorCode(interp, "TK", "TEXT", "INDEX_ORDER", NULL);
+ result = TCL_ERROR;
+ goto done;
+ }
+ if (textPtr->state == TK_TEXT_STATE_NORMAL) {
+ int lineNum, byteIndex;
+ TkTextIndex index;
+
+ /*
+ * The 'replace' operation is quite complex to do correctly,
+ * because we want a number of criteria to hold:
+ *
+ * 1. The insertion point shouldn't move, unless it is within the
+ * deleted range. In this case it should end up after the new
+ * text.
+ *
+ * 2. The window should not change the text it shows - should not
+ * scroll vertically - unless the result of the replace is
+ * that the insertion position which used to be on-screen is
+ * now off-screen.
+ */
+
+ byteIndex = textPtr->topIndex.byteIndex;
+ lineNum = TkBTreeLinesTo(textPtr, textPtr->topIndex.linePtr);
+
+ TkTextMarkSegToIndex(textPtr, textPtr->insertMarkPtr, &index);
+ if ((TkTextIndexCmp(indexFromPtr, &index) < 0)
+ && (TkTextIndexCmp(indexToPtr, &index) > 0)) {
+ /*
+ * The insertion point is inside the range to be replaced, so
+ * we have to do some calculations to ensure it doesn't move
+ * unnecessarily.
+ */
+
+ int deleteInsertOffset, insertLength, j;
+
+ insertLength = 0;
+ for (j = 4; j < objc; j += 2) {
+ insertLength += Tcl_GetCharLength(objv[j]);
+ }
+
+ /*
+ * Calculate 'deleteInsertOffset' as an offset we will apply
+ * to the insertion point after this operation.
+ */
+
+ deleteInsertOffset = CountIndices(textPtr, indexFromPtr,
+ &index, COUNT_CHARS);
+ if (deleteInsertOffset > insertLength) {
+ deleteInsertOffset = insertLength;
+ }
+
+ result = TextReplaceCmd(textPtr, interp, indexFromPtr,
+ indexToPtr, objc, objv, 0);
+
+ if (result == TCL_OK) {
+ /*
+ * Move the insertion position to the correct place.
+ */
+
+ TkTextIndexForwChars(NULL, indexFromPtr,
+ deleteInsertOffset, &index, COUNT_INDICES);
+ TkBTreeUnlinkSegment(textPtr->insertMarkPtr,
+ textPtr->insertMarkPtr->body.mark.linePtr);
+ TkBTreeLinkSegment(textPtr->insertMarkPtr, &index);
+ }
+ } else {
+ result = TextReplaceCmd(textPtr, interp, indexFromPtr,
+ indexToPtr, objc, objv, 1);
+ }
+ if (result == TCL_OK) {
+ /*
+ * Now ensure the top-line is in the right place.
+ */
+
+ TkTextMakeByteIndex(textPtr->sharedTextPtr->tree, textPtr,
+ lineNum, byteIndex, &index);
+ TkTextSetYView(textPtr, &index, TK_TEXT_NOPIXELADJUST);
+ }
+ }
+ break;
+ }
+ case TEXT_SCAN:
+ result = TkTextScanCmd(textPtr, interp, objc, objv);
+ break;
+ case TEXT_SEARCH:
+ result = TextSearchCmd(textPtr, interp, objc, objv);
+ break;
+ case TEXT_SEE:
+ result = TkTextSeeCmd(textPtr, interp, objc, objv);
+ break;
+ case TEXT_SYNC: {
+ if (objc == 4) {
+ Tcl_Obj *cmd = objv[3];
+ const char *option = Tcl_GetString(objv[2]);
+ if (strncmp(option, "-command", objv[2]->length)) {
+ Tcl_AppendResult(interp, "wrong option \"", option, "\": should be \"-command\"", NULL);
+ result = TCL_ERROR;
+ goto done;
+ }
+ Tcl_IncrRefCount(cmd);
+ if (TkTextPendingsync(textPtr)) {
+ if (textPtr->afterSyncCmd) {
+ Tcl_DecrRefCount(textPtr->afterSyncCmd);
+ }
+ textPtr->afterSyncCmd = cmd;
+ } else {
+ textPtr->afterSyncCmd = cmd;
+ Tcl_DoWhenIdle(RunAfterSyncCmd, (ClientData) textPtr);
+ }
+ break;
+ } else if (objc != 2) {
+ Tcl_WrongNumArgs(interp, 2, objv, "?-command command?");
+ result = TCL_ERROR;
+ goto done;
+ }
+ if (textPtr->afterSyncCmd) {
+ Tcl_DecrRefCount(textPtr->afterSyncCmd);
+ }
+ textPtr->afterSyncCmd = NULL;
+ TkTextUpdateLineMetrics(textPtr, 1,
+ TkBTreeNumLines(textPtr->sharedTextPtr->tree, textPtr), -1);
+ break;
+ }
+ case TEXT_TAG:
+ result = TkTextTagCmd(textPtr, interp, objc, objv);
+ break;
+ case TEXT_WINDOW:
+ result = TkTextWindowCmd(textPtr, interp, objc, objv);
+ break;
+ case TEXT_XVIEW:
+ result = TkTextXviewCmd(textPtr, interp, objc, objv);
+ break;
+ case TEXT_YVIEW:
+ result = TkTextYviewCmd(textPtr, interp, objc, objv);
+ break;
+ }
+
+ done:
+ textPtr->refCount--;
+ if (textPtr->refCount == 0) {
+ ckfree(textPtr);
+ }
+ return result;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * SharedTextObjCmd --
+ *
+ * This function is invoked to process commands on the shared portion of
+ * a text widget. Currently it is not actually exported as a Tcl command,
+ * and is only used internally to process parts of undo/redo scripts.
+ * See the user documentation for 'text' for details on what it does -
+ * the only subcommands it currently supports are 'insert' and 'delete'.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * See the user documentation for "text".
+ *
+ *--------------------------------------------------------------
+ */
+
+static int
+SharedTextObjCmd(
+ ClientData clientData, /* Information about shared test B-tree. */
+ Tcl_Interp *interp, /* Current interpreter. */
+ int objc, /* Number of arguments. */
+ Tcl_Obj *const objv[]) /* Argument objects. */
+{
+ register TkSharedText *sharedPtr = clientData;
+ int result = TCL_OK;
+ int index;
+
+ static const char *const optionStrings[] = {
+ "delete", "insert", NULL
+ };
+ enum options {
+ TEXT_DELETE, TEXT_INSERT
+ };
+
+ if (objc < 2) {
+ Tcl_WrongNumArgs(interp, 1, objv, "option ?arg ...?");
+ return TCL_ERROR;
+ }
+
+ if (Tcl_GetIndexFromObjStruct(interp, objv[1], optionStrings,
+ sizeof(char *), "option", 0, &index) != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ switch ((enum options) index) {
+ case TEXT_DELETE:
+ if (objc < 3) {
+ Tcl_WrongNumArgs(interp, 2, objv, "index1 ?index2 ...?");
+ return TCL_ERROR;
+ }
+ if (objc < 5) {
+ /*
+ * Simple case requires no predetermination of indices.
+ */
+
+ TkTextIndex index1;
+
+ /*
+ * Parse the starting and stopping indices.
+ */
+
+ result = TkTextSharedGetObjIndex(interp, sharedPtr, objv[2],
+ &index1);
+ if (result != TCL_OK) {
+ return result;
+ }
+ if (objc == 4) {
+ TkTextIndex index2;
+
+ result = TkTextSharedGetObjIndex(interp, sharedPtr, objv[3],
+ &index2);
+ if (result != TCL_OK) {
+ return result;
+ }
+ DeleteIndexRange(sharedPtr, NULL, &index1, &index2, 1);
+ } else {
+ DeleteIndexRange(sharedPtr, NULL, &index1, NULL, 1);
+ }
+ return TCL_OK;
+ } else {
+ /* Too many arguments */
+ return TCL_ERROR;
+ }
+ break;
+ case TEXT_INSERT: {
+ TkTextIndex index1;
+
+ if (objc < 4) {
+ Tcl_WrongNumArgs(interp, 2, objv,
+ "index chars ?tagList chars tagList ...?");
+ return TCL_ERROR;
+ }
+ result = TkTextSharedGetObjIndex(interp, sharedPtr, objv[2],
+ &index1);
+ if (result != TCL_OK) {
+ return result;
+ }
+ return TextInsertCmd(sharedPtr, NULL, interp, objc-3, objv+3, &index1,
+ 1);
+ }
+ default:
+ return TCL_OK;
+ }
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * TextPeerCmd --
+ *
+ * This function is invoked to process the "text peer" Tcl command. See
+ * the user documentation for details on what it does.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * See the user documentation.
+ *
+ *--------------------------------------------------------------
+ */
+
+static int
+TextPeerCmd(
+ TkText *textPtr, /* Information about text widget. */
+ Tcl_Interp *interp, /* Current interpreter. */
+ int objc, /* Number of arguments. */
+ Tcl_Obj *const objv[]) /* Argument objects. */
+{
+ Tk_Window tkwin = textPtr->tkwin;
+ int index;
+
+ static const char *const peerOptionStrings[] = {
+ "create", "names", NULL
+ };
+ enum peerOptions {
+ PEER_CREATE, PEER_NAMES
+ };
+
+ if (objc < 3) {
+ Tcl_WrongNumArgs(interp, 2, objv, "option ?arg ...?");
+ return TCL_ERROR;
+ }
+
+ if (Tcl_GetIndexFromObjStruct(interp, objv[2], peerOptionStrings,
+ sizeof(char *), "peer option", 0, &index) != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ switch ((enum peerOptions) index) {
+ case PEER_CREATE:
+ if (objc < 4) {
+ Tcl_WrongNumArgs(interp, 3, objv, "pathName ?-option value ...?");
+ return TCL_ERROR;
+ }
+ return CreateWidget(textPtr->sharedTextPtr, tkwin, interp, textPtr,
+ objc-2, objv+2);
+ case PEER_NAMES: {
+ TkText *tPtr = textPtr->sharedTextPtr->peers;
+ Tcl_Obj *peersObj;
+
+ if (objc > 3) {
+ Tcl_WrongNumArgs(interp, 3, objv, NULL);
+ return TCL_ERROR;
+ }
+ peersObj = Tcl_NewObj();
+ while (tPtr != NULL) {
+ if (tPtr != textPtr) {
+ Tcl_ListObjAppendElement(NULL, peersObj,
+ TkNewWindowObj(tPtr->tkwin));
+ }
+ tPtr = tPtr->next;
+ }
+ Tcl_SetObjResult(interp, peersObj);
+ }
+ }
+
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TextReplaceCmd --
+ *
+ * This function is invoked to process part of the "replace" widget
+ * command for text widgets.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * See the user documentation.
+ *
+ * If 'viewUpdate' is false, then textPtr->topIndex may no longer be a
+ * valid index after this function returns. The caller is responsible for
+ * ensuring a correct index is in place.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+TextReplaceCmd(
+ TkText *textPtr, /* Information about text widget. */
+ Tcl_Interp *interp, /* Current interpreter. */
+ const TkTextIndex *indexFromPtr,
+ /* Index from which to replace. */
+ const TkTextIndex *indexToPtr,
+ /* Index to which to replace. */
+ int objc, /* Number of arguments. */
+ Tcl_Obj *const objv[], /* Argument objects. */
+ int viewUpdate) /* Update vertical view if set. */
+{
+ /*
+ * Perform the deletion and insertion, but ensure no undo-separator is
+ * placed between the two operations. Since we are using the helper
+ * functions 'DeleteIndexRange' and 'TextInsertCmd' we have to pretend
+ * that the autoSeparators setting is off, so that we don't get an
+ * undo-separator between the delete and insert.
+ */
+
+ int origAutoSep = textPtr->sharedTextPtr->autoSeparators;
+ int result, lineNumber;
+ TkTextIndex indexTmp;
+
+ if (textPtr->sharedTextPtr->undo) {
+ textPtr->sharedTextPtr->autoSeparators = 0;
+ if (origAutoSep &&
+ textPtr->sharedTextPtr->lastEditMode!=TK_TEXT_EDIT_REPLACE) {
+ TkUndoInsertUndoSeparator(textPtr->sharedTextPtr->undoStack);
+ }
+ }
+
+ /*
+ * Must save and restore line in indexFromPtr based on line number; can't
+ * keep the line itself as that might be eliminated/invalidated when
+ * deleting the range. [Bug 1602537]
+ */
+
+ indexTmp = *indexFromPtr;
+ lineNumber = TkBTreeLinesTo(textPtr, indexFromPtr->linePtr);
+ DeleteIndexRange(NULL, textPtr, indexFromPtr, indexToPtr, viewUpdate);
+ indexTmp.linePtr = TkBTreeFindLine(indexTmp.tree, textPtr, lineNumber);
+ result = TextInsertCmd(NULL, textPtr, interp, objc-4, objv+4,
+ &indexTmp, viewUpdate);
+
+ if (textPtr->sharedTextPtr->undo) {
+ textPtr->sharedTextPtr->lastEditMode = TK_TEXT_EDIT_REPLACE;
+ textPtr->sharedTextPtr->autoSeparators = origAutoSep;
+ }
+
+ return result;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TextIndexSortProc --
+ *
+ * This function is called by qsort when sorting an array of indices in
+ * *decreasing* order (last to first).
+ *
+ * Results:
+ * The return value is -1 if the first argument should be before the
+ * second element, 0 if it's equivalent, and 1 if it should be after the
+ * second element.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+TextIndexSortProc(
+ const void *first, /* Elements to be compared. */
+ const void *second)
+{
+ TkTextIndex *pair1 = (TkTextIndex *) first;
+ TkTextIndex *pair2 = (TkTextIndex *) second;
+ int cmp = TkTextIndexCmp(&pair1[1], &pair2[1]);
+
+ if (cmp == 0) {
+ /*
+ * If the first indices were equal, we want the second index of the
+ * pair also to be the greater. Use pointer magic to access the second
+ * index pair.
+ */
+
+ cmp = TkTextIndexCmp(&pair1[0], &pair2[0]);
+ }
+ if (cmp > 0) {
+ return -1;
+ } else if (cmp < 0) {
+ return 1;
+ }
+ return 0;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * DestroyText --
+ *
+ * This function is invoked when we receive a destroy event to clean up
+ * the internal structure of a text widget. We will free up most of the
+ * internal structure and delete the associated Tcl command. If there are
+ * no outstanding references to the widget, we also free up the textPtr
+ * itself.
+ *
+ * The widget has already been flagged as deleted.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Either everything or almost everything associated with the text is
+ * freed up.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+DestroyText(
+ TkText *textPtr) /* Info about text widget. */
+{
+ Tcl_HashSearch search;
+ Tcl_HashEntry *hPtr;
+ TkTextTag *tagPtr;
+ TkSharedText *sharedTextPtr = textPtr->sharedTextPtr;
+
+ /*
+ * Free up all the stuff that requires special handling. We have already
+ * called let Tk_FreeConfigOptions to handle all the standard
+ * option-related stuff (and so none of that exists when we are called).
+ * Special note: free up display-related information before deleting the
+ * B-tree, since display-related stuff may refer to stuff in the B-tree.
+ */
+
+ TkTextFreeDInfo(textPtr);
+ textPtr->dInfoPtr = NULL;
+
+ /*
+ * Remove ourselves from the peer list.
+ */
+
+ if (sharedTextPtr->peers == textPtr) {
+ sharedTextPtr->peers = textPtr->next;
+ } else {
+ TkText *nextPtr = sharedTextPtr->peers;
+ while (nextPtr != NULL) {
+ if (nextPtr->next == textPtr) {
+ nextPtr->next = textPtr->next;
+ break;
+ }
+ nextPtr = nextPtr->next;
+ }
+ }
+
+ /*
+ * Always clean up the widget-specific tags first. Common tags (i.e. most)
+ * will only be cleaned up when the shared structure is cleaned up.
+ *
+ * We also need to clean up widget-specific marks ('insert', 'current'),
+ * since otherwise marks will never disappear from the B-tree.
+ */
+
+ TkTextDeleteTag(textPtr, textPtr->selTagPtr);
+ TkBTreeUnlinkSegment(textPtr->insertMarkPtr,
+ textPtr->insertMarkPtr->body.mark.linePtr);
+ ckfree(textPtr->insertMarkPtr);
+ TkBTreeUnlinkSegment(textPtr->currentMarkPtr,
+ textPtr->currentMarkPtr->body.mark.linePtr);
+ ckfree(textPtr->currentMarkPtr);
+
+ /*
+ * Now we've cleaned up everything of relevance to us in the B-tree, so we
+ * disassociate outselves from it.
+ *
+ * When the refCount reaches zero, it's time to clean up the shared
+ * portion of the text widget.
+ */
+
+ sharedTextPtr->refCount--;
+
+ if (sharedTextPtr->refCount > 0) {
+ TkBTreeRemoveClient(sharedTextPtr->tree, textPtr);
+
+ /*
+ * Free up any embedded windows which belong to this widget.
+ */
+
+ for (hPtr = Tcl_FirstHashEntry(&sharedTextPtr->windowTable, &search);
+ hPtr != NULL; hPtr = Tcl_NextHashEntry(&search)) {
+ TkTextEmbWindowClient *loop;
+ TkTextSegment *ewPtr = Tcl_GetHashValue(hPtr);
+
+ loop = ewPtr->body.ew.clients;
+ if (loop->textPtr == textPtr) {
+ ewPtr->body.ew.clients = loop->next;
+ TkTextWinFreeClient(hPtr, loop);
+ } else {
+ TkTextEmbWindowClient *client = ewPtr->body.ew.clients;
+
+ client = loop->next;
+ while (client != NULL) {
+ if (client->textPtr == textPtr) {
+ loop->next = client->next;
+ TkTextWinFreeClient(hPtr, client);
+ break;
+ } else {
+ loop = loop->next;
+ }
+ client = loop->next;
+ }
+ }
+ }
+ } else {
+ /*
+ * No need to call 'TkBTreeRemoveClient' first, since this will do
+ * everything in one go, more quickly.
+ */
+
+ TkBTreeDestroy(sharedTextPtr->tree);
+
+ for (hPtr = Tcl_FirstHashEntry(&sharedTextPtr->tagTable, &search);
+ hPtr != NULL; hPtr = Tcl_NextHashEntry(&search)) {
+ tagPtr = Tcl_GetHashValue(hPtr);
+
+ /*
+ * No need to use 'TkTextDeleteTag' since we've already removed
+ * the B-tree completely.
+ */
+
+ TkTextFreeTag(textPtr, tagPtr);
+ }
+ Tcl_DeleteHashTable(&sharedTextPtr->tagTable);
+ for (hPtr = Tcl_FirstHashEntry(&sharedTextPtr->markTable, &search);
+ hPtr != NULL; hPtr = Tcl_NextHashEntry(&search)) {
+ ckfree(Tcl_GetHashValue(hPtr));
+ }
+ Tcl_DeleteHashTable(&sharedTextPtr->markTable);
+ TkUndoFreeStack(sharedTextPtr->undoStack);
+
+ Tcl_DeleteHashTable(&sharedTextPtr->windowTable);
+ Tcl_DeleteHashTable(&sharedTextPtr->imageTable);
+
+ if (sharedTextPtr->bindingTable != NULL) {
+ Tk_DeleteBindingTable(sharedTextPtr->bindingTable);
+ }
+ ckfree(sharedTextPtr);
+ }
+
+ if (textPtr->tabArrayPtr != NULL) {
+ ckfree(textPtr->tabArrayPtr);
+ }
+ if (textPtr->insertBlinkHandler != NULL) {
+ Tcl_DeleteTimerHandler(textPtr->insertBlinkHandler);
+ }
+
+ textPtr->tkwin = NULL;
+ textPtr->refCount--;
+ Tcl_DeleteCommandFromToken(textPtr->interp, textPtr->widgetCmd);
+ if (textPtr->afterSyncCmd){
+ Tcl_DecrRefCount(textPtr->afterSyncCmd);
+ textPtr->afterSyncCmd = NULL;
+ }
+ if (textPtr->refCount == 0) {
+ ckfree(textPtr);
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ConfigureText --
+ *
+ * This function is called to process an objv/objc list, plus the Tk
+ * option database, in order to configure (or reconfigure) a text widget.
+ *
+ * Results:
+ * The return value is a standard Tcl result. If TCL_ERROR is returned,
+ * then the interp's result contains an error message.
+ *
+ * Side effects:
+ * Configuration information, such as text string, colors, font, etc. get
+ * set for textPtr; old resources get freed, if there were any.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+ConfigureText(
+ Tcl_Interp *interp, /* Used for error reporting. */
+ register TkText *textPtr, /* Information about widget; may or may not
+ * already have values for some fields. */
+ int objc, /* Number of arguments. */
+ Tcl_Obj *const objv[]) /* Argument objects. */
+{
+ Tk_SavedOptions savedOptions;
+ int oldExport = textPtr->exportSelection;
+ int mask = 0;
+
+ if (Tk_SetOptions(interp, (char *) textPtr, textPtr->optionTable,
+ objc, objv, textPtr->tkwin, &savedOptions, &mask) != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ /*
+ * Copy down shared flags.
+ */
+
+ textPtr->sharedTextPtr->undo = textPtr->undo;
+ textPtr->sharedTextPtr->maxUndo = textPtr->maxUndo;
+ textPtr->sharedTextPtr->autoSeparators = textPtr->autoSeparators;
+
+ TkUndoSetMaxDepth(textPtr->sharedTextPtr->undoStack,
+ textPtr->sharedTextPtr->maxUndo);
+
+ /*
+ * A few other options also need special processing, such as parsing the
+ * geometry and setting the background from a 3-D border.
+ */
+
+ Tk_SetBackgroundFromBorder(textPtr->tkwin, textPtr->border);
+
+ if (mask & TK_TEXT_LINE_RANGE) {
+ int start, end, current;
+ TkTextIndex index1, index2, index3;
+
+ /*
+ * Line start and/or end have been adjusted. We need to validate the
+ * first displayed line and arrange for re-layout.
+ */
+
+ TkBTreeClientRangeChanged(textPtr, textPtr->charHeight);
+
+ if (textPtr->start != NULL) {
+ start = TkBTreeLinesTo(NULL, textPtr->start);
+ } else {
+ start = 0;
+ }
+ if (textPtr->end != NULL) {
+ end = TkBTreeLinesTo(NULL, textPtr->end);
+ } else {
+ end = TkBTreeNumLines(textPtr->sharedTextPtr->tree, NULL);
+ }
+ if (start > end) {
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "-startline must be less than or equal to -endline", -1));
+ Tcl_SetErrorCode(interp, "TK", "TEXT", "INDEX_ORDER", NULL);
+ Tk_RestoreSavedOptions(&savedOptions);
+ return TCL_ERROR;
+ }
+ current = TkBTreeLinesTo(NULL, textPtr->topIndex.linePtr);
+ TkTextMakeByteIndex(textPtr->sharedTextPtr->tree, NULL, start, 0,
+ &index1);
+ TkTextMakeByteIndex(textPtr->sharedTextPtr->tree, NULL, end, 0,
+ &index2);
+ if (current < start || current > end) {
+ TkTextSearch search;
+ TkTextIndex first, last;
+ int selChanged = 0;
+
+ TkTextSetYView(textPtr, &index1, 0);
+
+ /*
+ * We may need to adjust the selection. So we have to check
+ * whether the "sel" tag was applied to anything outside the
+ * current start,end.
+ */
+
+ TkTextMakeByteIndex(textPtr->sharedTextPtr->tree, NULL, 0, 0,
+ &first);
+ TkTextMakeByteIndex(textPtr->sharedTextPtr->tree, NULL,
+ TkBTreeNumLines(textPtr->sharedTextPtr->tree, NULL),
+ 0, &last);
+ TkBTreeStartSearch(&first, &last, textPtr->selTagPtr, &search);
+ if (!TkBTreeCharTagged(&first, textPtr->selTagPtr)
+ && !TkBTreeNextTag(&search)) {
+ /* Nothing tagged with "sel" */
+ } else {
+ int line = TkBTreeLinesTo(NULL, search.curIndex.linePtr);
+
+ if (line < start) {
+ selChanged = 1;
+ } else {
+ TkTextLine *linePtr = search.curIndex.linePtr;
+
+ while (TkBTreeNextTag(&search)) {
+ linePtr = search.curIndex.linePtr;
+ }
+ line = TkBTreeLinesTo(NULL, linePtr);
+ if (line >= end) {
+ selChanged = 1;
+ }
+ }
+ }
+ if (selChanged) {
+ /*
+ * Send an event that the selection has changed, and abort any
+ * partial-selections in progress.
+ */
+
+ TkTextSelectionEvent(textPtr);
+ textPtr->abortSelections = 1;
+ }
+ }
+
+ /* Indices are potentially obsolete after changing -startline and/or
+ * -endline, therefore increase the epoch.
+ * Also, clamp the insert and current (unshared) marks to the new
+ * -startline/-endline range limits of the widget. All other (shared)
+ * marks are unchanged.
+ * The return value of TkTextMarkNameToIndex does not need to be
+ * checked: "insert" and "current" marks always exist, and the
+ * purpose of the code below precisely is to move them inside the
+ * -startline/-endline range.
+ */
+
+ textPtr->sharedTextPtr->stateEpoch++;
+ TkTextMarkNameToIndex(textPtr, "insert", &index3);
+ if (TkTextIndexCmp(&index3, &index1) < 0) {
+ textPtr->insertMarkPtr = TkTextSetMark(textPtr, "insert", &index1);
+ }
+ if (TkTextIndexCmp(&index3, &index2) > 0) {
+ textPtr->insertMarkPtr = TkTextSetMark(textPtr, "insert", &index2);
+ }
+ TkTextMarkNameToIndex(textPtr, "current", &index3);
+ if (TkTextIndexCmp(&index3, &index1) < 0) {
+ textPtr->currentMarkPtr = TkTextSetMark(textPtr, "current", &index1);
+ }
+ if (TkTextIndexCmp(&index3, &index2) > 0) {
+ textPtr->currentMarkPtr = TkTextSetMark(textPtr, "current", &index2);
+ }
+ }
+
+ /*
+ * Don't allow negative spacings.
+ */
+
+ if (textPtr->spacing1 < 0) {
+ textPtr->spacing1 = 0;
+ }
+ if (textPtr->spacing2 < 0) {
+ textPtr->spacing2 = 0;
+ }
+ if (textPtr->spacing3 < 0) {
+ textPtr->spacing3 = 0;
+ }
+
+ /*
+ * Parse tab stops.
+ */
+
+ if (textPtr->tabArrayPtr != NULL) {
+ ckfree(textPtr->tabArrayPtr);
+ textPtr->tabArrayPtr = NULL;
+ }
+ if (textPtr->tabOptionPtr != NULL) {
+ textPtr->tabArrayPtr = TkTextGetTabs(interp, textPtr,
+ textPtr->tabOptionPtr);
+ if (textPtr->tabArrayPtr == NULL) {
+ Tcl_AddErrorInfo(interp,"\n (while processing -tabs option)");
+ Tk_RestoreSavedOptions(&savedOptions);
+ return TCL_ERROR;
+ }
+ }
+
+ /*
+ * Make sure that configuration options are properly mirrored between the
+ * widget record and the "sel" tags. NOTE: we don't have to free up
+ * information during the mirroring; old information was freed when it was
+ * replaced in the widget record.
+ */
+
+ if (textPtr->selTagPtr->selBorder == NULL) {
+ textPtr->selTagPtr->border = textPtr->selBorder;
+ } else {
+ textPtr->selTagPtr->selBorder = textPtr->selBorder;
+ }
+ if (textPtr->selTagPtr->borderWidthPtr != textPtr->selBorderWidthPtr) {
+ textPtr->selTagPtr->borderWidthPtr = textPtr->selBorderWidthPtr;
+ textPtr->selTagPtr->borderWidth = textPtr->selBorderWidth;
+ }
+ if (textPtr->selTagPtr->selFgColor == NULL) {
+ textPtr->selTagPtr->fgColor = textPtr->selFgColorPtr;
+ } else {
+ textPtr->selTagPtr->selFgColor = textPtr->selFgColorPtr;
+ }
+ textPtr->selTagPtr->affectsDisplay = 0;
+ textPtr->selTagPtr->affectsDisplayGeometry = 0;
+ if ((textPtr->selTagPtr->elideString != NULL)
+ || (textPtr->selTagPtr->tkfont != None)
+ || (textPtr->selTagPtr->justifyString != NULL)
+ || (textPtr->selTagPtr->lMargin1String != NULL)
+ || (textPtr->selTagPtr->lMargin2String != NULL)
+ || (textPtr->selTagPtr->offsetString != NULL)
+ || (textPtr->selTagPtr->rMarginString != NULL)
+ || (textPtr->selTagPtr->spacing1String != NULL)
+ || (textPtr->selTagPtr->spacing2String != NULL)
+ || (textPtr->selTagPtr->spacing3String != NULL)
+ || (textPtr->selTagPtr->tabStringPtr != NULL)
+ || (textPtr->selTagPtr->wrapMode != TEXT_WRAPMODE_NULL)) {
+ textPtr->selTagPtr->affectsDisplay = 1;
+ textPtr->selTagPtr->affectsDisplayGeometry = 1;
+ }
+ if ((textPtr->selTagPtr->border != NULL)
+ || (textPtr->selTagPtr->selBorder != NULL)
+ || (textPtr->selTagPtr->reliefString != NULL)
+ || (textPtr->selTagPtr->bgStipple != None)
+ || (textPtr->selTagPtr->fgColor != NULL)
+ || (textPtr->selTagPtr->selFgColor != NULL)
+ || (textPtr->selTagPtr->fgStipple != None)
+ || (textPtr->selTagPtr->overstrikeString != NULL)
+ || (textPtr->selTagPtr->overstrikeColor != NULL)
+ || (textPtr->selTagPtr->underlineString != NULL)
+ || (textPtr->selTagPtr->underlineColor != NULL)
+ || (textPtr->selTagPtr->lMarginColor != NULL)
+ || (textPtr->selTagPtr->rMarginColor != NULL)) {
+ textPtr->selTagPtr->affectsDisplay = 1;
+ }
+ TkTextRedrawTag(NULL, textPtr, NULL, NULL, textPtr->selTagPtr, 1);
+
+ /*
+ * Claim the selection if we've suddenly started exporting it and there
+ * are tagged characters.
+ */
+
+ if (textPtr->exportSelection && (!oldExport)) {
+ TkTextSearch search;
+ TkTextIndex first, last;
+
+ TkTextMakeByteIndex(textPtr->sharedTextPtr->tree, textPtr, 0, 0,
+ &first);
+ TkTextMakeByteIndex(textPtr->sharedTextPtr->tree, textPtr,
+ TkBTreeNumLines(textPtr->sharedTextPtr->tree, textPtr),
+ 0, &last);
+ TkBTreeStartSearch(&first, &last, textPtr->selTagPtr, &search);
+ if (TkBTreeCharTagged(&first, textPtr->selTagPtr)
+ || TkBTreeNextTag(&search)) {
+ Tk_OwnSelection(textPtr->tkwin, XA_PRIMARY, TkTextLostSelection,
+ textPtr);
+ textPtr->flags |= GOT_SELECTION;
+ }
+ }
+
+ /*
+ * Account for state changes that would reenable blinking cursor state.
+ */
+
+ if (textPtr->flags & GOT_FOCUS) {
+ Tcl_DeleteTimerHandler(textPtr->insertBlinkHandler);
+ textPtr->insertBlinkHandler = NULL;
+ TextBlinkProc(textPtr);
+ }
+
+ /*
+ * Register the desired geometry for the window, and arrange for the
+ * window to be redisplayed.
+ */
+
+ if (textPtr->width <= 0) {
+ textPtr->width = 1;
+ }
+ if (textPtr->height <= 0) {
+ textPtr->height = 1;
+ }
+ Tk_FreeSavedOptions(&savedOptions);
+ TextWorldChanged(textPtr, mask);
+ return TCL_OK;
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * TextWorldChangedCallback --
+ *
+ * This function is called when the world has changed in some way and the
+ * widget needs to recompute all its graphics contexts and determine its
+ * new geometry.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Configures all tags in the Text with a empty objc/objv, for the side
+ * effect of causing all the items to recompute their geometry and to be
+ * redisplayed.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+static void
+TextWorldChangedCallback(
+ ClientData instanceData) /* Information about widget. */
+{
+ TkText *textPtr = instanceData;
+
+ TextWorldChanged(textPtr, TK_TEXT_LINE_GEOMETRY);
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * TextWorldChanged --
+ *
+ * This function is called when the world has changed in some way and the
+ * widget needs to recompute all its graphics contexts and determine its
+ * new geometry.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Configures all tags in the Text with a empty objc/objv, for the side
+ * effect of causing all the items to recompute their geometry and to be
+ * redisplayed.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+static void
+TextWorldChanged(
+ TkText *textPtr, /* Information about widget. */
+ int mask) /* OR'd collection of bits showing what has
+ * changed. */
+{
+ Tk_FontMetrics fm;
+ int border;
+ int oldCharHeight = textPtr->charHeight;
+
+ textPtr->charWidth = Tk_TextWidth(textPtr->tkfont, "0", 1);
+ if (textPtr->charWidth <= 0) {
+ textPtr->charWidth = 1;
+ }
+ Tk_GetFontMetrics(textPtr->tkfont, &fm);
+
+ textPtr->charHeight = fm.linespace;
+ if (textPtr->charHeight <= 0) {
+ textPtr->charHeight = 1;
+ }
+ if (textPtr->charHeight != oldCharHeight) {
+ TkBTreeClientRangeChanged(textPtr, textPtr->charHeight);
+ }
+ border = textPtr->borderWidth + textPtr->highlightWidth;
+ Tk_GeometryRequest(textPtr->tkwin,
+ textPtr->width * textPtr->charWidth + 2*textPtr->padX + 2*border,
+ textPtr->height*(fm.linespace+textPtr->spacing1+textPtr->spacing3)
+ + 2*textPtr->padY + 2*border);
+
+ Tk_SetInternalBorderEx(textPtr->tkwin,
+ border + textPtr->padX, border + textPtr->padX,
+ border + textPtr->padY, border + textPtr->padY);
+ if (textPtr->setGrid) {
+ Tk_SetGrid(textPtr->tkwin, textPtr->width, textPtr->height,
+ textPtr->charWidth, textPtr->charHeight);
+ } else {
+ Tk_UnsetGrid(textPtr->tkwin);
+ }
+
+ TkTextRelayoutWindow(textPtr, mask);
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * TextEventProc --
+ *
+ * This function is invoked by the Tk dispatcher on structure changes to
+ * a text. For texts with 3D borders, this function is also invoked for
+ * exposures.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * When the window gets deleted, internal structures get cleaned up.
+ * When it gets exposed, it is redisplayed.
+ *
+ *--------------------------------------------------------------
+ */
+
+static void
+TextEventProc(
+ ClientData clientData, /* Information about window. */
+ register XEvent *eventPtr) /* Information about event. */
+{
+ register TkText *textPtr = clientData;
+ TkTextIndex index, index2;
+
+ if (eventPtr->type == Expose) {
+ TkTextRedrawRegion(textPtr, eventPtr->xexpose.x,
+ eventPtr->xexpose.y, eventPtr->xexpose.width,
+ eventPtr->xexpose.height);
+ } else if (eventPtr->type == ConfigureNotify) {
+ if ((textPtr->prevWidth != Tk_Width(textPtr->tkwin))
+ || (textPtr->prevHeight != Tk_Height(textPtr->tkwin))) {
+ int mask = 0;
+
+ if (textPtr->prevWidth != Tk_Width(textPtr->tkwin)) {
+ mask = TK_TEXT_LINE_GEOMETRY;
+ }
+ TkTextRelayoutWindow(textPtr, mask);
+ textPtr->prevWidth = Tk_Width(textPtr->tkwin);
+ textPtr->prevHeight = Tk_Height(textPtr->tkwin);
+ }
+ } else if (eventPtr->type == DestroyNotify) {
+ /*
+ * NOTE: we must zero out selBorder, selBorderWidthPtr and
+ * selFgColorPtr: they are duplicates of information in the "sel" tag,
+ * which will be freed up when we delete all tags. Hence we don't want
+ * the automatic config options freeing process to delete them as
+ * well.
+ */
+
+ textPtr->selBorder = NULL;
+ textPtr->selBorderWidthPtr = NULL;
+ textPtr->selBorderWidth = 0;
+ textPtr->selFgColorPtr = NULL;
+ if (textPtr->setGrid) {
+ Tk_UnsetGrid(textPtr->tkwin);
+ textPtr->setGrid = 0;
+ }
+ if (!(textPtr->flags & OPTIONS_FREED)) {
+ Tk_FreeConfigOptions((char *) textPtr, textPtr->optionTable,
+ textPtr->tkwin);
+ textPtr->flags |= OPTIONS_FREED;
+ }
+ textPtr->flags |= DESTROYED;
+
+ /*
+ * Call 'DestroyTest' to handle the deletion for us. The actual
+ * textPtr may still exist after this, if there are some outstanding
+ * references. But we have flagged it as DESTROYED just above, so
+ * nothing will try to make use of it very extensively.
+ */
+
+ DestroyText(textPtr);
+ } else if ((eventPtr->type == FocusIn) || (eventPtr->type == FocusOut)) {
+ if (eventPtr->xfocus.detail == NotifyInferior
+ || eventPtr->xfocus.detail == NotifyAncestor
+ || eventPtr->xfocus.detail == NotifyNonlinear) {
+ Tcl_DeleteTimerHandler(textPtr->insertBlinkHandler);
+ if (eventPtr->type == FocusIn) {
+ textPtr->flags |= GOT_FOCUS | INSERT_ON;
+ if (textPtr->insertOffTime != 0) {
+ textPtr->insertBlinkHandler = Tcl_CreateTimerHandler(
+ textPtr->insertOnTime, TextBlinkProc, textPtr);
+ }
+ } else {
+ textPtr->flags &= ~(GOT_FOCUS | INSERT_ON);
+ textPtr->insertBlinkHandler = NULL;
+ }
+ if (textPtr->inactiveSelBorder != textPtr->selBorder) {
+ TkTextRedrawTag(NULL, textPtr, NULL, NULL, textPtr->selTagPtr,
+ 1);
+ }
+ TkTextMarkSegToIndex(textPtr, textPtr->insertMarkPtr, &index);
+ TkTextIndexForwChars(NULL, &index, 1, &index2, COUNT_INDICES);
+
+ /*
+ * While we wish to redisplay, no heights have changed, so no need
+ * to call TkTextInvalidateLineMetrics.
+ */
+
+ TkTextChanged(NULL, textPtr, &index, &index2);
+ if (textPtr->highlightWidth > 0) {
+ TkTextRedrawRegion(textPtr, 0, 0, textPtr->highlightWidth,
+ textPtr->highlightWidth);
+ }
+ }
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TextCmdDeletedProc --
+ *
+ * This function is invoked when a widget command is deleted. If the
+ * widget isn't already in the process of being destroyed, this command
+ * destroys it.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The widget is destroyed.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+TextCmdDeletedProc(
+ ClientData clientData) /* Pointer to widget record for widget. */
+{
+ TkText *textPtr = clientData;
+ Tk_Window tkwin = textPtr->tkwin;
+
+ /*
+ * This function could be invoked either because the window was destroyed
+ * and the command was then deleted (in which this flag is already set) or
+ * because the command was deleted, and then this function destroys the
+ * widget.
+ */
+
+ if (!(textPtr->flags & DESTROYED)) {
+ if (textPtr->setGrid) {
+ Tk_UnsetGrid(textPtr->tkwin);
+ textPtr->setGrid = 0;
+ }
+ textPtr->flags |= DESTROYED;
+ Tk_DestroyWindow(tkwin);
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * InsertChars --
+ *
+ * This function implements most of the functionality of the "insert"
+ * widget command.
+ *
+ * Results:
+ * The length of the inserted string.
+ *
+ * Side effects:
+ * The characters in "stringPtr" get added to the text just before the
+ * character indicated by "indexPtr".
+ *
+ * If 'viewUpdate' is true, we may adjust the window contents'
+ * y-position, and scrollbar setting.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+InsertChars(
+ TkSharedText *sharedTextPtr,
+ TkText *textPtr, /* Overall information about text widget. */
+ TkTextIndex *indexPtr, /* Where to insert new characters. May be
+ * modified if the index is not valid for
+ * insertion (e.g. if at "end"). */
+ Tcl_Obj *stringPtr, /* Null-terminated string containing new
+ * information to add to text. */
+ int viewUpdate) /* Update the view if set. */
+{
+ int lineIndex, length;
+ TkText *tPtr;
+ int *lineAndByteIndex;
+ int resetViewCount;
+ int pixels[2*PIXEL_CLIENTS];
+ const char *string = Tcl_GetString(stringPtr);
+
+ length = stringPtr->length;
+ if (sharedTextPtr == NULL) {
+ sharedTextPtr = textPtr->sharedTextPtr;
+ }
+
+ /*
+ * Don't allow insertions on the last (dummy) line of the text. This is
+ * the only place in this function where the indexPtr is modified.
+ */
+
+ lineIndex = TkBTreeLinesTo(textPtr, indexPtr->linePtr);
+ if (lineIndex == TkBTreeNumLines(sharedTextPtr->tree, textPtr)) {
+ lineIndex--;
+ TkTextMakeByteIndex(sharedTextPtr->tree, textPtr, lineIndex, 1000000,
+ indexPtr);
+ }
+
+ /*
+ * Notify the display module that lines are about to change, then do the
+ * insertion. If the insertion occurs on the top line of the widget
+ * (textPtr->topIndex), then we have to recompute topIndex after the
+ * insertion, since the insertion could invalidate it.
+ */
+
+ resetViewCount = 0;
+ if (sharedTextPtr->refCount > PIXEL_CLIENTS) {
+ lineAndByteIndex = ckalloc(sizeof(int) * 2 * sharedTextPtr->refCount);
+ } else {
+ lineAndByteIndex = pixels;
+ }
+ for (tPtr = sharedTextPtr->peers; tPtr != NULL ; tPtr = tPtr->next) {
+ lineAndByteIndex[resetViewCount] = -1;
+ if (indexPtr->linePtr == tPtr->topIndex.linePtr) {
+ lineAndByteIndex[resetViewCount] =
+ TkBTreeLinesTo(tPtr, indexPtr->linePtr);
+ lineAndByteIndex[resetViewCount+1] = tPtr->topIndex.byteIndex;
+ if (lineAndByteIndex[resetViewCount+1] > indexPtr->byteIndex) {
+ lineAndByteIndex[resetViewCount+1] += length;
+ }
+ }
+ resetViewCount += 2;
+ }
+
+ TkTextChanged(sharedTextPtr, NULL, indexPtr, indexPtr);
+
+ sharedTextPtr->stateEpoch++;
+
+ TkBTreeInsertChars(sharedTextPtr->tree, indexPtr, string);
+
+ /*
+ * Push the insertion on the undo stack, and update the modified status of
+ * the widget.
+ */
+
+ if (length > 0) {
+ if (sharedTextPtr->undo) {
+ TkTextIndex toIndex;
+
+ if (sharedTextPtr->autoSeparators &&
+ sharedTextPtr->lastEditMode != TK_TEXT_EDIT_INSERT) {
+ TkUndoInsertUndoSeparator(sharedTextPtr->undoStack);
+ }
+
+ sharedTextPtr->lastEditMode = TK_TEXT_EDIT_INSERT;
+
+ TkTextIndexForwBytes(textPtr, indexPtr, length, &toIndex);
+ TextPushUndoAction(textPtr, stringPtr, 1, indexPtr, &toIndex);
+ }
+
+ UpdateDirtyFlag(sharedTextPtr);
+ }
+
+ resetViewCount = 0;
+ for (tPtr = sharedTextPtr->peers; tPtr != NULL ; tPtr = tPtr->next) {
+ if (lineAndByteIndex[resetViewCount] != -1) {
+ if ((tPtr != textPtr) || viewUpdate) {
+ TkTextIndex newTop;
+
+ TkTextMakeByteIndex(sharedTextPtr->tree, tPtr,
+ lineAndByteIndex[resetViewCount], 0, &newTop);
+ TkTextIndexForwBytes(tPtr, &newTop,
+ lineAndByteIndex[resetViewCount+1], &newTop);
+ TkTextSetYView(tPtr, &newTop, 0);
+ }
+ }
+ resetViewCount += 2;
+ }
+ if (sharedTextPtr->refCount > PIXEL_CLIENTS) {
+ ckfree(lineAndByteIndex);
+ }
+
+ /*
+ * Invalidate any selection retrievals in progress.
+ */
+
+ for (tPtr = sharedTextPtr->peers; tPtr != NULL ; tPtr = tPtr->next) {
+ tPtr->abortSelections = 1;
+ }
+
+ /*
+ * For convenience, return the length of the string.
+ */
+
+ return length;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TextPushUndoAction --
+ *
+ * Shared by insert and delete actions. Stores the appropriate scripts
+ * into our undo stack. We will add a single refCount to the 'undoString'
+ * object, so, if it previously had a refCount of zero, the caller should
+ * not free it.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Items pushed onto stack.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+TextPushUndoAction(
+ TkText *textPtr, /* Overall information about text widget. */
+ Tcl_Obj *undoString, /* New text. */
+ int insert, /* 1 if insert, else delete. */
+ const TkTextIndex *index1Ptr,
+ /* Index describing first location. */
+ const TkTextIndex *index2Ptr)
+ /* Index describing second location. */
+{
+ TkUndoSubAtom *iAtom, *dAtom;
+ int canUndo, canRedo;
+
+ /*
+ * Create the helpers.
+ */
+
+ Tcl_Obj *seeInsertObj = Tcl_NewObj();
+ Tcl_Obj *markSet1InsertObj = Tcl_NewObj();
+ Tcl_Obj *markSet2InsertObj = NULL;
+ Tcl_Obj *insertCmdObj = Tcl_NewObj();
+ Tcl_Obj *deleteCmdObj = Tcl_NewObj();
+
+ /*
+ * Get the index positions.
+ */
+
+ Tcl_Obj *index1Obj = TkTextNewIndexObj(NULL, index1Ptr);
+ Tcl_Obj *index2Obj = TkTextNewIndexObj(NULL, index2Ptr);
+
+ /*
+ * These need refCounts, because they are used more than once below.
+ */
+
+ Tcl_IncrRefCount(seeInsertObj);
+ Tcl_IncrRefCount(index1Obj);
+ Tcl_IncrRefCount(index2Obj);
+
+ Tcl_ListObjAppendElement(NULL, seeInsertObj,
+ Tcl_NewStringObj(Tk_PathName(textPtr->tkwin), -1));
+ Tcl_ListObjAppendElement(NULL, seeInsertObj, Tcl_NewStringObj("see", 3));
+ Tcl_ListObjAppendElement(NULL, seeInsertObj,
+ Tcl_NewStringObj("insert", 6));
+
+ Tcl_ListObjAppendElement(NULL, markSet1InsertObj,
+ Tcl_NewStringObj(Tk_PathName(textPtr->tkwin), -1));
+ Tcl_ListObjAppendElement(NULL, markSet1InsertObj,
+ Tcl_NewStringObj("mark", 4));
+ Tcl_ListObjAppendElement(NULL, markSet1InsertObj,
+ Tcl_NewStringObj("set", 3));
+ Tcl_ListObjAppendElement(NULL, markSet1InsertObj,
+ Tcl_NewStringObj("insert", 6));
+ markSet2InsertObj = Tcl_DuplicateObj(markSet1InsertObj);
+ Tcl_ListObjAppendElement(NULL, markSet1InsertObj, index1Obj);
+ Tcl_ListObjAppendElement(NULL, markSet2InsertObj, index2Obj);
+
+ Tcl_ListObjAppendElement(NULL, insertCmdObj,
+ Tcl_NewStringObj("insert", 6));
+ Tcl_ListObjAppendElement(NULL, insertCmdObj, index1Obj);
+
+ /*
+ * Only use of 'undoString' is here.
+ */
+
+ Tcl_ListObjAppendElement(NULL, insertCmdObj, undoString);
+
+ Tcl_ListObjAppendElement(NULL, deleteCmdObj,
+ Tcl_NewStringObj("delete", 6));
+ Tcl_ListObjAppendElement(NULL, deleteCmdObj, index1Obj);
+ Tcl_ListObjAppendElement(NULL, deleteCmdObj, index2Obj);
+
+ /*
+ * Note: we don't wish to use textPtr->widgetCmd in these callbacks
+ * because if we delete the textPtr, but peers still exist, we will then
+ * have references to a non-existent Tcl_Command in the undo stack, which
+ * will lead to crashes later. Also, the behaviour of the widget w.r.t.
+ * bindings (%W substitutions) always uses the widget path name, so there
+ * is no good reason the undo stack should do otherwise.
+ *
+ * For the 'insert' and 'delete' actions, we have to register a functional
+ * callback, because these actions are defined to operate on the
+ * underlying data shared by all peers.
+ */
+
+ iAtom = TkUndoMakeSubAtom(&TextUndoRedoCallback, textPtr->sharedTextPtr,
+ insertCmdObj, NULL);
+ TkUndoMakeCmdSubAtom(NULL, markSet2InsertObj, iAtom);
+ TkUndoMakeCmdSubAtom(NULL, seeInsertObj, iAtom);
+
+ dAtom = TkUndoMakeSubAtom(&TextUndoRedoCallback, textPtr->sharedTextPtr,
+ deleteCmdObj, NULL);
+ TkUndoMakeCmdSubAtom(NULL, markSet1InsertObj, dAtom);
+ TkUndoMakeCmdSubAtom(NULL, seeInsertObj, dAtom);
+
+ Tcl_DecrRefCount(seeInsertObj);
+ Tcl_DecrRefCount(index1Obj);
+ Tcl_DecrRefCount(index2Obj);
+
+ canUndo = TkUndoCanUndo(textPtr->sharedTextPtr->undoStack);
+ canRedo = TkUndoCanRedo(textPtr->sharedTextPtr->undoStack);
+
+ /*
+ * Depending whether the action is to insert or delete, we provide the
+ * appropriate second and third arguments to TkUndoPushAction. (The first
+ * is the 'actionCommand', and the second the 'revertCommand').
+ */
+
+ if (insert) {
+ TkUndoPushAction(textPtr->sharedTextPtr->undoStack, iAtom, dAtom);
+ } else {
+ TkUndoPushAction(textPtr->sharedTextPtr->undoStack, dAtom, iAtom);
+ }
+
+ if (!canUndo || canRedo) {
+ GenerateUndoStackEvent(textPtr);
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TextUndoRedoCallback --
+ *
+ * This function is registered with the generic undo/redo code to handle
+ * 'insert' and 'delete' actions on all text widgets. We cannot perform
+ * those actions on any particular text widget, because that text widget
+ * might have been deleted by the time we get here.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * Will insert or delete text, depending on the first word contained in
+ * objPtr.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TextUndoRedoCallback(
+ Tcl_Interp *interp, /* Current interpreter. */
+ ClientData clientData, /* Passed from undo code, but contains our
+ * shared text data structure. */
+ Tcl_Obj *objPtr) /* Arguments of a command to be handled by the
+ * shared text data structure. */
+{
+ TkSharedText *sharedPtr = clientData;
+ int res, objc;
+ Tcl_Obj **objv;
+ TkText *textPtr;
+
+ res = Tcl_ListObjGetElements(interp, objPtr, &objc, &objv);
+ if (res != TCL_OK) {
+ return res;
+ }
+
+ /*
+ * If possible, use a real text widget to perform the undo/redo action
+ * (i.e. insertion or deletion of text). This provides maximum
+ * compatibility with older versions of Tk, in which the user may rename
+ * the text widget to allow capture of undo or redo actions.
+ *
+ * In particular, this sorting of capture is useful in text editors based
+ * on the Tk text widget, which need to know which new text needs
+ * re-coloring.
+ *
+ * It would be better if the text widget provided some other mechanism to
+ * allow capture of this information ("What has just changed in the text
+ * widget?"). What we have here is not entirely satisfactory under all
+ * circumstances.
+ */
+
+ textPtr = sharedPtr->peers;
+ while (textPtr != NULL) {
+ if (textPtr->start == NULL && textPtr->end == NULL) {
+ Tcl_Obj *cmdNameObj, *evalObj;
+
+ evalObj = Tcl_NewObj();
+ Tcl_IncrRefCount(evalObj);
+
+ /*
+ * We might wish to use the real, current command-name for the
+ * widget, but this will break any code that has over-ridden the
+ * widget, and is expecting to observe the insert/delete actions
+ * which are caused by undo/redo operations.
+ *
+ * cmdNameObj = Tcl_NewObj();
+ * Tcl_GetCommandFullName(interp, textPtr->widgetCmd, cmdNameObj);
+ *
+ * While such interception is not explicitly documented as
+ * supported, it does occur, and so until we can provide some
+ * alternative mechanism for such code to do what it needs, we
+ * allow it to take place here.
+ */
+
+ cmdNameObj = Tcl_NewStringObj(Tk_PathName(textPtr->tkwin), -1);
+ Tcl_ListObjAppendElement(NULL, evalObj, cmdNameObj);
+ Tcl_ListObjAppendList(NULL, evalObj, objPtr);
+ res = Tcl_EvalObjEx(interp, evalObj, TCL_EVAL_GLOBAL);
+ Tcl_DecrRefCount(evalObj);
+ return res;
+ }
+ textPtr = textPtr->next;
+ }
+
+ /*
+ * If there's no current text widget which shows everything, then we fall
+ * back on acting directly. This means there is no way to intercept from
+ * the Tcl level.
+ */
+
+ return SharedTextObjCmd(sharedPtr, interp, objc+1, objv-1);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * CountIndices --
+ *
+ * This function implements most of the functionality of the "count"
+ * widget command.
+ *
+ * Note that 'textPtr' is only used if we need to check for elided
+ * attributes, i.e. if type is COUNT_DISPLAY_INDICES or
+ * COUNT_DISPLAY_CHARS
+ *
+ * Results:
+ * Returns the number of characters in the range.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+CountIndices(
+ const TkText *textPtr, /* Overall information about text widget. */
+ const TkTextIndex *indexPtr1,
+ /* Index describing location of first
+ * character to delete. */
+ const TkTextIndex *indexPtr2,
+ /* Index describing location of last character
+ * to delete. NULL means just delete the one
+ * character given by indexPtr1. */
+ TkTextCountType type) /* The kind of indices to count. */
+{
+ /*
+ * Order the starting and stopping indices.
+ */
+
+ int compare = TkTextIndexCmp(indexPtr1, indexPtr2);
+
+ if (compare == 0) {
+ return 0;
+ } else if (compare > 0) {
+ return -TkTextIndexCount(textPtr, indexPtr2, indexPtr1, type);
+ } else {
+ return TkTextIndexCount(textPtr, indexPtr1, indexPtr2, type);
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * DeleteIndexRange --
+ *
+ * This function implements most of the functionality of the "delete"
+ * widget command.
+ *
+ * Results:
+ * Returns a standard Tcl result, currently always TCL_OK.
+ *
+ * Side effects:
+ * Characters and other entities (windows, images) get deleted from the
+ * text.
+ *
+ * If 'viewUpdate' is true, we may adjust the window contents'
+ * y-position, and scrollbar setting.
+ *
+ * If 'viewUpdate' is false, true we can guarantee that textPtr->topIndex
+ * points to a valid TkTextLine after this function returns. However, if
+ * 'viewUpdate' is false, then there is no such guarantee (since
+ * topIndex.linePtr can be garbage). The caller is expected to take
+ * actions to ensure the topIndex is validated before laying out the
+ * window again.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+DeleteIndexRange(
+ TkSharedText *sharedTextPtr,/* Shared portion of peer widgets. */
+ TkText *textPtr, /* Overall information about text widget. */
+ const TkTextIndex *indexPtr1,
+ /* Index describing location of first
+ * character (or other entity) to delete. */
+ const TkTextIndex *indexPtr2,
+ /* Index describing location of last
+ * character (or other entity) to delete.
+ * NULL means just delete the one character
+ * given by indexPtr1. */
+ int viewUpdate) /* Update vertical view if set. */
+{
+ int line1, line2;
+ TkTextIndex index1, index2;
+ TkText *tPtr;
+ int *lineAndByteIndex;
+ int resetViewCount;
+ int pixels[2*PIXEL_CLIENTS];
+
+ if (sharedTextPtr == NULL) {
+ sharedTextPtr = textPtr->sharedTextPtr;
+ }
+
+ /*
+ * Prepare the starting and stopping indices.
+ */
+
+ index1 = *indexPtr1;
+ if (indexPtr2 != NULL) {
+ index2 = *indexPtr2;
+ } else {
+ index2 = index1;
+ TkTextIndexForwChars(NULL, &index2, 1, &index2, COUNT_INDICES);
+ }
+
+ /*
+ * Make sure there's really something to delete.
+ */
+
+ if (TkTextIndexCmp(&index1, &index2) >= 0) {
+ return TCL_OK;
+ }
+
+ /*
+ * The code below is ugly, but it's needed to make sure there is always a
+ * dummy empty line at the end of the text. If the final newline of the
+ * file (just before the dummy line) is being deleted, then back up index
+ * to just before the newline. If there is a newline just before the first
+ * character being deleted, then back up the first index too. The idea is
+ * that a deletion involving a range starting at a line start and
+ * including the final \n (i.e. index2 is "end") is an attempt to delete
+ * complete lines, so the \n before the deleted block shall become the new
+ * final \n. Furthermore, remove any tags that are present on the newline
+ * that isn't going to be deleted after all (this simulates deleting the
+ * newline and then adding a "clean" one back again). Note that index1 and
+ * index2 might now be equal again which means that no text will be
+ * deleted but tags might be removed.
+ */
+
+ line1 = TkBTreeLinesTo(textPtr, index1.linePtr);
+ line2 = TkBTreeLinesTo(textPtr, index2.linePtr);
+ if (line2 == TkBTreeNumLines(sharedTextPtr->tree, textPtr)) {
+ TkTextTag **arrayPtr;
+ int arraySize, i;
+ TkTextIndex oldIndex2;
+
+ oldIndex2 = index2;
+ TkTextIndexBackChars(NULL, &oldIndex2, 1, &index2, COUNT_INDICES);
+ line2--;
+ if ((index1.byteIndex == 0) && (line1 != 0)) {
+ TkTextIndexBackChars(NULL, &index1, 1, &index1, COUNT_INDICES);
+ line1--;
+ }
+ arrayPtr = TkBTreeGetTags(&index2, NULL, &arraySize);
+ if (arrayPtr != NULL) {
+ for (i = 0; i < arraySize; i++) {
+ TkBTreeTag(&index2, &oldIndex2, arrayPtr[i], 0);
+ }
+ ckfree(arrayPtr);
+ }
+ }
+
+ if (line1 < line2) {
+ /*
+ * We are deleting more than one line. For speed, we remove all tags
+ * from the range first. If we don't do this, the code below can (when
+ * there are many tags) grow non-linearly in execution time.
+ */
+
+ Tcl_HashSearch search;
+ Tcl_HashEntry *hPtr;
+ int i;
+
+ for (i=0, hPtr=Tcl_FirstHashEntry(&sharedTextPtr->tagTable, &search);
+ hPtr != NULL; i++, hPtr = Tcl_NextHashEntry(&search)) {
+ TkTextTag *tagPtr = Tcl_GetHashValue(hPtr);
+
+ TkBTreeTag(&index1, &index2, tagPtr, 0);
+ }
+
+ /*
+ * Special case for the sel tag which is not in the hash table. We
+ * need to do this once for each peer text widget.
+ */
+
+ for (tPtr = sharedTextPtr->peers; tPtr != NULL ;
+ tPtr = tPtr->next) {
+ if (TkBTreeTag(&index1, &index2, tPtr->selTagPtr, 0)) {
+ /*
+ * Send an event that the selection changed. This is
+ * equivalent to:
+ * event generate $textWidget <<Selection>>
+ */
+
+ TkTextSelectionEvent(textPtr);
+ tPtr->abortSelections = 1;
+ }
+ }
+ }
+
+ /*
+ * Tell the display what's about to happen so it can discard obsolete
+ * display information, then do the deletion. Also, if the deletion
+ * involves the top line on the screen, then we have to reset the view
+ * (the deletion will invalidate textPtr->topIndex). Compute what the new
+ * first character will be, then do the deletion, then reset the view.
+ */
+
+ TkTextChanged(sharedTextPtr, NULL, &index1, &index2);
+
+ resetViewCount = 0;
+ if (sharedTextPtr->refCount > PIXEL_CLIENTS) {
+ lineAndByteIndex = ckalloc(sizeof(int) * 2 * sharedTextPtr->refCount);
+ } else {
+ lineAndByteIndex = pixels;
+ }
+ for (tPtr = sharedTextPtr->peers; tPtr != NULL ; tPtr = tPtr->next) {
+ int line = 0;
+ int byteIndex = 0;
+ int resetView = 0;
+
+ if (TkTextIndexCmp(&index2, &tPtr->topIndex) >= 0) {
+ if (TkTextIndexCmp(&index1, &tPtr->topIndex) <= 0) {
+ /*
+ * Deletion range straddles topIndex: use the beginning of the
+ * range as the new topIndex.
+ */
+
+ resetView = 1;
+ line = line1;
+ byteIndex = index1.byteIndex;
+ } else if (index1.linePtr == tPtr->topIndex.linePtr) {
+ /*
+ * Deletion range starts on top line but after topIndex. Use
+ * the current topIndex as the new one.
+ */
+
+ resetView = 1;
+ line = line1;
+ byteIndex = tPtr->topIndex.byteIndex;
+ } else {
+ /*
+ * Deletion range starts after the top line. This peers's view
+ * will not need to be reset. Nothing to do.
+ */
+ }
+ } else if (index2.linePtr == tPtr->topIndex.linePtr) {
+ /*
+ * Deletion range ends on top line but before topIndex. Figure out
+ * what will be the new character index for the character
+ * currently pointed to by topIndex.
+ */
+
+ resetView = 1;
+ line = line2;
+ byteIndex = tPtr->topIndex.byteIndex;
+ if (index1.linePtr != index2.linePtr) {
+ byteIndex -= index2.byteIndex;
+ } else {
+ byteIndex -= (index2.byteIndex - index1.byteIndex);
+ }
+ } else {
+ /*
+ * Deletion range ends before the top line. This peers's view
+ * will not need to be reset. Nothing to do.
+ */
+ }
+ if (resetView) {
+ lineAndByteIndex[resetViewCount] = line;
+ lineAndByteIndex[resetViewCount+1] = byteIndex;
+ } else {
+ lineAndByteIndex[resetViewCount] = -1;
+ }
+ resetViewCount += 2;
+ }
+
+ /*
+ * Push the deletion on the undo stack if something was actually deleted.
+ */
+
+ if (TkTextIndexCmp(&index1, &index2) < 0) {
+ if (sharedTextPtr->undo) {
+ Tcl_Obj *get;
+
+ if (sharedTextPtr->autoSeparators
+ && (sharedTextPtr->lastEditMode != TK_TEXT_EDIT_DELETE)) {
+ TkUndoInsertUndoSeparator(sharedTextPtr->undoStack);
+ }
+
+ sharedTextPtr->lastEditMode = TK_TEXT_EDIT_DELETE;
+
+ get = TextGetText(textPtr, &index1, &index2, 0);
+ TextPushUndoAction(textPtr, get, 0, &index1, &index2);
+ }
+ sharedTextPtr->stateEpoch++;
+
+ TkBTreeDeleteIndexRange(sharedTextPtr->tree, &index1, &index2);
+
+ UpdateDirtyFlag(sharedTextPtr);
+ }
+
+ resetViewCount = 0;
+ for (tPtr = sharedTextPtr->peers; tPtr != NULL ; tPtr = tPtr->next) {
+ int line = lineAndByteIndex[resetViewCount];
+
+ if (line != -1) {
+ int byteIndex = lineAndByteIndex[resetViewCount+1];
+ TkTextIndex indexTmp;
+
+ if (tPtr == textPtr) {
+ if (viewUpdate) {
+ /*
+ * line cannot be before -startline of textPtr because
+ * this line corresponds to an index which is necessarily
+ * between "1.0" and "end" relative to textPtr.
+ * Therefore no need to clamp line to the -start/-end
+ * range.
+ */
+
+ TkTextMakeByteIndex(sharedTextPtr->tree, textPtr, line,
+ byteIndex, &indexTmp);
+ TkTextSetYView(tPtr, &indexTmp, 0);
+ }
+ } else {
+ TkTextMakeByteIndex(sharedTextPtr->tree, tPtr, line,
+ byteIndex, &indexTmp);
+ /*
+ * line may be before -startline of tPtr and must be
+ * clamped to -startline before providing it to
+ * TkTextSetYView otherwise lines before -startline
+ * would be displayed.
+ * There is no need to worry about -endline however,
+ * because the view will only be reset if the deletion
+ * involves the TOP line of the screen
+ */
+
+ if (tPtr->start != NULL) {
+ int start;
+ TkTextIndex indexStart;
+
+ start = TkBTreeLinesTo(NULL, tPtr->start);
+ TkTextMakeByteIndex(sharedTextPtr->tree, NULL, start,
+ 0, &indexStart);
+ if (TkTextIndexCmp(&indexTmp, &indexStart) < 0) {
+ indexTmp = indexStart;
+ }
+ }
+ TkTextSetYView(tPtr, &indexTmp, 0);
+ }
+ }
+ resetViewCount += 2;
+ }
+ if (sharedTextPtr->refCount > PIXEL_CLIENTS) {
+ ckfree(lineAndByteIndex);
+ }
+
+ if (line1 >= line2) {
+ /*
+ * Invalidate any selection retrievals in progress, assuming we didn't
+ * check for this case above.
+ */
+
+ for (tPtr = sharedTextPtr->peers; tPtr != NULL ; tPtr = tPtr->next) {
+ tPtr->abortSelections = 1;
+ }
+ }
+
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TextFetchSelection --
+ *
+ * This function is called back by Tk when the selection is requested by
+ * someone. It returns part or all of the selection in a buffer provided
+ * by the caller.
+ *
+ * Results:
+ * The return value is the number of non-NULL bytes stored at buffer.
+ * Buffer is filled (or partially filled) with a NULL-terminated string
+ * containing part or all of the selection, as given by offset and
+ * maxBytes.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+TextFetchSelection(
+ ClientData clientData, /* Information about text widget. */
+ int offset, /* Offset within selection of first character
+ * to be returned. */
+ char *buffer, /* Location in which to place selection. */
+ int maxBytes) /* Maximum number of bytes to place at buffer,
+ * not including terminating NULL
+ * character. */
+{
+ register TkText *textPtr = clientData;
+ TkTextIndex eof;
+ int count, chunkSize, offsetInSeg;
+ TkTextSearch search;
+ TkTextSegment *segPtr;
+
+ if (!textPtr->exportSelection) {
+ return -1;
+ }
+
+ /*
+ * Find the beginning of the next range of selected text. Note: if the
+ * selection is being retrieved in multiple pieces (offset != 0) and some
+ * modification has been made to the text that affects the selection then
+ * reject the selection request (make 'em start over again).
+ */
+
+ if (offset == 0) {
+ TkTextMakeByteIndex(textPtr->sharedTextPtr->tree, textPtr, 0, 0,
+ &textPtr->selIndex);
+ textPtr->abortSelections = 0;
+ } else if (textPtr->abortSelections) {
+ return 0;
+ }
+ TkTextMakeByteIndex(textPtr->sharedTextPtr->tree, textPtr,
+ TkBTreeNumLines(textPtr->sharedTextPtr->tree, textPtr), 0, &eof);
+ TkBTreeStartSearch(&textPtr->selIndex, &eof, textPtr->selTagPtr, &search);
+ if (!TkBTreeCharTagged(&textPtr->selIndex, textPtr->selTagPtr)) {
+ if (!TkBTreeNextTag(&search)) {
+ if (offset == 0) {
+ return -1;
+ } else {
+ return 0;
+ }
+ }
+ textPtr->selIndex = search.curIndex;
+ }
+
+ /*
+ * Each iteration through the outer loop below scans one selected range.
+ * Each iteration through the inner loop scans one segment in the selected
+ * range.
+ */
+
+ count = 0;
+ while (1) {
+ /*
+ * Find the end of the current range of selected text.
+ */
+
+ if (!TkBTreeNextTag(&search)) {
+ Tcl_Panic("TextFetchSelection couldn't find end of range");
+ }
+
+ /*
+ * Copy information from character segments into the buffer until
+ * either we run out of space in the buffer or we get to the end of
+ * this range of text.
+ */
+
+ while (1) {
+ if (maxBytes == 0) {
+ goto fetchDone;
+ }
+ segPtr = TkTextIndexToSeg(&textPtr->selIndex, &offsetInSeg);
+ chunkSize = segPtr->size - offsetInSeg;
+ if (chunkSize > maxBytes) {
+ chunkSize = maxBytes;
+ }
+ if (textPtr->selIndex.linePtr == search.curIndex.linePtr) {
+ int leftInRange;
+
+ leftInRange = search.curIndex.byteIndex
+ - textPtr->selIndex.byteIndex;
+ if (leftInRange < chunkSize) {
+ chunkSize = leftInRange;
+ if (chunkSize <= 0) {
+ break;
+ }
+ }
+ }
+ if ((segPtr->typePtr == &tkTextCharType)
+ && !TkTextIsElided(textPtr, &textPtr->selIndex, NULL)) {
+ memcpy(buffer, segPtr->body.chars + offsetInSeg,
+ (size_t) chunkSize);
+ buffer += chunkSize;
+ maxBytes -= chunkSize;
+ count += chunkSize;
+ }
+ TkTextIndexForwBytes(textPtr, &textPtr->selIndex, chunkSize,
+ &textPtr->selIndex);
+ }
+
+ /*
+ * Find the beginning of the next range of selected text.
+ */
+
+ if (!TkBTreeNextTag(&search)) {
+ break;
+ }
+ textPtr->selIndex = search.curIndex;
+ }
+
+ fetchDone:
+ *buffer = 0;
+ return count;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkTextLostSelection --
+ *
+ * This function is called back by Tk when the selection is grabbed away
+ * from a text widget. On Windows and Mac systems, we want to remember
+ * the selection for the next time the focus enters the window. On Unix,
+ * just remove the "sel" tag from everything in the widget.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The "sel" tag is cleared from the window.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TkTextLostSelection(
+ ClientData clientData) /* Information about text widget. */
+{
+ register TkText *textPtr = clientData;
+
+ if (TkpAlwaysShowSelection(textPtr->tkwin)) {
+ TkTextIndex start, end;
+
+ if (!textPtr->exportSelection) {
+ return;
+ }
+
+ /*
+ * On Windows and Mac systems, we want to remember the selection for
+ * the next time the focus enters the window. On Unix, just remove the
+ * "sel" tag from everything in the widget.
+ */
+
+ TkTextMakeByteIndex(textPtr->sharedTextPtr->tree, textPtr,
+ 0, 0, &start);
+ TkTextMakeByteIndex(textPtr->sharedTextPtr->tree, textPtr,
+ TkBTreeNumLines(textPtr->sharedTextPtr->tree, textPtr),
+ 0, &end);
+ TkTextRedrawTag(NULL, textPtr, &start, &end, textPtr->selTagPtr, 1);
+ TkBTreeTag(&start, &end, textPtr->selTagPtr, 0);
+ }
+
+ /*
+ * Send an event that the selection changed. This is equivalent to:
+ * event generate $textWidget <<Selection>>
+ */
+
+ TkTextSelectionEvent(textPtr);
+
+ textPtr->flags &= ~GOT_SELECTION;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkTextSelectionEvent --
+ *
+ * When anything relevant to the "sel" tag has been changed, call this
+ * function to generate a <<Selection>> event.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * If <<Selection>> bindings are present, they will trigger.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TkTextSelectionEvent(
+ TkText *textPtr)
+{
+ /*
+ * Send an event that the selection changed. This is equivalent to:
+ * event generate $textWidget <<Selection>>
+ */
+
+ TkSendVirtualEvent(textPtr->tkwin, "Selection", NULL);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TextBlinkProc --
+ *
+ * This function is called as a timer handler to blink the insertion
+ * cursor off and on.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The cursor gets turned on or off, redisplay gets invoked, and this
+ * function reschedules itself.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+TextBlinkProc(
+ ClientData clientData) /* Pointer to record describing text. */
+{
+ register TkText *textPtr = clientData;
+ TkTextIndex index;
+ int x, y, w, h, charWidth;
+
+ if ((textPtr->state == TK_TEXT_STATE_DISABLED) ||
+ !(textPtr->flags & GOT_FOCUS) || (textPtr->insertOffTime == 0)) {
+ if (!(textPtr->flags & GOT_FOCUS) &&
+ (textPtr->insertUnfocussed != TK_TEXT_INSERT_NOFOCUS_NONE)) {
+ /*
+ * The widget doesn't have the focus yet it is configured to
+ * display the cursor when it doesn't have the focus. Act now!
+ */
+
+ textPtr->flags |= INSERT_ON;
+ goto redrawInsert;
+ }
+ if ((textPtr->insertOffTime == 0) && !(textPtr->flags & INSERT_ON)) {
+ /*
+ * The widget was configured to have zero offtime while the
+ * insertion point was not displayed. We have to display it once.
+ */
+
+ textPtr->flags |= INSERT_ON;
+ goto redrawInsert;
+ }
+ return;
+ }
+ if (textPtr->flags & INSERT_ON) {
+ textPtr->flags &= ~INSERT_ON;
+ textPtr->insertBlinkHandler = Tcl_CreateTimerHandler(
+ textPtr->insertOffTime, TextBlinkProc, textPtr);
+ } else {
+ textPtr->flags |= INSERT_ON;
+ textPtr->insertBlinkHandler = Tcl_CreateTimerHandler(
+ textPtr->insertOnTime, TextBlinkProc, textPtr);
+ }
+ redrawInsert:
+ TkTextMarkSegToIndex(textPtr, textPtr->insertMarkPtr, &index);
+ if (TkTextIndexBbox(textPtr, &index, &x, &y, &w, &h, &charWidth) == 0) {
+ if (textPtr->insertCursorType) {
+ /* Block cursor */
+ TkTextRedrawRegion(textPtr, x - textPtr->width / 2, y,
+ charWidth + textPtr->insertWidth / 2, h);
+ } else {
+ /* I-beam cursor */
+ TkTextRedrawRegion(textPtr, x - textPtr->insertWidth / 2, y,
+ textPtr->insertWidth, h);
+ }
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TextInsertCmd --
+ *
+ * This function is invoked to process the "insert" and "replace" widget
+ * commands for text widgets.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * See the user documentation.
+ *
+ * If 'viewUpdate' is true, we may adjust the window contents'
+ * y-position, and scrollbar setting.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+TextInsertCmd(
+ TkSharedText *sharedTextPtr,/* Shared portion of peer widgets. */
+ TkText *textPtr, /* Information about text widget. */
+ Tcl_Interp *interp, /* Current interpreter. */
+ int objc, /* Number of arguments. */
+ Tcl_Obj *const objv[], /* Argument objects. */
+ const TkTextIndex *indexPtr,/* Index at which to insert. */
+ int viewUpdate) /* Update the view if set. */
+{
+ TkTextIndex index1, index2;
+ int j;
+
+ if (sharedTextPtr == NULL) {
+ sharedTextPtr = textPtr->sharedTextPtr;
+ }
+
+ index1 = *indexPtr;
+ for (j = 0; j < objc; j += 2) {
+ /*
+ * Here we rely on this call to modify index1 if it is outside the
+ * acceptable range. In particular, if index1 is "end", it must be set
+ * to the last allowable index for insertion, otherwise subsequent tag
+ * insertions will fail.
+ */
+
+ int length = InsertChars(sharedTextPtr, textPtr, &index1, objv[j],
+ viewUpdate);
+
+ if (objc > (j+1)) {
+ Tcl_Obj **tagNamePtrs;
+ TkTextTag **oldTagArrayPtr;
+ int numTags;
+
+ TkTextIndexForwBytes(textPtr, &index1, length, &index2);
+ oldTagArrayPtr = TkBTreeGetTags(&index1, NULL, &numTags);
+ if (oldTagArrayPtr != NULL) {
+ int i;
+
+ for (i = 0; i < numTags; i++) {
+ TkBTreeTag(&index1, &index2, oldTagArrayPtr[i], 0);
+ }
+ ckfree(oldTagArrayPtr);
+ }
+ if (Tcl_ListObjGetElements(interp, objv[j+1], &numTags,
+ &tagNamePtrs) != TCL_OK) {
+ return TCL_ERROR;
+ } else {
+ int i;
+
+ for (i = 0; i < numTags; i++) {
+ const char *strTag = Tcl_GetString(tagNamePtrs[i]);
+
+ TkBTreeTag(&index1, &index2,
+ TkTextCreateTag(textPtr, strTag, NULL), 1);
+ }
+ index1 = index2;
+ }
+ }
+ }
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TextSearchCmd --
+ *
+ * This function is invoked to process the "search" widget command for
+ * text widgets. See the user documentation for details on what it does.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * See the user documentation.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+TextSearchCmd(
+ TkText *textPtr, /* Information about text widget. */
+ Tcl_Interp *interp, /* Current interpreter. */
+ int objc, /* Number of arguments. */
+ Tcl_Obj *const objv[]) /* Argument objects. */
+{
+ int i, argsLeft, code;
+ SearchSpec searchSpec;
+
+ static const char *const switchStrings[] = {
+ "-hidden",
+ "--", "-all", "-backwards", "-count", "-elide", "-exact", "-forwards",
+ "-nocase", "-nolinestop", "-overlap", "-regexp", "-strictlimits", NULL
+ };
+ enum SearchSwitches {
+ SEARCH_HIDDEN,
+ SEARCH_END, SEARCH_ALL, SEARCH_BACK, SEARCH_COUNT, SEARCH_ELIDE,
+ SEARCH_EXACT, SEARCH_FWD, SEARCH_NOCASE,
+ SEARCH_NOLINESTOP, SEARCH_OVERLAP, SEARCH_REGEXP, SEARCH_STRICTLIMITS
+ };
+
+ /*
+ * Set up the search specification, including the last 4 fields which are
+ * text widget specific.
+ */
+
+ searchSpec.exact = 1;
+ searchSpec.noCase = 0;
+ searchSpec.all = 0;
+ searchSpec.backwards = 0;
+ searchSpec.varPtr = NULL;
+ searchSpec.countPtr = NULL;
+ searchSpec.resPtr = NULL;
+ searchSpec.searchElide = 0;
+ searchSpec.noLineStop = 0;
+ searchSpec.overlap = 0;
+ searchSpec.strictLimits = 0;
+ searchSpec.numLines =
+ TkBTreeNumLines(textPtr->sharedTextPtr->tree, textPtr);
+ searchSpec.clientData = textPtr;
+ searchSpec.addLineProc = &TextSearchAddNextLine;
+ searchSpec.foundMatchProc = &TextSearchFoundMatch;
+ searchSpec.lineIndexProc = &TextSearchGetLineIndex;
+
+ /*
+ * Parse switches and other arguments.
+ */
+
+ for (i=2 ; i<objc ; i++) {
+ int index;
+
+ if (Tcl_GetString(objv[i])[0] != '-') {
+ break;
+ }
+
+ if (Tcl_GetIndexFromObjStruct(NULL, objv[i], switchStrings,
+ sizeof(char *), "switch", 0, &index) != TCL_OK) {
+ /*
+ * Hide the -hidden option, generating the error description with
+ * the side effects of T_GIFO.
+ */
+
+ (void) Tcl_GetIndexFromObjStruct(interp, objv[i], switchStrings+1,
+ sizeof(char *), "switch", 0, &index);
+ return TCL_ERROR;
+ }
+
+ switch ((enum SearchSwitches) index) {
+ case SEARCH_END:
+ i++;
+ goto endOfSwitchProcessing;
+ case SEARCH_ALL:
+ searchSpec.all = 1;
+ break;
+ case SEARCH_BACK:
+ searchSpec.backwards = 1;
+ break;
+ case SEARCH_COUNT:
+ if (i >= objc-1) {
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "no value given for \"-count\" option", -1));
+ Tcl_SetErrorCode(interp, "TK", "TEXT", "VALUE", NULL);
+ return TCL_ERROR;
+ }
+ i++;
+
+ /*
+ * Assumption objv[i] isn't going to disappear on us during this
+ * function, which is fair.
+ */
+
+ searchSpec.varPtr = objv[i];
+ break;
+ case SEARCH_ELIDE:
+ case SEARCH_HIDDEN:
+ searchSpec.searchElide = 1;
+ break;
+ case SEARCH_EXACT:
+ searchSpec.exact = 1;
+ break;
+ case SEARCH_FWD:
+ searchSpec.backwards = 0;
+ break;
+ case SEARCH_NOCASE:
+ searchSpec.noCase = 1;
+ break;
+ case SEARCH_NOLINESTOP:
+ searchSpec.noLineStop = 1;
+ break;
+ case SEARCH_OVERLAP:
+ searchSpec.overlap = 1;
+ break;
+ case SEARCH_STRICTLIMITS:
+ searchSpec.strictLimits = 1;
+ break;
+ case SEARCH_REGEXP:
+ searchSpec.exact = 0;
+ break;
+ default:
+ Tcl_Panic("unexpected switch fallthrough");
+ }
+ }
+ endOfSwitchProcessing:
+
+ argsLeft = objc - (i+2);
+ if ((argsLeft != 0) && (argsLeft != 1)) {
+ Tcl_WrongNumArgs(interp, 2, objv,
+ "?switches? pattern index ?stopIndex?");
+ return TCL_ERROR;
+ }
+
+ if (searchSpec.noLineStop && searchSpec.exact) {
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "the \"-nolinestop\" option requires the \"-regexp\" option"
+ " to be present", -1));
+ Tcl_SetErrorCode(interp, "TK", "TEXT", "SEARCH_USAGE", NULL);
+ return TCL_ERROR;
+ }
+
+ if (searchSpec.overlap && !searchSpec.all) {
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "the \"-overlap\" option requires the \"-all\" option"
+ " to be present", -1));
+ Tcl_SetErrorCode(interp, "TK", "TEXT", "SEARCH_USAGE", NULL);
+ return TCL_ERROR;
+ }
+
+ /*
+ * Scan through all of the lines of the text circularly, starting at the
+ * given index. 'objv[i]' is the pattern which may be an exact string or a
+ * regexp pattern depending on the flags set above.
+ */
+
+ code = SearchPerform(interp, &searchSpec, objv[i], objv[i+1],
+ (argsLeft == 1 ? objv[i+2] : NULL));
+ if (code != TCL_OK) {
+ goto cleanup;
+ }
+
+ /*
+ * Set the '-count' variable, if given.
+ */
+
+ if (searchSpec.varPtr != NULL && searchSpec.countPtr != NULL) {
+ Tcl_IncrRefCount(searchSpec.countPtr);
+ if (Tcl_ObjSetVar2(interp, searchSpec.varPtr, NULL,
+ searchSpec.countPtr, TCL_LEAVE_ERR_MSG) == NULL) {
+ code = TCL_ERROR;
+ goto cleanup;
+ }
+ }
+
+ /*
+ * Set the result.
+ */
+
+ if (searchSpec.resPtr != NULL) {
+ Tcl_SetObjResult(interp, searchSpec.resPtr);
+ searchSpec.resPtr = NULL;
+ }
+
+ cleanup:
+ if (searchSpec.countPtr != NULL) {
+ Tcl_DecrRefCount(searchSpec.countPtr);
+ }
+ if (searchSpec.resPtr != NULL) {
+ Tcl_DecrRefCount(searchSpec.resPtr);
+ }
+ return code;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TextSearchGetLineIndex --
+ *
+ * Extract a row, text offset index position from an objPtr
+ *
+ * This means we ignore any embedded windows/images and elidden text
+ * (unless we are searching that).
+ *
+ * Results:
+ * Standard Tcl error code (with a message in the interpreter on error
+ * conditions).
+ *
+ * The offset placed in offsetPosPtr is a utf-8 char* byte index for
+ * exact searches, and a Unicode character index for regexp searches.
+ *
+ * The line number should start at zero (searches which wrap around
+ * assume the first line is numbered 0).
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+TextSearchGetLineIndex(
+ Tcl_Interp *interp, /* For error messages. */
+ Tcl_Obj *objPtr, /* Contains a textual index like "1.2" */
+ SearchSpec *searchSpecPtr, /* Contains other search parameters. */
+ int *linePosPtr, /* For returning the line number. */
+ int *offsetPosPtr) /* For returning the text offset in the
+ * line. */
+{
+ const TkTextIndex *indexPtr;
+ int line;
+ TkText *textPtr = searchSpecPtr->clientData;
+
+ indexPtr = TkTextGetIndexFromObj(interp, textPtr, objPtr);
+ if (indexPtr == NULL) {
+ return TCL_ERROR;
+ }
+
+ line = TkBTreeLinesTo(textPtr, indexPtr->linePtr);
+ if (line >= searchSpecPtr->numLines) {
+ TkTextLine *linePtr;
+ int count = 0;
+ TkTextSegment *segPtr;
+
+ line = searchSpecPtr->numLines-1;
+ linePtr = TkBTreeFindLine(textPtr->sharedTextPtr->tree, textPtr, line);
+
+ /*
+ * Count the number of bytes in this line.
+ */
+
+ for (segPtr=linePtr->segPtr ; segPtr!=NULL ; segPtr=segPtr->nextPtr) {
+ count += segPtr->size;
+ }
+ *offsetPosPtr = TextSearchIndexInLine(searchSpecPtr, linePtr, count);
+ } else {
+ *offsetPosPtr = TextSearchIndexInLine(searchSpecPtr,
+ indexPtr->linePtr, indexPtr->byteIndex);
+ }
+
+ *linePosPtr = line;
+
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TextSearchIndexInLine --
+ *
+ * Find textual index of 'byteIndex' in the searchable characters of
+ * 'linePtr'.
+ *
+ * This means we ignore any embedded windows/images and elidden text
+ * (unless we are searching that).
+ *
+ * Results:
+ * The returned index is a utf-8 char* byte index for exact searches, and
+ * a Unicode character index for regexp searches.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+TextSearchIndexInLine(
+ const SearchSpec *searchSpecPtr,
+ /* Search parameters. */
+ TkTextLine *linePtr, /* The line we're looking at. */
+ int byteIndex) /* Index into the line. */
+{
+ TkTextSegment *segPtr;
+ TkTextIndex curIndex;
+ int index, leftToScan;
+ TkText *textPtr = searchSpecPtr->clientData;
+
+ index = 0;
+ curIndex.tree = textPtr->sharedTextPtr->tree;
+ curIndex.linePtr = linePtr; curIndex.byteIndex = 0;
+ for (segPtr = linePtr->segPtr, leftToScan = byteIndex;
+ leftToScan > 0;
+ curIndex.byteIndex += segPtr->size, segPtr = segPtr->nextPtr) {
+ if ((segPtr->typePtr == &tkTextCharType) &&
+ (searchSpecPtr->searchElide
+ || !TkTextIsElided(textPtr, &curIndex, NULL))) {
+ if (leftToScan < segPtr->size) {
+ if (searchSpecPtr->exact) {
+ index += leftToScan;
+ } else {
+ index += Tcl_NumUtfChars(segPtr->body.chars, leftToScan);
+ }
+ } else if (searchSpecPtr->exact) {
+ index += segPtr->size;
+ } else {
+ index += Tcl_NumUtfChars(segPtr->body.chars, -1);
+ }
+ }
+ leftToScan -= segPtr->size;
+ }
+ return index;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TextSearchAddNextLine --
+ *
+ * Adds a line from the text widget to the object 'theLine'.
+ *
+ * Results:
+ * A pointer to the TkTextLine corresponding to the given line, or NULL
+ * if there was no available line.
+ *
+ * Also 'lenPtr' (if non-NULL) is filled in with the total length of
+ * 'theLine' (not just what we added to it, but the length including what
+ * was already in there). This is in bytes for an exact search and in
+ * chars for a regexp search.
+ *
+ * Also 'extraLinesPtr' (if non-NULL) will have its value incremented by
+ * 1 for each additional logical line we have added because a newline is
+ * elided (this will only ever happen if we have chosen not to search
+ * elided text, of course).
+ *
+ * Side effects:
+ * Memory may be allocated or re-allocated for theLine's string
+ * representation.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static ClientData
+TextSearchAddNextLine(
+ int lineNum, /* Line we must add. */
+ SearchSpec *searchSpecPtr, /* Search parameters. */
+ Tcl_Obj *theLine, /* Object to append to. */
+ int *lenPtr, /* For returning the total length. */
+ int *extraLinesPtr) /* If non-NULL, will have its value
+ * incremented by the number of additional
+ * logical lines which are merged into this
+ * one by newlines being elided. */
+{
+ TkTextLine *linePtr, *thisLinePtr;
+ TkTextIndex curIndex;
+ TkTextSegment *segPtr;
+ TkText *textPtr = searchSpecPtr->clientData;
+ int nothingYet = 1;
+
+ /*
+ * Extract the text from the line.
+ */
+
+ linePtr = TkBTreeFindLine(textPtr->sharedTextPtr->tree, textPtr, lineNum);
+ if (linePtr == NULL) {
+ return NULL;
+ }
+ curIndex.tree = textPtr->sharedTextPtr->tree;
+ thisLinePtr = linePtr;
+
+ while (thisLinePtr != NULL) {
+ int elideWraps = 0;
+
+ curIndex.linePtr = thisLinePtr;
+ curIndex.byteIndex = 0;
+ for (segPtr = thisLinePtr->segPtr; segPtr != NULL;
+ curIndex.byteIndex += segPtr->size, segPtr = segPtr->nextPtr) {
+ if (!searchSpecPtr->searchElide
+ && TkTextIsElided(textPtr, &curIndex, NULL)) {
+ /*
+ * If we reach the end of the logical line, and if we have at
+ * least one character in the string, then we continue
+ * wrapping to the next logical line. If there are no
+ * characters yet, then the entire line of characters is
+ * elided and there's no need to complicate matters by
+ * wrapping - we'll look at the next line in due course.
+ */
+
+ if (segPtr->nextPtr == NULL && !nothingYet) {
+ elideWraps = 1;
+ }
+ continue;
+ }
+ if (segPtr->typePtr != &tkTextCharType) {
+ continue;
+ }
+ Tcl_AppendToObj(theLine, segPtr->body.chars, segPtr->size);
+ nothingYet = 0;
+ }
+ if (!elideWraps) {
+ break;
+ }
+ lineNum++;
+ if (lineNum >= searchSpecPtr->numLines) {
+ break;
+ }
+ thisLinePtr = TkBTreeNextLine(textPtr, thisLinePtr);
+ if (thisLinePtr != NULL && extraLinesPtr != NULL) {
+ /*
+ * Tell our caller we have an extra line merged in.
+ */
+
+ *extraLinesPtr = (*extraLinesPtr) + 1;
+ }
+ }
+
+ /*
+ * If we're ignoring case, convert the line to lower case. There is no
+ * need to do this for regexp searches, since they handle a flag for this
+ * purpose.
+ */
+
+ if (searchSpecPtr->exact && searchSpecPtr->noCase) {
+ Tcl_SetObjLength(theLine, Tcl_UtfToLower(Tcl_GetString(theLine)));
+ }
+
+ if (lenPtr != NULL) {
+ if (searchSpecPtr->exact) {
+ (void)Tcl_GetString(theLine);
+ *lenPtr = theLine->length;
+ } else {
+ *lenPtr = Tcl_GetCharLength(theLine);
+ }
+ }
+ return linePtr;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TextSearchFoundMatch --
+ *
+ * Stores information from a successful search.
+ *
+ * Results:
+ * 1 if the information was stored, 0 if the position at which the match
+ * was found actually falls outside the allowable search region (and
+ * therefore the search is actually complete).
+ *
+ * Side effects:
+ * Memory may be allocated in the 'countPtr' and 'resPtr' fields of
+ * 'searchSpecPtr'. Each of those objects will have refCount zero and
+ * must eventually be freed or stored elsewhere as appropriate.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+TextSearchFoundMatch(
+ int lineNum, /* Line on which match was found. */
+ SearchSpec *searchSpecPtr, /* Search parameters. */
+ ClientData clientData, /* Token returned by the 'addNextLineProc',
+ * TextSearchAddNextLine. May be NULL, in
+ * which we case we must generate it (from
+ * lineNum). */
+ Tcl_Obj *theLine, /* Text from current line, only accessed for
+ * exact searches, and is allowed to be NULL
+ * for regexp searches. */
+ int matchOffset, /* Offset of found item in utf-8 bytes for
+ * exact search, Unicode chars for regexp. */
+ int matchLength) /* Length also in bytes/chars as per search
+ * type. */
+{
+ int numChars;
+ int leftToScan;
+ TkTextIndex curIndex, foundIndex;
+ TkTextSegment *segPtr;
+ TkTextLine *linePtr;
+ TkText *textPtr = searchSpecPtr->clientData;
+
+ if (lineNum == searchSpecPtr->stopLine) {
+ /*
+ * If the current index is on the wrong side of the stopIndex, then
+ * the item we just found is actually outside the acceptable range,
+ * and the search is over.
+ */
+
+ if (searchSpecPtr->backwards ^
+ (matchOffset >= searchSpecPtr->stopOffset)) {
+ return 0;
+ }
+ }
+
+ /*
+ * Calculate the character count, which may need augmenting if there are
+ * embedded windows or elidden text.
+ */
+
+ if (searchSpecPtr->exact) {
+ const char *startOfLine = Tcl_GetString(theLine);
+
+ numChars = Tcl_NumUtfChars(startOfLine + matchOffset, matchLength);
+ } else {
+ numChars = matchLength;
+ }
+
+ /*
+ * If we're using strict limits checking, ensure that the match with its
+ * full length fits inside the given range.
+ */
+
+ if (searchSpecPtr->strictLimits && lineNum == searchSpecPtr->stopLine) {
+ if (searchSpecPtr->backwards ^
+ ((matchOffset + numChars) > searchSpecPtr->stopOffset)) {
+ return 0;
+ }
+ }
+
+ /*
+ * The index information returned by the regular expression parser only
+ * considers textual information: it doesn't account for embedded windows,
+ * elided text (when we are not searching elided text) or any other
+ * non-textual info. Scan through the line's segments again to adjust both
+ * matchChar and matchCount.
+ *
+ * We will walk through the segments of this line until we have either
+ * reached the end of the match or we have reached the end of the line.
+ */
+
+ linePtr = clientData;
+ if (linePtr == NULL) {
+ linePtr = TkBTreeFindLine(textPtr->sharedTextPtr->tree, textPtr,
+ lineNum);
+ }
+
+ curIndex.tree = textPtr->sharedTextPtr->tree;
+
+ /*
+ * Find the starting point.
+ */
+
+ leftToScan = matchOffset;
+ while (1) {
+ curIndex.linePtr = linePtr;
+ curIndex.byteIndex = 0;
+
+ /*
+ * Note that we allow leftToScan to be zero because we want to skip
+ * over any preceding non-textual items.
+ */
+
+ for (segPtr = linePtr->segPtr; leftToScan >= 0 && segPtr;
+ segPtr = segPtr->nextPtr) {
+ if (segPtr->typePtr != &tkTextCharType) {
+ matchOffset += segPtr->size;
+ } else if (!searchSpecPtr->searchElide
+ && TkTextIsElided(textPtr, &curIndex, NULL)) {
+ if (searchSpecPtr->exact) {
+ matchOffset += segPtr->size;
+ } else {
+ matchOffset += Tcl_NumUtfChars(segPtr->body.chars, -1);
+ }
+ } else {
+ if (searchSpecPtr->exact) {
+ leftToScan -= segPtr->size;
+ } else {
+ leftToScan -= Tcl_NumUtfChars(segPtr->body.chars, -1);
+ }
+ }
+ curIndex.byteIndex += segPtr->size;
+ }
+ if (segPtr == NULL && leftToScan >= 0) {
+ /*
+ * This will only happen if we are eliding newlines.
+ */
+
+ linePtr = TkBTreeNextLine(textPtr, linePtr);
+ if (linePtr == NULL) {
+ /*
+ * If we reach the end of the text, we have a serious problem,
+ * unless there's actually nothing left to look for.
+ */
+
+ if (leftToScan == 0) {
+ break;
+ } else {
+ Tcl_Panic("Reached end of text in a match");
+ }
+ }
+
+ /*
+ * We've wrapped to the beginning of the next logical line, which
+ * has been merged with the previous one whose newline was elided.
+ */
+
+ lineNum++;
+ matchOffset = 0;
+ } else {
+ break;
+ }
+ }
+
+ /*
+ * Calculate and store the found index in the result.
+ */
+
+ if (searchSpecPtr->exact) {
+ TkTextMakeByteIndex(textPtr->sharedTextPtr->tree, textPtr, lineNum,
+ matchOffset, &foundIndex);
+ } else {
+ TkTextMakeCharIndex(textPtr->sharedTextPtr->tree, textPtr, lineNum,
+ matchOffset, &foundIndex);
+ }
+
+ if (searchSpecPtr->all) {
+ if (searchSpecPtr->resPtr == NULL) {
+ searchSpecPtr->resPtr = Tcl_NewObj();
+ }
+ Tcl_ListObjAppendElement(NULL, searchSpecPtr->resPtr,
+ TkTextNewIndexObj(textPtr, &foundIndex));
+ } else {
+ searchSpecPtr->resPtr = TkTextNewIndexObj(textPtr, &foundIndex);
+ }
+
+ /*
+ * Find the end point. Here 'leftToScan' could be negative already as a
+ * result of the above loop if the segment we reached spanned the start of
+ * the string. When we add matchLength it will become non-negative.
+ */
+
+ for (leftToScan += matchLength; leftToScan > 0;
+ curIndex.byteIndex += segPtr->size, segPtr = segPtr->nextPtr) {
+ if (segPtr == NULL) {
+ /*
+ * We are on the next line - this of course should only ever
+ * happen with searches which have matched across multiple lines.
+ */
+
+ linePtr = TkBTreeNextLine(textPtr, linePtr);
+ segPtr = linePtr->segPtr;
+ curIndex.linePtr = linePtr; curIndex.byteIndex = 0;
+ }
+ if (segPtr->typePtr != &tkTextCharType) {
+ /*
+ * Anything we didn't count in the search needs adding.
+ */
+
+ numChars += segPtr->size;
+ continue;
+ } else if (!searchSpecPtr->searchElide
+ && TkTextIsElided(textPtr, &curIndex, NULL)) {
+ numChars += Tcl_NumUtfChars(segPtr->body.chars, -1);
+ continue;
+ }
+ if (searchSpecPtr->exact) {
+ leftToScan -= segPtr->size;
+ } else {
+ leftToScan -= Tcl_NumUtfChars(segPtr->body.chars, -1);
+ }
+ }
+
+ /*
+ * Now store the count result, if it is wanted.
+ */
+
+ if (searchSpecPtr->varPtr != NULL) {
+ Tcl_Obj *tmpPtr = Tcl_NewIntObj(numChars);
+ if (searchSpecPtr->all) {
+ if (searchSpecPtr->countPtr == NULL) {
+ searchSpecPtr->countPtr = Tcl_NewObj();
+ }
+ Tcl_ListObjAppendElement(NULL, searchSpecPtr->countPtr, tmpPtr);
+ } else {
+ searchSpecPtr->countPtr = tmpPtr;
+ }
+ }
+ return 1;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkTextGetTabs --
+ *
+ * Parses a string description of a set of tab stops.
+ *
+ * Results:
+ * The return value is a pointer to a malloc'ed structure holding parsed
+ * information about the tab stops. If an error occurred then the return
+ * value is NULL and an error message is left in the interp's result.
+ *
+ * Side effects:
+ * Memory is allocated for the structure that is returned. It is up to
+ * the caller to free this structure when it is no longer needed.
+ *
+ *----------------------------------------------------------------------
+ */
+
+TkTextTabArray *
+TkTextGetTabs(
+ Tcl_Interp *interp, /* Used for error reporting. */
+ TkText *textPtr, /* Information about the text widget. */
+ Tcl_Obj *stringPtr) /* Description of the tab stops. See the text
+ * manual entry for details. */
+{
+ int objc, i, count;
+ Tcl_Obj **objv;
+ TkTextTabArray *tabArrayPtr;
+ TkTextTab *tabPtr;
+ Tcl_UniChar ch;
+ double prevStop, lastStop;
+ /*
+ * Map these strings to TkTextTabAlign values.
+ */
+ static const char *const tabOptionStrings[] = {
+ "left", "right", "center", "numeric", NULL
+ };
+
+ if (Tcl_ListObjGetElements(interp, stringPtr, &objc, &objv) != TCL_OK) {
+ return NULL;
+ }
+
+ /*
+ * First find out how many entries we need to allocate in the tab array.
+ */
+
+ count = 0;
+ for (i = 0; i < objc; i++) {
+ char c = Tcl_GetString(objv[i])[0];
+
+ if ((c != 'l') && (c != 'r') && (c != 'c') && (c != 'n')) {
+ count++;
+ }
+ }
+
+ /*
+ * Parse the elements of the list one at a time to fill in the array.
+ */
+
+ tabArrayPtr = ckalloc(sizeof(TkTextTabArray)
+ + (count - 1) * sizeof(TkTextTab));
+ tabArrayPtr->numTabs = 0;
+ prevStop = 0.0;
+ lastStop = 0.0;
+ for (i = 0, tabPtr = &tabArrayPtr->tabs[0]; i < objc; i++, tabPtr++) {
+ int index;
+
+ /*
+ * This will round fractional pixels above 0.5 upwards, and otherwise
+ * downwards, to find the right integer pixel position.
+ */
+
+ if (Tk_GetPixelsFromObj(interp, textPtr->tkwin, objv[i],
+ &tabPtr->location) != TCL_OK) {
+ goto error;
+ }
+
+ if (tabPtr->location <= 0) {
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "tab stop \"%s\" is not at a positive distance",
+ Tcl_GetString(objv[i])));
+ Tcl_SetErrorCode(interp, "TK", "VALUE", "TAB_STOP", NULL);
+ goto error;
+ }
+
+ prevStop = lastStop;
+ if (Tk_GetDoublePixelsFromObj(interp, textPtr->tkwin, objv[i],
+ &lastStop) != TCL_OK) {
+ goto error;
+ }
+
+ if (i > 0 && (tabPtr->location <= (tabPtr-1)->location)) {
+ /*
+ * This tab is actually to the left of the previous one, which is
+ * illegal.
+ */
+
+#ifdef _TK_ALLOW_DECREASING_TABS
+ /*
+ * Force the tab to be a typical character width to the right of
+ * the previous one, and update the 'lastStop' with the changed
+ * position.
+ */
+
+ if (textPtr->charWidth > 0) {
+ tabPtr->location = (tabPtr-1)->location + textPtr->charWidth;
+ } else {
+ tabPtr->location = (tabPtr-1)->location + 8;
+ }
+ lastStop = tabPtr->location;
+#else
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "tabs must be monotonically increasing, but \"%s\" is "
+ "smaller than or equal to the previous tab",
+ Tcl_GetString(objv[i])));
+ Tcl_SetErrorCode(interp, "TK", "VALUE", "TAB_STOP", NULL);
+ goto error;
+#endif /* _TK_ALLOW_DECREASING_TABS */
+ }
+
+ tabArrayPtr->numTabs++;
+
+ /*
+ * See if there is an explicit alignment in the next list element.
+ * Otherwise just use "left".
+ */
+
+ tabPtr->alignment = LEFT;
+ if ((i+1) == objc) {
+ continue;
+ }
+
+ /*
+ * There may be a more efficient way of getting this.
+ */
+
+ Tcl_UtfToUniChar(Tcl_GetString(objv[i+1]), &ch);
+ if (!Tcl_UniCharIsAlpha(ch)) {
+ continue;
+ }
+ i += 1;
+
+ if (Tcl_GetIndexFromObjStruct(interp, objv[i], tabOptionStrings,
+ sizeof(char *), "tab alignment", 0, &index) != TCL_OK) {
+ goto error;
+ }
+ tabPtr->alignment = (TkTextTabAlign) index;
+ }
+
+ /*
+ * For when we need to interpolate tab stops, store these two so we know
+ * the tab stop size to very high precision. With the above checks, we can
+ * guarantee that tabIncrement is strictly positive here.
+ */
+
+ tabArrayPtr->lastTab = lastStop;
+ tabArrayPtr->tabIncrement = lastStop - prevStop;
+
+ return tabArrayPtr;
+
+ error:
+ ckfree(tabArrayPtr);
+ return NULL;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TextDumpCmd --
+ *
+ * Return information about the text, tags, marks, and embedded windows
+ * and images in a text widget. See the man page for the description of
+ * the text dump operation for all the details.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * Memory is allocated for the result, if needed (standard Tcl result
+ * side effects).
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+TextDumpCmd(
+ register TkText *textPtr, /* Information about text widget. */
+ Tcl_Interp *interp, /* Current interpreter. */
+ int objc, /* Number of arguments. */
+ Tcl_Obj *const objv[]) /* Argument objects. Someone else has already
+ * parsed this command enough to know that
+ * objv[1] is "dump". */
+{
+ TkTextIndex index1, index2;
+ int arg;
+ int lineno; /* Current line number. */
+ int what = 0; /* bitfield to select segment types. */
+ int atEnd; /* True if dumping up to logical end. */
+ TkTextLine *linePtr;
+ Tcl_Obj *command = NULL; /* Script callback to apply to segments. */
+#define TK_DUMP_TEXT 0x1
+#define TK_DUMP_MARK 0x2
+#define TK_DUMP_TAG 0x4
+#define TK_DUMP_WIN 0x8
+#define TK_DUMP_IMG 0x10
+#define TK_DUMP_ALL (TK_DUMP_TEXT|TK_DUMP_MARK|TK_DUMP_TAG| \
+ TK_DUMP_WIN|TK_DUMP_IMG)
+ static const char *const optStrings[] = {
+ "-all", "-command", "-image", "-mark", "-tag", "-text", "-window",
+ NULL
+ };
+ enum opts {
+ DUMP_ALL, DUMP_CMD, DUMP_IMG, DUMP_MARK, DUMP_TAG, DUMP_TXT, DUMP_WIN
+ };
+
+ for (arg=2 ; arg < objc ; arg++) {
+ int index;
+ if (Tcl_GetString(objv[arg])[0] != '-') {
+ break;
+ }
+ if (Tcl_GetIndexFromObjStruct(interp, objv[arg], optStrings,
+ sizeof(char *), "option", 0, &index) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ switch ((enum opts) index) {
+ case DUMP_ALL:
+ what = TK_DUMP_ALL;
+ break;
+ case DUMP_TXT:
+ what |= TK_DUMP_TEXT;
+ break;
+ case DUMP_TAG:
+ what |= TK_DUMP_TAG;
+ break;
+ case DUMP_MARK:
+ what |= TK_DUMP_MARK;
+ break;
+ case DUMP_IMG:
+ what |= TK_DUMP_IMG;
+ break;
+ case DUMP_WIN:
+ what |= TK_DUMP_WIN;
+ break;
+ case DUMP_CMD:
+ arg++;
+ if (arg >= objc) {
+ goto wrongArgs;
+ }
+ command = objv[arg];
+ break;
+ default:
+ Tcl_Panic("unexpected switch fallthrough");
+ }
+ }
+ if (arg >= objc || arg+2 < objc) {
+ wrongArgs:
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "Usage: %s dump ?-all -image -text -mark -tag -window? "
+ "?-command script? index ?index2?", Tcl_GetString(objv[0])));
+ Tcl_SetErrorCode(interp, "TCL", "WRONGARGS", NULL);
+ return TCL_ERROR;
+ }
+ if (what == 0) {
+ what = TK_DUMP_ALL;
+ }
+ if (TkTextGetObjIndex(interp, textPtr, objv[arg], &index1) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ arg++;
+ atEnd = 0;
+ if (objc == arg) {
+ TkTextIndexForwChars(NULL, &index1, 1, &index2, COUNT_INDICES);
+ } else {
+ int length;
+ const char *str;
+
+ if (TkTextGetObjIndex(interp, textPtr, objv[arg], &index2) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ str = Tcl_GetString(objv[arg]);
+ length = objv[arg]->length;
+ if (strncmp(str, "end", (unsigned) length) == 0) {
+ atEnd = 1;
+ }
+ }
+ if (TkTextIndexCmp(&index1, &index2) >= 0) {
+ return TCL_OK;
+ }
+ lineno = TkBTreeLinesTo(textPtr, index1.linePtr);
+ if (index1.linePtr == index2.linePtr) {
+ DumpLine(interp, textPtr, what, index1.linePtr,
+ index1.byteIndex, index2.byteIndex, lineno, command);
+ } else {
+ int textChanged;
+ int lineend = TkBTreeLinesTo(textPtr, index2.linePtr);
+ int endByteIndex = index2.byteIndex;
+
+ textChanged = DumpLine(interp, textPtr, what, index1.linePtr,
+ index1.byteIndex, 32000000, lineno, command);
+ if (textChanged) {
+ if (textPtr->flags & DESTROYED) {
+ return TCL_OK;
+ }
+ linePtr = TkBTreeFindLine(textPtr->sharedTextPtr->tree,
+ textPtr, lineno);
+ textChanged = 0;
+ } else {
+ linePtr = index1.linePtr;
+ }
+ while ((linePtr = TkBTreeNextLine(textPtr, linePtr)) != NULL) {
+ lineno++;
+ if (lineno == lineend) {
+ break;
+ }
+ textChanged = DumpLine(interp, textPtr, what, linePtr, 0,
+ 32000000, lineno, command);
+ if (textChanged) {
+ if (textPtr->flags & DESTROYED) {
+ return TCL_OK;
+ }
+ linePtr = TkBTreeFindLine(textPtr->sharedTextPtr->tree,
+ textPtr, lineno);
+ textChanged = 0;
+ }
+ }
+ if (linePtr != NULL) {
+ DumpLine(interp, textPtr, what, linePtr, 0, endByteIndex, lineno,
+ command);
+ if (textPtr->flags & DESTROYED) {
+ return TCL_OK;
+ }
+ }
+ }
+
+ /*
+ * Special case to get the leftovers hiding at the end mark.
+ */
+
+ if (atEnd) {
+ if (textPtr->flags & DESTROYED) {
+ return TCL_OK;
+ }
+
+ /*
+ * Re-get the end index, in case it has changed.
+ */
+
+ if (TkTextGetObjIndex(interp, textPtr, objv[arg], &index2) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ DumpLine(interp, textPtr, what & ~TK_DUMP_TEXT, index2.linePtr,
+ 0, 1, lineno, command);
+ }
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * DumpLine
+ *
+ * Return information about a given text line from character position
+ * "start" up to, but not including, "end".
+ *
+ * Results:
+ * Returns 1 if the command callback made any changes to the text widget
+ * which will have invalidated internal structures such as TkTextSegment,
+ * TkTextIndex, pointers. Our caller can then take action to recompute
+ * such entities. Returns 0 otherwise.
+ *
+ * Side effects:
+ * None, but see DumpSegment which can have arbitrary side-effects
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+DumpLine(
+ Tcl_Interp *interp,
+ TkText *textPtr,
+ int what, /* Bit flags to select segment types. */
+ TkTextLine *linePtr, /* The current line. */
+ int startByte, int endByte, /* Byte range to dump. */
+ int lineno, /* Line number for indices dump. */
+ Tcl_Obj *command) /* Script to apply to the segment. */
+{
+ TkTextSegment *segPtr;
+ TkTextIndex index;
+ int offset = 0, textChanged = 0;
+
+ /*
+ * Must loop through line looking at its segments.
+ * character
+ * toggleOn, toggleOff
+ * mark
+ * image
+ * window
+ */
+
+ segPtr = linePtr->segPtr;
+ while ((offset < endByte) && (segPtr != NULL)) {
+ int lineChanged = 0;
+ int currentSize = segPtr->size;
+
+ if ((what & TK_DUMP_TEXT) && (segPtr->typePtr == &tkTextCharType) &&
+ (offset + currentSize > startByte)) {
+ int last = currentSize; /* Index of last char in seg. */
+ int first = 0; /* Index of first char in seg. */
+
+ if (offset + currentSize > endByte) {
+ last = endByte - offset;
+ }
+ if (startByte > offset) {
+ first = startByte - offset;
+ }
+ if (last != currentSize) {
+ /*
+ * To avoid modifying the string in place we copy over just
+ * the segment that we want. Since DumpSegment can modify the
+ * text, we could not confidently revert the modification
+ * here.
+ */
+
+ int length = last - first;
+ char *range = ckalloc(length + 1);
+
+ memcpy(range, segPtr->body.chars + first, length);
+ range[length] = '\0';
+
+ TkTextMakeByteIndex(textPtr->sharedTextPtr->tree, textPtr,
+ lineno, offset + first, &index);
+ lineChanged = DumpSegment(textPtr, interp, "text", range,
+ command, &index, what);
+ ckfree(range);
+ } else {
+ TkTextMakeByteIndex(textPtr->sharedTextPtr->tree, textPtr,
+ lineno, offset + first, &index);
+ lineChanged = DumpSegment(textPtr, interp, "text",
+ segPtr->body.chars + first, command, &index, what);
+ }
+ } else if ((offset >= startByte)) {
+ if ((what & TK_DUMP_MARK)
+ && (segPtr->typePtr == &tkTextLeftMarkType
+ || segPtr->typePtr == &tkTextRightMarkType)) {
+ const char *name;
+ TkTextMark *markPtr = &segPtr->body.mark;
+
+ if (segPtr == textPtr->insertMarkPtr) {
+ name = "insert";
+ } else if (segPtr == textPtr->currentMarkPtr) {
+ name = "current";
+ } else if (markPtr->hPtr == NULL) {
+ name = NULL;
+ lineChanged = 0;
+ } else {
+ name = Tcl_GetHashKey(&textPtr->sharedTextPtr->markTable,
+ markPtr->hPtr);
+ }
+ if (name != NULL) {
+ TkTextMakeByteIndex(textPtr->sharedTextPtr->tree, textPtr,
+ lineno, offset, &index);
+ lineChanged = DumpSegment(textPtr, interp, "mark", name,
+ command, &index, what);
+ }
+ } else if ((what & TK_DUMP_TAG) &&
+ (segPtr->typePtr == &tkTextToggleOnType)) {
+ TkTextMakeByteIndex(textPtr->sharedTextPtr->tree, textPtr,
+ lineno, offset, &index);
+ lineChanged = DumpSegment(textPtr, interp, "tagon",
+ segPtr->body.toggle.tagPtr->name, command, &index,
+ what);
+ } else if ((what & TK_DUMP_TAG) &&
+ (segPtr->typePtr == &tkTextToggleOffType)) {
+ TkTextMakeByteIndex(textPtr->sharedTextPtr->tree, textPtr,
+ lineno, offset, &index);
+ lineChanged = DumpSegment(textPtr, interp, "tagoff",
+ segPtr->body.toggle.tagPtr->name, command, &index,
+ what);
+ } else if ((what & TK_DUMP_IMG) &&
+ (segPtr->typePtr == &tkTextEmbImageType)) {
+ TkTextEmbImage *eiPtr = &segPtr->body.ei;
+ const char *name = (eiPtr->name == NULL) ? "" : eiPtr->name;
+
+ TkTextMakeByteIndex(textPtr->sharedTextPtr->tree, textPtr,
+ lineno, offset, &index);
+ lineChanged = DumpSegment(textPtr, interp, "image", name,
+ command, &index, what);
+ } else if ((what & TK_DUMP_WIN) &&
+ (segPtr->typePtr == &tkTextEmbWindowType)) {
+ TkTextEmbWindow *ewPtr = &segPtr->body.ew;
+ const char *pathname;
+
+ if (ewPtr->tkwin == (Tk_Window) NULL) {
+ pathname = "";
+ } else {
+ pathname = Tk_PathName(ewPtr->tkwin);
+ }
+ TkTextMakeByteIndex(textPtr->sharedTextPtr->tree, textPtr,
+ lineno, offset, &index);
+ lineChanged = DumpSegment(textPtr, interp, "window", pathname,
+ command, &index, what);
+ }
+ }
+
+ offset += currentSize;
+ if (lineChanged) {
+ TkTextSegment *newSegPtr;
+ int newOffset = 0;
+
+ textChanged = 1;
+
+ /*
+ * Our indices are no longer valid.
+ */
+
+ if (textPtr->flags & DESTROYED) {
+ return textChanged;
+ }
+ linePtr = TkBTreeFindLine(textPtr->sharedTextPtr->tree,
+ textPtr, lineno);
+ newSegPtr = linePtr->segPtr;
+ if (segPtr != newSegPtr) {
+ while ((newOffset < endByte) && (newOffset < offset)
+ && (newSegPtr != NULL)) {
+ newOffset += currentSize;
+ newSegPtr = newSegPtr->nextPtr;
+ if (segPtr == newSegPtr) {
+ break;
+ }
+ }
+ if (segPtr != newSegPtr && newOffset == offset
+ && currentSize == 0) {
+ TkTextSegment *searchPtr = newSegPtr;
+
+ while (searchPtr != NULL && searchPtr->size == 0) {
+ if (searchPtr == segPtr) {
+ newSegPtr = searchPtr;
+ break;
+ }
+ searchPtr = searchPtr->nextPtr;
+ }
+ }
+ segPtr = newSegPtr;
+ }
+ }
+ if (segPtr != NULL) {
+ segPtr = segPtr->nextPtr;
+ }
+ }
+ return textChanged;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * DumpSegment
+ *
+ * Either append information about the current segment to the result, or
+ * make a script callback with that information as arguments.
+ *
+ * Results:
+ * Returns 1 if the command callback made any changes to the text widget
+ * which will have invalidated internal structures such as TkTextSegment,
+ * TkTextIndex, pointers. Our caller can then take action to recompute
+ * such entities. Returns 0 otherwise.
+ *
+ * Side effects:
+ * Either evals the callback or appends elements to the result string.
+ * The callback can have arbitrary side-effects.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+DumpSegment(
+ TkText *textPtr,
+ Tcl_Interp *interp,
+ const char *key, /* Segment type key. */
+ const char *value, /* Segment value. */
+ Tcl_Obj *command, /* Script callback. */
+ const TkTextIndex *index, /* index with line/byte position info. */
+ int what) /* Look for TK_DUMP_INDEX bit. */
+{
+ char buffer[TK_POS_CHARS];
+ Tcl_Obj *values[3], *tuple;
+
+ TkTextPrintIndex(textPtr, index, buffer);
+ values[0] = Tcl_NewStringObj(key, -1);
+ values[1] = Tcl_NewStringObj(value, -1);
+ values[2] = Tcl_NewStringObj(buffer, -1);
+ tuple = Tcl_NewListObj(3, values);
+ if (command == NULL) {
+ Tcl_ListObjAppendList(NULL, Tcl_GetObjResult(interp), tuple);
+ Tcl_DecrRefCount(tuple);
+ return 0;
+ } else {
+ int oldStateEpoch = TkBTreeEpoch(textPtr->sharedTextPtr->tree);
+ Tcl_DString buf;
+ int code;
+
+ Tcl_DStringInit(&buf);
+ Tcl_DStringAppend(&buf, Tcl_GetString(command), -1);
+ Tcl_DStringAppend(&buf, " ", -1);
+ Tcl_DStringAppend(&buf, Tcl_GetString(tuple), -1);
+ code = Tcl_EvalEx(interp, Tcl_DStringValue(&buf), -1, 0);
+ Tcl_DStringFree(&buf);
+ if (code != TCL_OK) {
+ Tcl_AddErrorInfo(interp,
+ "\n (segment dumping command executed by text)");
+ Tcl_BackgroundException(interp, code);
+ }
+ Tcl_DecrRefCount(tuple);
+ return ((textPtr->flags & DESTROYED) ||
+ TkBTreeEpoch(textPtr->sharedTextPtr->tree) != oldStateEpoch);
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TextEditUndo --
+ *
+ * Undo the last change.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Apart from manipulating the undo and redo stacks, the state of the
+ * rest of the widget may also change (due to whatever is being undone).
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+TextEditUndo(
+ TkText *textPtr) /* Overall information about text widget. */
+{
+ int status;
+
+ if (!textPtr->sharedTextPtr->undo) {
+ return TCL_OK;
+ }
+
+ /*
+ * Turn off the undo feature while we revert a compound action, setting
+ * the dirty handling mode to undo for the duration (unless it is
+ * 'fixed').
+ */
+
+ textPtr->sharedTextPtr->undo = 0;
+ if (textPtr->sharedTextPtr->dirtyMode != TK_TEXT_DIRTY_FIXED) {
+ textPtr->sharedTextPtr->dirtyMode = TK_TEXT_DIRTY_UNDO;
+ }
+
+ status = TkUndoRevert(textPtr->sharedTextPtr->undoStack);
+
+ if (textPtr->sharedTextPtr->dirtyMode != TK_TEXT_DIRTY_FIXED) {
+ textPtr->sharedTextPtr->dirtyMode = TK_TEXT_DIRTY_NORMAL;
+ }
+ textPtr->sharedTextPtr->undo = 1;
+
+ return status;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TextEditRedo --
+ *
+ * Redo the last undone change.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Apart from manipulating the undo and redo stacks, the state of the
+ * rest of the widget may also change (due to whatever is being redone).
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+TextEditRedo(
+ TkText *textPtr) /* Overall information about text widget. */
+{
+ int status;
+
+ if (!textPtr->sharedTextPtr->undo) {
+ return TCL_OK;
+ }
+
+ /*
+ * Turn off the undo feature temporarily while we revert a previously
+ * undone compound action, setting the dirty handling mode to redo for the
+ * duration (unless it is 'fixed').
+ */
+
+ textPtr->sharedTextPtr->undo = 0;
+ if (textPtr->sharedTextPtr->dirtyMode != TK_TEXT_DIRTY_FIXED) {
+ textPtr->sharedTextPtr->dirtyMode = TK_TEXT_DIRTY_REDO;
+ }
+
+ status = TkUndoApply(textPtr->sharedTextPtr->undoStack);
+
+ if (textPtr->sharedTextPtr->dirtyMode != TK_TEXT_DIRTY_FIXED) {
+ textPtr->sharedTextPtr->dirtyMode = TK_TEXT_DIRTY_NORMAL;
+ }
+ textPtr->sharedTextPtr->undo = 1;
+ return status;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TextEditCmd --
+ *
+ * Handle the subcommands to "$text edit ...". See documentation for
+ * details.
+ *
+ * Results:
+ * None
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+TextEditCmd(
+ TkText *textPtr, /* Information about text widget. */
+ Tcl_Interp *interp, /* Current interpreter. */
+ int objc, /* Number of arguments. */
+ Tcl_Obj *const objv[]) /* Argument objects. */
+{
+ int index, setModified, oldModified;
+ int canRedo = 0;
+ int canUndo = 0;
+
+ static const char *const editOptionStrings[] = {
+ "canundo", "canredo", "modified", "redo", "reset", "separator",
+ "undo", NULL
+ };
+ enum editOptions {
+ EDIT_CANUNDO, EDIT_CANREDO, EDIT_MODIFIED, EDIT_REDO, EDIT_RESET,
+ EDIT_SEPARATOR, EDIT_UNDO
+ };
+
+ if (objc < 3) {
+ Tcl_WrongNumArgs(interp, 2, objv, "option ?arg ...?");
+ return TCL_ERROR;
+ }
+
+ if (Tcl_GetIndexFromObjStruct(interp, objv[2], editOptionStrings,
+ sizeof(char *), "edit option", 0, &index) != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ switch ((enum editOptions) index) {
+ case EDIT_CANREDO:
+ if (objc != 3) {
+ Tcl_WrongNumArgs(interp, 3, objv, NULL);
+ return TCL_ERROR;
+ }
+ if (textPtr->sharedTextPtr->undo) {
+ canRedo = TkUndoCanRedo(textPtr->sharedTextPtr->undoStack);
+ }
+ Tcl_SetObjResult(interp, Tcl_NewBooleanObj(canRedo));
+ break;
+ case EDIT_CANUNDO:
+ if (objc != 3) {
+ Tcl_WrongNumArgs(interp, 3, objv, NULL);
+ return TCL_ERROR;
+ }
+ if (textPtr->sharedTextPtr->undo) {
+ canUndo = TkUndoCanUndo(textPtr->sharedTextPtr->undoStack);
+ }
+ Tcl_SetObjResult(interp, Tcl_NewBooleanObj(canUndo));
+ break;
+ case EDIT_MODIFIED:
+ if (objc == 3) {
+ Tcl_SetObjResult(interp,
+ Tcl_NewBooleanObj(textPtr->sharedTextPtr->isDirty));
+ return TCL_OK;
+ } else if (objc != 4) {
+ Tcl_WrongNumArgs(interp, 3, objv, "?boolean?");
+ return TCL_ERROR;
+ } else if (Tcl_GetBooleanFromObj(interp, objv[3],
+ &setModified) != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ /*
+ * Set or reset the dirty info, and trigger a Modified event.
+ */
+
+ setModified = setModified ? 1 : 0;
+
+ oldModified = textPtr->sharedTextPtr->isDirty;
+ textPtr->sharedTextPtr->isDirty = setModified;
+ if (setModified) {
+ textPtr->sharedTextPtr->dirtyMode = TK_TEXT_DIRTY_FIXED;
+ } else {
+ textPtr->sharedTextPtr->dirtyMode = TK_TEXT_DIRTY_NORMAL;
+ }
+
+ /*
+ * Only issue the <<Modified>> event if the flag actually changed.
+ * However, degree of modified-ness doesn't matter. [Bug 1799782]
+ */
+
+ if ((!oldModified) != (!setModified)) {
+ GenerateModifiedEvent(textPtr);
+ }
+ break;
+ case EDIT_REDO:
+ if (objc != 3) {
+ Tcl_WrongNumArgs(interp, 3, objv, NULL);
+ return TCL_ERROR;
+ }
+ canUndo = TkUndoCanUndo(textPtr->sharedTextPtr->undoStack);
+ if (TextEditRedo(textPtr)) {
+ Tcl_SetObjResult(interp, Tcl_NewStringObj("nothing to redo", -1));
+ Tcl_SetErrorCode(interp, "TK", "TEXT", "NO_REDO", NULL);
+ return TCL_ERROR;
+ }
+ canRedo = TkUndoCanRedo(textPtr->sharedTextPtr->undoStack);
+ if (!canUndo || !canRedo) {
+ GenerateUndoStackEvent(textPtr);
+ }
+ break;
+ case EDIT_RESET:
+ if (objc != 3) {
+ Tcl_WrongNumArgs(interp, 3, objv, NULL);
+ return TCL_ERROR;
+ }
+ canUndo = TkUndoCanUndo(textPtr->sharedTextPtr->undoStack);
+ canRedo = TkUndoCanRedo(textPtr->sharedTextPtr->undoStack);
+ TkUndoClearStacks(textPtr->sharedTextPtr->undoStack);
+ if (canUndo || canRedo) {
+ GenerateUndoStackEvent(textPtr);
+ }
+ break;
+ case EDIT_SEPARATOR:
+ if (objc != 3) {
+ Tcl_WrongNumArgs(interp, 3, objv, NULL);
+ return TCL_ERROR;
+ }
+ TkUndoInsertUndoSeparator(textPtr->sharedTextPtr->undoStack);
+ break;
+ case EDIT_UNDO:
+ if (objc != 3) {
+ Tcl_WrongNumArgs(interp, 3, objv, NULL);
+ return TCL_ERROR;
+ }
+ canRedo = TkUndoCanRedo(textPtr->sharedTextPtr->undoStack);
+ if (TextEditUndo(textPtr)) {
+ Tcl_SetObjResult(interp, Tcl_NewStringObj("nothing to undo", -1));
+ Tcl_SetErrorCode(interp, "TK", "TEXT", "NO_UNDO", NULL);
+ return TCL_ERROR;
+ }
+ canUndo = TkUndoCanUndo(textPtr->sharedTextPtr->undoStack);
+ if (!canRedo || !canUndo) {
+ GenerateUndoStackEvent(textPtr);
+ }
+ break;
+ }
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TextGetText --
+ *
+ * Returns the text from indexPtr1 to indexPtr2, placing that text in a
+ * string object which is returned with a refCount of zero.
+ *
+ * Since the amount of text may potentially be several megabytes (e.g.
+ * in text editors built on the text widget), efficiency is very
+ * important. We may want to investigate the efficiency of the
+ * Tcl_AppendToObj more carefully (e.g. if we know we are going to be
+ * appending several thousand lines, we could attempt to pre-allocate a
+ * larger space).
+ *
+ * Also the result is built up as a utf-8 string, but, if we knew we
+ * wanted it as Unicode, we could potentially save a huge conversion by
+ * building it up as Unicode directly. This could be as simple as
+ * replacing Tcl_NewObj by Tcl_NewUnicodeObj.
+ *
+ * Results:
+ * Tcl_Obj of string type containing the specified text. If the
+ * visibleOnly flag is set to 1, then only those characters which are not
+ * elided will be returned. Otherwise (flag is 0) all characters in the
+ * given range are returned.
+ *
+ * Side effects:
+ * Memory will be allocated for the new object. Remember to free it if it
+ * isn't going to be stored appropriately.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static Tcl_Obj *
+TextGetText(
+ const TkText *textPtr, /* Information about text widget. */
+ const TkTextIndex *indexPtr1,
+ /* Get text from this index... */
+ const TkTextIndex *indexPtr2,
+ /* ...to this index. */
+ int visibleOnly) /* If non-zero, then only return non-elided
+ * characters. */
+{
+ TkTextIndex tmpIndex;
+ Tcl_Obj *resultPtr = Tcl_NewObj();
+
+ TkTextMakeByteIndex(indexPtr1->tree, textPtr,
+ TkBTreeLinesTo(textPtr, indexPtr1->linePtr),
+ indexPtr1->byteIndex, &tmpIndex);
+
+ if (TkTextIndexCmp(indexPtr1, indexPtr2) < 0) {
+ while (1) {
+ int offset;
+ TkTextSegment *segPtr = TkTextIndexToSeg(&tmpIndex, &offset);
+ int last = segPtr->size, last2;
+
+ if (tmpIndex.linePtr == indexPtr2->linePtr) {
+ /*
+ * The last line that was requested must be handled carefully,
+ * because we may need to break out of this loop in the middle
+ * of the line.
+ */
+
+ if (indexPtr2->byteIndex == tmpIndex.byteIndex) {
+ break;
+ }
+ last2 = indexPtr2->byteIndex - tmpIndex.byteIndex + offset;
+ if (last2 < last) {
+ last = last2;
+ }
+ }
+ if (segPtr->typePtr == &tkTextCharType &&
+ !(visibleOnly && TkTextIsElided(textPtr,&tmpIndex,NULL))){
+ Tcl_AppendToObj(resultPtr, segPtr->body.chars + offset,
+ last - offset);
+ }
+ TkTextIndexForwBytes(textPtr, &tmpIndex, last-offset, &tmpIndex);
+ }
+ }
+ return resultPtr;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * GenerateModifiedEvent --
+ *
+ * Send an event that the text was modified. This is equivalent to:
+ * event generate $textWidget <<Modified>>
+ * for all peers of $textWidget.
+ *
+ * Results:
+ * None
+ *
+ * Side effects:
+ * May force the text window into existence.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+GenerateModifiedEvent(
+ TkText *textPtr) /* Information about text widget. */
+{
+ for (textPtr = textPtr->sharedTextPtr->peers; textPtr != NULL;
+ textPtr = textPtr->next) {
+ Tk_MakeWindowExist(textPtr->tkwin);
+ TkSendVirtualEvent(textPtr->tkwin, "Modified", NULL);
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * GenerateUndoStackEvent --
+ *
+ * Send an event that the undo or redo stack became empty or unempty.
+ * This is equivalent to:
+ * event generate $textWidget <<UndoStack>>
+ * for all peers of $textWidget.
+ *
+ * Results:
+ * None
+ *
+ * Side effects:
+ * May force the text window (and all peers) into existence.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+GenerateUndoStackEvent(
+ TkText *textPtr) /* Information about text widget. */
+{
+ for (textPtr = textPtr->sharedTextPtr->peers; textPtr != NULL;
+ textPtr = textPtr->next) {
+ Tk_MakeWindowExist(textPtr->tkwin);
+ TkSendVirtualEvent(textPtr->tkwin, "UndoStack", NULL);
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * UpdateDirtyFlag --
+ *
+ * Updates the dirtyness of the text widget
+ *
+ * Results:
+ * None
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+UpdateDirtyFlag(
+ TkSharedText *sharedTextPtr)/* Information about text widget. */
+{
+ int oldDirtyFlag;
+
+ /*
+ * If we've been forced to be dirty, we stay dirty (until explicitly
+ * reset, of course).
+ */
+
+ if (sharedTextPtr->dirtyMode == TK_TEXT_DIRTY_FIXED) {
+ return;
+ }
+
+ if (sharedTextPtr->isDirty < 0
+ && sharedTextPtr->dirtyMode == TK_TEXT_DIRTY_NORMAL) {
+ /*
+ * If dirty flag is negative, only redo operations can make it zero
+ * again. If we do a normal operation, it can never become zero any
+ * more (other than by explicit reset).
+ */
+
+ sharedTextPtr->dirtyMode = TK_TEXT_DIRTY_FIXED;
+ return;
+ }
+
+ oldDirtyFlag = sharedTextPtr->isDirty;
+ if (sharedTextPtr->dirtyMode == TK_TEXT_DIRTY_UNDO) {
+ sharedTextPtr->isDirty--;
+ } else {
+ sharedTextPtr->isDirty++;
+ }
+
+ if (sharedTextPtr->isDirty == 0 || oldDirtyFlag == 0) {
+ GenerateModifiedEvent(sharedTextPtr->peers);
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * RunAfterSyncCmd --
+ *
+ * This function is called by the event loop and executes the command
+ * scheduled by [.text sync -command $cmd].
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Anything may happen, depending on $cmd contents.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+RunAfterSyncCmd(
+ ClientData clientData) /* Information about text widget. */
+{
+ register TkText *textPtr = (TkText *) clientData;
+ int code;
+
+ if ((textPtr->tkwin == NULL) || (textPtr->flags & DESTROYED)) {
+ /*
+ * The widget has been deleted. Don't do anything.
+ */
+
+ if (--textPtr->refCount == 0) {
+ ckfree((char *) textPtr);
+ }
+ return;
+ }
+
+ Tcl_Preserve((ClientData) textPtr->interp);
+ code = Tcl_EvalObjEx(textPtr->interp, textPtr->afterSyncCmd, TCL_EVAL_GLOBAL);
+ if (code == TCL_ERROR) {
+ Tcl_AddErrorInfo(textPtr->interp, "\n (text sync)");
+ Tcl_BackgroundError(textPtr->interp);
+ }
+ Tcl_Release((ClientData) textPtr->interp);
+ Tcl_DecrRefCount(textPtr->afterSyncCmd);
+ textPtr->afterSyncCmd = NULL;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * SearchPerform --
+ *
+ * Overall control of search process. Is given a pattern, a starting
+ * index and an ending index, and attempts to perform a search. This
+ * function is actually completely independent of Tk, and could in the
+ * future be split off.
+ *
+ * Results:
+ * Standard Tcl result code. In particular, if fromPtr or toPtr are not
+ * considered valid by the 'lineIndexProc', an error will be thrown and
+ * no search performed.
+ *
+ * Side effects:
+ * See 'SearchCore'.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+SearchPerform(
+ Tcl_Interp *interp, /* For error messages. */
+ SearchSpec *searchSpecPtr, /* Search parameters. */
+ Tcl_Obj *patObj, /* Contains an exact string or a regexp
+ * pattern. Must have a refCount > 0. */
+ Tcl_Obj *fromPtr, /* Contains information describing the first
+ * index. */
+ Tcl_Obj *toPtr) /* NULL or information describing the last
+ * index. */
+{
+ /*
+ * Find the starting line and starting offset (measured in Unicode chars
+ * for regexp search, utf-8 bytes for exact search).
+ */
+
+ if (searchSpecPtr->lineIndexProc(interp, fromPtr, searchSpecPtr,
+ &searchSpecPtr->startLine,
+ &searchSpecPtr->startOffset) != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ /*
+ * Find the optional end location, similarly.
+ */
+
+ if (toPtr != NULL) {
+ const TkTextIndex *indexToPtr, *indexFromPtr;
+ TkText *textPtr = searchSpecPtr->clientData;
+
+ indexToPtr = TkTextGetIndexFromObj(interp, textPtr, toPtr);
+ if (indexToPtr == NULL) {
+ return TCL_ERROR;
+ }
+ indexFromPtr = TkTextGetIndexFromObj(interp, textPtr, fromPtr);
+
+ /*
+ * Check for any empty search range here. It might be better in the
+ * future to embed that in SearchCore (whose default behaviour is to
+ * wrap when given a negative search range).
+ */
+
+ if (TkTextIndexCmp(indexFromPtr, indexToPtr) ==
+ (searchSpecPtr->backwards ? -1 : 1)) {
+ return TCL_OK;
+ }
+
+ if (searchSpecPtr->lineIndexProc(interp, toPtr, searchSpecPtr,
+ &searchSpecPtr->stopLine,
+ &searchSpecPtr->stopOffset) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ } else {
+ searchSpecPtr->stopLine = -1;
+ }
+
+ /*
+ * Scan through all of the lines of the text circularly, starting at the
+ * given index. 'patObj' is the pattern which may be an exact string or a
+ * regexp pattern depending on the flags in searchSpecPtr.
+ */
+
+ return SearchCore(interp, searchSpecPtr, patObj);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * SearchCore --
+ *
+ * The core of the search function. This function is actually completely
+ * independent of Tk, and could in the future be split off.
+ *
+ * The function assumes regexp-based searches operate on Unicode strings,
+ * and exact searches on utf-8 strings. Therefore the 'foundMatchProc'
+ * and 'addLineProc' need to be aware of this distinction.
+ *
+ * Results:
+ * Standard Tcl result code.
+ *
+ * Side effects:
+ * Only those of the 'searchSpecPtr->foundMatchProc' which is called
+ * whenever a match is found.
+ *
+ * Note that the way matching across multiple lines is implemented, we
+ * start afresh with each line we have available, even though we may
+ * already have examined the contents of that line (and further ones) if
+ * we were attempting a multi-line match using the previous line. This
+ * means there may be ways to speed this up a lot by not throwing away
+ * all the multi-line information one has accumulated. Profiling should
+ * be done to see where the bottlenecks lie before attempting this,
+ * however. We would also need to be very careful such optimisation keep
+ * within the specified search bounds.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+SearchCore(
+ Tcl_Interp *interp, /* For error messages. */
+ SearchSpec *searchSpecPtr, /* Search parameters. */
+ Tcl_Obj *patObj) /* Contains an exact string or a regexp
+ * pattern. Must have a refCount > 0. */
+{
+ /*
+ * For exact searches these are utf-8 char* offsets, for regexp searches
+ * they are Unicode char offsets.
+ */
+
+ int firstOffset, lastOffset, matchOffset, matchLength;
+ int passes;
+ int lineNum = searchSpecPtr->startLine;
+ int code = TCL_OK;
+ Tcl_Obj *theLine;
+ int alreadySearchOffset = -1;
+
+ const char *pattern = NULL; /* For exact searches only. */
+ int firstNewLine = -1; /* For exact searches only. */
+ Tcl_RegExp regexp = NULL; /* For regexp searches only. */
+
+ /*
+ * These items are for backward regexp searches only. They are for two
+ * purposes: to allow us to report backwards matches in the correct order,
+ * even though the implementation uses repeated forward searches; and to
+ * provide for overlap checking between backwards matches on different
+ * text lines.
+ */
+
+#define LOTS_OF_MATCHES 20
+ int matchNum = LOTS_OF_MATCHES;
+ int smArray[2 * LOTS_OF_MATCHES];
+ int *storeMatch = smArray;
+ int *storeLength = smArray + LOTS_OF_MATCHES;
+ int lastBackwardsLineMatch = -1;
+ int lastBackwardsMatchOffset = -1;
+
+ if (searchSpecPtr->exact) {
+ /*
+ * Convert the pattern to lower-case if we're supposed to ignore case.
+ */
+
+ if (searchSpecPtr->noCase) {
+ patObj = Tcl_DuplicateObj(patObj);
+
+ /*
+ * This can change the length of the string behind the object's
+ * back, so ensure it is correctly synchronised.
+ */
+
+ Tcl_SetObjLength(patObj, Tcl_UtfToLower(Tcl_GetString(patObj)));
+ }
+ } else {
+ /*
+ * Compile the regular expression. We want '^$' to match after and
+ * before \n respectively, so use the TCL_REG_NLANCH flag.
+ */
+
+ regexp = Tcl_GetRegExpFromObj(interp, patObj,
+ (searchSpecPtr->noCase ? TCL_REG_NOCASE : 0)
+ | (searchSpecPtr->noLineStop ? 0 : TCL_REG_NLSTOP)
+ | TCL_REG_ADVANCED | TCL_REG_CANMATCH | TCL_REG_NLANCH);
+ if (regexp == NULL) {
+ return TCL_ERROR;
+ }
+ }
+
+ /*
+ * For exact strings, we want to know where the first newline is, and we
+ * will also use this as a flag to test whether it is even possible to
+ * match the pattern on a single line. If not we will have to search
+ * across multiple lines.
+ */
+
+ if (searchSpecPtr->exact) {
+ const char *nl;
+
+ /*
+ * We only need to set the matchLength once for exact searches, and we
+ * do it here. It is also used below as the actual pattern length, so
+ * it has dual purpose.
+ */
+
+ pattern = Tcl_GetString(patObj);
+ matchLength = patObj->length;
+ nl = strchr(pattern, '\n');
+
+ /*
+ * If there is no newline, or it is the very end of the string, then
+ * we don't need any special treatment, since single-line matching
+ * will work fine.
+ */
+
+ if (nl != NULL && nl[1] != '\0') {
+ firstNewLine = (nl - pattern);
+ }
+ } else {
+ matchLength = 0; /* Only needed to prevent compiler warnings. */
+ }
+
+ /*
+ * Keep a reference here, so that we can be sure the object doesn't
+ * disappear behind our backs and invalidate its contents which we are
+ * using.
+ */
+
+ Tcl_IncrRefCount(patObj);
+
+ /*
+ * For building up the current line being checked.
+ */
+
+ theLine = Tcl_NewObj();
+ Tcl_IncrRefCount(theLine);
+
+ for (passes = 0; passes < 2; ) {
+ ClientData lineInfo;
+ int linesSearched = 1;
+ int extraLinesSearched = 0;
+
+ if (lineNum >= searchSpecPtr->numLines) {
+ /*
+ * Don't search the dummy last line of the text.
+ */
+
+ goto nextLine;
+ }
+
+ /*
+ * Extract the text from the line, storing its length in 'lastOffset'
+ * (in bytes if exact, chars if regexp), since obviously the length is
+ * the maximum offset at which it is possible to find something on
+ * this line, which is what 'lastOffset' represents.
+ */
+
+ lineInfo = searchSpecPtr->addLineProc(lineNum, searchSpecPtr, theLine,
+ &lastOffset, &linesSearched);
+
+ if (lineInfo == NULL) {
+ /*
+ * This should not happen, since 'lineNum' should be valid in the
+ * call above. However, let's try to be flexible and not cause a
+ * crash below.
+ */
+
+ goto nextLine;
+ }
+
+ if (lineNum == searchSpecPtr->stopLine && searchSpecPtr->backwards) {
+ firstOffset = searchSpecPtr->stopOffset;
+ } else {
+ firstOffset = 0;
+ }
+
+ if (alreadySearchOffset != -1) {
+ if (searchSpecPtr->backwards) {
+ if (alreadySearchOffset < lastOffset) {
+ lastOffset = alreadySearchOffset;
+ }
+ } else {
+ if (alreadySearchOffset > firstOffset) {
+ firstOffset = alreadySearchOffset;
+ }
+ }
+ alreadySearchOffset = -1;
+ }
+
+ if (lineNum == searchSpecPtr->startLine) {
+ /*
+ * The starting line is tricky: the first time we see it we check
+ * one part of the line, and the second pass through we check the
+ * other part of the line.
+ */
+
+ passes++;
+ if ((passes == 1) ^ searchSpecPtr->backwards) {
+ /*
+ * Forward search and first pass, or backward search and
+ * second pass.
+ *
+ * Only use the last part of the line.
+ */
+
+ if (searchSpecPtr->startOffset > firstOffset) {
+ firstOffset = searchSpecPtr->startOffset;
+ }
+ if ((firstOffset >= lastOffset)
+ && ((lastOffset != 0) || searchSpecPtr->exact)) {
+ goto nextLine;
+ }
+ } else {
+ /*
+ * Use only the first part of the line.
+ */
+
+ if (searchSpecPtr->startOffset < lastOffset) {
+ lastOffset = searchSpecPtr->startOffset;
+ }
+ }
+ }
+
+ /*
+ * Check for matches within the current line 'lineNum'. If so, and if
+ * we're searching backwards or for all matches, repeat the search
+ * until we find the last match in the line. The 'lastOffset' is one
+ * beyond the last position in the line at which a match is allowed to
+ * begin.
+ */
+
+ matchOffset = -1;
+
+ if (searchSpecPtr->exact) {
+ int maxExtraLines = 0;
+ const char *startOfLine = Tcl_GetString(theLine);
+
+ CLANG_ASSERT(pattern);
+ do {
+ Tcl_UniChar ch;
+ const char *p;
+ int lastFullLine = lastOffset;
+
+ if (firstNewLine == -1) {
+ if (searchSpecPtr->strictLimits
+ && (firstOffset + matchLength > lastOffset)) {
+ /*
+ * Not enough characters to match.
+ */
+
+ break;
+ }
+
+ /*
+ * Single line matching. We want to scan forwards or
+ * backwards as appropriate.
+ */
+
+ if (searchSpecPtr->backwards) {
+ /*
+ * Search back either from the previous match or from
+ * 'startOfLine + lastOffset - 1' until we find a
+ * match.
+ */
+
+ const char c = pattern[0];
+
+ if (alreadySearchOffset != -1) {
+ p = startOfLine + alreadySearchOffset;
+ alreadySearchOffset = -1;
+ } else {
+ p = startOfLine + lastOffset -1;
+ }
+ while (p >= startOfLine + firstOffset) {
+ if (p[0] == c && !strncmp(p, pattern,
+ (unsigned) matchLength)) {
+ goto backwardsMatch;
+ }
+ p--;
+ }
+ break;
+ } else {
+ p = strstr(startOfLine + firstOffset, pattern);
+ }
+ if (p == NULL) {
+ /*
+ * Single line match failed.
+ */
+
+ break;
+ }
+ } else if (firstNewLine >= (lastOffset - firstOffset)) {
+ /*
+ * Multi-line match, but not enough characters to match.
+ */
+
+ break;
+ } else {
+ /*
+ * Multi-line match has only one possible match position,
+ * because we know where the '\n' is.
+ */
+
+ p = startOfLine + lastOffset - firstNewLine - 1;
+ if (strncmp(p, pattern, (unsigned) firstNewLine + 1)) {
+ /*
+ * No match.
+ */
+
+ break;
+ } else {
+ int extraLines = 1;
+
+ /*
+ * If we find a match that overlaps more than one
+ * line, we will use this value to determine the first
+ * allowed starting offset for the following search
+ * (to avoid overlapping results).
+ */
+
+ int lastTotal = lastOffset;
+ int skipFirst = lastOffset - firstNewLine -1;
+
+ /*
+ * We may be able to match if given more text. The
+ * following 'while' block handles multi-line exact
+ * searches.
+ */
+
+ while (1) {
+ lastFullLine = lastTotal;
+
+ if (lineNum+extraLines>=searchSpecPtr->numLines) {
+ p = NULL;
+ break;
+ }
+
+ /*
+ * Only add the line if we haven't already done so
+ * already.
+ */
+
+ if (extraLines > maxExtraLines) {
+ if (searchSpecPtr->addLineProc(lineNum
+ + extraLines, searchSpecPtr, theLine,
+ &lastTotal, &extraLines) == NULL) {
+ p = NULL;
+ if (!searchSpecPtr->backwards) {
+ extraLinesSearched = extraLines;
+ }
+ break;
+ }
+ maxExtraLines = extraLines;
+ }
+
+ startOfLine = Tcl_GetString(theLine);
+ p = startOfLine + skipFirst;
+
+ /*
+ * Use the fact that 'matchLength = patLength' for
+ * exact searches.
+ */
+
+ if ((lastTotal - skipFirst) >= matchLength) {
+ /*
+ * We now have enough text to match, so we
+ * make a final test and break whatever the
+ * result.
+ */
+
+ if (strncmp(p,pattern,(unsigned)matchLength)) {
+ p = NULL;
+ }
+ break;
+ } else {
+ /*
+ * Not enough text yet, but check the prefix.
+ */
+
+ if (strncmp(p, pattern,
+ (unsigned)(lastTotal - skipFirst))) {
+ p = NULL;
+ break;
+ }
+
+ /*
+ * The prefix matches, so keep looking.
+ */
+ }
+ extraLines++;
+ }
+ /*
+ * If we reach here, with p != NULL, we've found a
+ * multi-line match, else we started a multi-match but
+ * didn't finish it off, so we go to the next line.
+ */
+
+ if (p == NULL) {
+ break;
+ }
+
+ /*
+ * We've found a multi-line match.
+ */
+
+ if (extraLines > 0) {
+ extraLinesSearched = extraLines - 1;
+ }
+ }
+ }
+
+ backwardsMatch:
+ if ((p - startOfLine) >= lastOffset) {
+ break;
+ }
+
+ /*
+ * Remember the match.
+ */
+
+ matchOffset = p - startOfLine;
+
+ if (searchSpecPtr->all &&
+ !searchSpecPtr->foundMatchProc(lineNum, searchSpecPtr,
+ lineInfo, theLine, matchOffset, matchLength)) {
+ /*
+ * We reached the end of the search.
+ */
+
+ goto searchDone;
+ }
+
+ if (!searchSpecPtr->overlap) {
+ if (searchSpecPtr->backwards) {
+ alreadySearchOffset = p - startOfLine;
+ if (firstNewLine != -1) {
+ break;
+ } else {
+ alreadySearchOffset -= matchLength;
+ }
+ } else {
+ firstOffset = p - startOfLine + matchLength;
+ if (firstOffset >= lastOffset) {
+ /*
+ * Now, we have to be careful not to find
+ * overlapping matches either on the same or
+ * following lines. Assume that if we did find
+ * something, it goes until the last extra line we
+ * added.
+ *
+ * We can break out of the loop, since we know no
+ * more will be found.
+ */
+
+ if (!searchSpecPtr->backwards) {
+ alreadySearchOffset =
+ firstOffset - lastFullLine;
+ break;
+ }
+ }
+ }
+ } else {
+ if (searchSpecPtr->backwards) {
+ alreadySearchOffset = p - startOfLine - 1;
+ if (alreadySearchOffset < 0) {
+ break;
+ }
+ } else {
+ firstOffset = p - startOfLine +
+ Tcl_UtfToUniChar(startOfLine+matchOffset,&ch);
+ }
+ }
+ } while (searchSpecPtr->all);
+ } else {
+ int maxExtraLines = 0;
+ int matches = 0;
+ int lastNonOverlap = -1;
+
+ do {
+ Tcl_RegExpInfo info;
+ int match;
+ int lastFullLine = lastOffset;
+
+ match = Tcl_RegExpExecObj(interp, regexp, theLine,
+ firstOffset, 1, (firstOffset>0 ? TCL_REG_NOTBOL : 0));
+ if (match < 0) {
+ code = TCL_ERROR;
+ goto searchDone;
+ }
+ Tcl_RegExpGetInfo(regexp, &info);
+
+ /*
+ * If we don't have a match, or if we do, but it extends to
+ * the end of the line, we must try to add more lines to get a
+ * full greedy match.
+ */
+
+ if (!match ||
+ ((info.extendStart == info.matches[0].start)
+ && (info.matches[0].end == lastOffset-firstOffset))) {
+ int extraLines = 0;
+ int prevFullLine;
+
+ /*
+ * If we find a match that overlaps more than one line, we
+ * will use this value to determine the first allowed
+ * starting offset for the following search (to avoid
+ * overlapping results).
+ */
+
+ int lastTotal = lastOffset;
+
+ if ((lastBackwardsLineMatch != -1)
+ && (lastBackwardsLineMatch == (lineNum + 1))) {
+ lastNonOverlap = lastTotal;
+ }
+
+ if (info.extendStart < 0) {
+ /*
+ * No multi-line match is possible.
+ */
+
+ break;
+ }
+
+ /*
+ * We may be able to match if given more text. The
+ * following 'while' block handles multi-line regexp
+ * searches.
+ */
+
+ while (1) {
+ prevFullLine = lastTotal;
+
+ /*
+ * Move firstOffset to first possible start.
+ */
+
+ if (!match) {
+ firstOffset += info.extendStart;
+ }
+ if (firstOffset >= lastOffset) {
+ /*
+ * We're being told that the only possible new
+ * match is starting after the end of the line.
+ * But, that is the next line which we will handle
+ * when we look at that line.
+ */
+
+ if (!match && !searchSpecPtr->backwards
+ && (firstOffset == 0)) {
+ extraLinesSearched = extraLines;
+ }
+ break;
+ }
+
+ if (lineNum + extraLines >= searchSpecPtr->numLines) {
+ break;
+ }
+
+ /*
+ * Add next line, provided we haven't already done so.
+ */
+
+ if (extraLines > maxExtraLines) {
+ if (searchSpecPtr->addLineProc(lineNum
+ + extraLines, searchSpecPtr, theLine,
+ &lastTotal, &extraLines) == NULL) {
+ /*
+ * There are no more acceptable lines, so we
+ * can say we have searched all of these.
+ */
+
+ if (!match && !searchSpecPtr->backwards) {
+ extraLinesSearched = extraLines;
+ }
+ break;
+ }
+
+ maxExtraLines = extraLines;
+ if ((lastBackwardsLineMatch != -1)
+ && (lastBackwardsLineMatch
+ == (lineNum + extraLines + 1))) {
+ lastNonOverlap = lastTotal;
+ }
+ }
+
+ match = Tcl_RegExpExecObj(interp, regexp, theLine,
+ firstOffset, 1,
+ ((firstOffset > 0) ? TCL_REG_NOTBOL : 0));
+ if (match < 0) {
+ code = TCL_ERROR;
+ goto searchDone;
+ }
+ Tcl_RegExpGetInfo(regexp, &info);
+
+ /*
+ * Unfortunately there are bugs in Tcl's regexp
+ * library, which tells us that info.extendStart is
+ * zero when it should not be (should be -1), which
+ * makes our task a bit more complicated here. We
+ * check if there was a match, and the end of the
+ * match leaves an entire extra line unmatched, then
+ * we stop searching. Clearly it still might sometimes
+ * be possible to add more text and match again, but
+ * Tcl's regexp library doesn't tell us that.
+ *
+ * This means we often add and search one more line
+ * than might be necessary if Tcl were able to give us
+ * a correct value of info.extendStart under all
+ * circumstances.
+ */
+
+ if ((match &&
+ firstOffset+info.matches[0].end != lastTotal &&
+ firstOffset+info.matches[0].end < prevFullLine)
+ || info.extendStart < 0) {
+ break;
+ }
+
+ /*
+ * If there is a match, but that match starts after
+ * the end of the first line, then we'll handle that
+ * next time around, when we're actually looking at
+ * that line.
+ */
+
+ if (match && (info.matches[0].start >= lastOffset)) {
+ break;
+ }
+ if (match && ((firstOffset + info.matches[0].end)
+ >= prevFullLine)) {
+ if (extraLines > 0) {
+ extraLinesSearched = extraLines - 1;
+ }
+ lastFullLine = prevFullLine;
+ }
+
+ /*
+ * The prefix matches, so keep looking.
+ */
+
+ extraLines++;
+ }
+
+ /*
+ * If we reach here with 'match == 1', we've found a
+ * multi-line match, which we will record in the code
+ * which follows directly else we started a multi-line
+ * match but didn't finish it off, so we go to the next
+ * line.
+ */
+
+ if (!match) {
+ /*
+ * Here is where we could perform an optimisation,
+ * since we have already retrieved the contents of the
+ * next line (perhaps many more), so we shouldn't
+ * really throw it all away and start again. This
+ * could be particularly important for complex regexp
+ * searches.
+ *
+ * This 'break' will take us to just before the
+ * 'nextLine:' below.
+ */
+
+ break;
+ }
+
+ if (lastBackwardsLineMatch != -1) {
+ if ((lineNum + linesSearched + extraLinesSearched)
+ == lastBackwardsLineMatch) {
+ /*
+ * Possible overlap or inclusion.
+ */
+
+ int thisOffset = firstOffset + info.matches[0].end
+ - info.matches[0].start;
+
+ if (lastNonOverlap != -1) {
+ /*
+ * Possible overlap or enclosure.
+ */
+
+ if (thisOffset-lastNonOverlap >=
+ lastBackwardsMatchOffset+matchLength){
+ /*
+ * Totally encloses previous match, so
+ * forget the previous match.
+ */
+
+ lastBackwardsLineMatch = -1;
+ } else if ((thisOffset - lastNonOverlap)
+ > lastBackwardsMatchOffset) {
+ /*
+ * Overlap. Previous match is ok, and the
+ * current match is only ok if we are
+ * searching with -overlap.
+ */
+
+ if (searchSpecPtr->overlap) {
+ goto recordBackwardsMatch;
+ } else {
+ match = 0;
+ break;
+ }
+ } else {
+ /*
+ * No overlap, although the same line was
+ * reached.
+ */
+
+ goto recordBackwardsMatch;
+ }
+ } else {
+ /*
+ * No overlap.
+ */
+
+ goto recordBackwardsMatch;
+ }
+ } else if (lineNum+linesSearched+extraLinesSearched
+ < lastBackwardsLineMatch) {
+ /*
+ * No overlap.
+ */
+
+ goto recordBackwardsMatch;
+ } else {
+ /*
+ * Totally enclosed.
+ */
+
+ lastBackwardsLineMatch = -1;
+ }
+ }
+
+ } else {
+ /*
+ * Matched in a single line.
+ */
+
+ if (lastBackwardsLineMatch != -1) {
+ recordBackwardsMatch:
+ searchSpecPtr->foundMatchProc(lastBackwardsLineMatch,
+ searchSpecPtr, NULL, NULL,
+ lastBackwardsMatchOffset, matchLength);
+ lastBackwardsLineMatch = -1;
+ if (!searchSpecPtr->all) {
+ goto searchDone;
+ }
+ }
+ }
+
+ firstOffset += info.matches[0].start;
+ if (firstOffset >= lastOffset) {
+ break;
+ }
+
+ /*
+ * Update our local variables with the match, if we haven't
+ * yet found anything, or if we're doing '-all' or
+ * '-backwards' _and_ this match isn't fully enclosed in the
+ * previous match.
+ */
+
+ if (matchOffset == -1 ||
+ ((searchSpecPtr->all || searchSpecPtr->backwards)
+ && ((firstOffset < matchOffset)
+ || ((firstOffset + info.matches[0].end
+ - info.matches[0].start)
+ > (matchOffset + matchLength))))) {
+
+ matchOffset = firstOffset;
+ matchLength = info.matches[0].end - info.matches[0].start;
+
+ if (searchSpecPtr->backwards) {
+ /*
+ * To get backwards searches in the correct order, we
+ * must store them away here.
+ */
+
+ if (matches == matchNum) {
+ /*
+ * We've run out of space in our normal store, so
+ * we must allocate space for these backwards
+ * matches on the heap.
+ */
+
+ int *newArray =
+ ckalloc(4 * matchNum * sizeof(int));
+ memcpy(newArray, storeMatch, matchNum*sizeof(int));
+ memcpy(newArray + 2*matchNum, storeLength,
+ matchNum * sizeof(int));
+ if (storeMatch != smArray) {
+ ckfree(storeMatch);
+ }
+ matchNum *= 2;
+ storeMatch = newArray;
+ storeLength = newArray + matchNum;
+ }
+ storeMatch[matches] = matchOffset;
+ storeLength[matches] = matchLength;
+ matches++;
+ } else {
+ /*
+ * Now actually record the match, but only if we are
+ * doing an '-all' search.
+ */
+
+ if (searchSpecPtr->all &&
+ !searchSpecPtr->foundMatchProc(lineNum,
+ searchSpecPtr, lineInfo, theLine, matchOffset,
+ matchLength)) {
+ /*
+ * We reached the end of the search.
+ */
+
+ goto searchDone;
+ }
+ }
+
+ /*
+ * For forward matches, unless we allow overlaps, we move
+ * this on by the length of the current match so that we
+ * explicitly disallow overlapping matches.
+ */
+
+ if (matchLength > 0 && !searchSpecPtr->overlap
+ && !searchSpecPtr->backwards) {
+ firstOffset += matchLength;
+ if (firstOffset >= lastOffset) {
+ /*
+ * Now, we have to be careful not to find
+ * overlapping matches either on the same or
+ * following lines. Assume that if we did find
+ * something, it goes until the last extra line we
+ * added.
+ *
+ * We can break out of the loop, since we know no
+ * more will be found.
+ */
+
+ alreadySearchOffset = firstOffset - lastFullLine;
+ break;
+ }
+
+ /*
+ * We'll add this on again just below.
+ */
+
+ firstOffset --;
+ }
+ }
+
+ /*
+ * Move the starting point on, in case we are doing repeated
+ * or backwards searches (for the latter, we actually do
+ * repeated forward searches).
+ */
+
+ firstOffset++;
+ } while (searchSpecPtr->backwards || searchSpecPtr->all);
+
+ if (matches > 0) {
+ /*
+ * Now we have all the matches in our array, but not stored
+ * with 'foundMatchProc' yet.
+ */
+
+ matches--;
+ matchOffset = storeMatch[matches];
+ matchLength = storeLength[matches];
+ while (--matches >= 0) {
+ if (lineNum == searchSpecPtr->stopLine) {
+ /*
+ * It appears as if a condition like:
+ *
+ * if (storeMatch[matches]<searchSpecPtr->stopOffset)
+ * break;
+ *
+ * might be needed here, but no test case has been
+ * found which would exercise such a problem.
+ */
+ }
+ if (storeMatch[matches] + storeLength[matches]
+ >= matchOffset + matchLength) {
+ /*
+ * The new match totally encloses the previous one, so
+ * we overwrite the previous one.
+ */
+
+ matchOffset = storeMatch[matches];
+ matchLength = storeLength[matches];
+ continue;
+ }
+ if (!searchSpecPtr->overlap) {
+ if (storeMatch[matches] + storeLength[matches]
+ > matchOffset) {
+ continue;
+ }
+ }
+ searchSpecPtr->foundMatchProc(lineNum, searchSpecPtr,
+ lineInfo, theLine, matchOffset, matchLength);
+ if (!searchSpecPtr->all) {
+ goto searchDone;
+ }
+ matchOffset = storeMatch[matches];
+ matchLength = storeLength[matches];
+ }
+ if (searchSpecPtr->all && matches > 0) {
+ /*
+ * We only need to do this for the '-all' case, because
+ * just below we will call the foundMatchProc for the
+ * non-all case.
+ */
+
+ searchSpecPtr->foundMatchProc(lineNum, searchSpecPtr,
+ lineInfo, theLine, matchOffset, matchLength);
+ } else {
+ lastBackwardsLineMatch = lineNum;
+ lastBackwardsMatchOffset = matchOffset;
+ }
+ }
+ }
+
+ /*
+ * If the 'all' flag is set, we will already have stored all matches,
+ * so we just proceed to the next line.
+ *
+ * If not, and there is a match we need to store that information and
+ * we are done.
+ */
+
+ if ((lastBackwardsLineMatch == -1) && (matchOffset >= 0)
+ && !searchSpecPtr->all) {
+ searchSpecPtr->foundMatchProc(lineNum, searchSpecPtr, lineInfo,
+ theLine, matchOffset, matchLength);
+ goto searchDone;
+ }
+
+ /*
+ * Go to the next (or previous) line;
+ */
+
+ nextLine:
+ linesSearched += extraLinesSearched;
+
+ while (linesSearched-- > 0) {
+ /*
+ * If we have just completed the 'stopLine', we are done.
+ */
+
+ if (lineNum == searchSpecPtr->stopLine) {
+ goto searchDone;
+ }
+
+ if (searchSpecPtr->backwards) {
+ lineNum--;
+
+ if (lastBackwardsLineMatch != -1
+ && ((lineNum < 0)
+ || (lineNum + 2 < lastBackwardsLineMatch))) {
+ searchSpecPtr->foundMatchProc(lastBackwardsLineMatch,
+ searchSpecPtr, NULL, NULL,
+ lastBackwardsMatchOffset, matchLength);
+ lastBackwardsLineMatch = -1;
+ if (!searchSpecPtr->all) {
+ goto searchDone;
+ }
+ }
+
+ if (lineNum < 0) {
+ lineNum = searchSpecPtr->numLines-1;
+ }
+ if (!searchSpecPtr->exact) {
+ /*
+ * The 'exact' search loops above are designed to give us
+ * an accurate picture of the number of lines which we can
+ * skip here. For 'regexp' searches, on the other hand,
+ * which can match potentially variable lengths, we cannot
+ * skip multiple lines when searching backwards. Therefore
+ * we only allow one line to be skipped here.
+ */
+
+ break;
+ }
+ } else {
+ lineNum++;
+ if (lineNum >= searchSpecPtr->numLines) {
+ lineNum = 0;
+ }
+ }
+ if (lineNum == searchSpecPtr->startLine && linesSearched > 0) {
+ /*
+ * We've just searched all the way round and have gone right
+ * through the start line without finding anything in the last
+ * attempt.
+ */
+
+ break;
+ }
+ }
+
+ Tcl_SetObjLength(theLine, 0);
+ }
+ searchDone:
+
+ if (lastBackwardsLineMatch != -1) {
+ searchSpecPtr->foundMatchProc(lastBackwardsLineMatch, searchSpecPtr,
+ NULL, NULL, lastBackwardsMatchOffset, matchLength);
+ }
+
+ /*
+ * Free up the cached line and pattern.
+ */
+
+ Tcl_DecrRefCount(theLine);
+ Tcl_DecrRefCount(patObj);
+
+ /*
+ * Free up any extra space we allocated.
+ */
+
+ if (storeMatch != smArray) {
+ ckfree(storeMatch);
+ }
+
+ return code;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * GetLineStartEnd -
+ *
+ * Converts an internal TkTextLine ptr into a Tcl string obj containing
+ * the line number. (Handler for the 'line' configuration option type.)
+ *
+ * Results:
+ * Tcl_Obj containing the string representation of the line value.
+ *
+ * Side effects:
+ * Creates a new Tcl_Obj.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static Tcl_Obj *
+GetLineStartEnd(
+ ClientData clientData,
+ Tk_Window tkwin,
+ char *recordPtr, /* Pointer to widget record. */
+ int internalOffset) /* Offset within *recordPtr containing the
+ * line value. */
+{
+ TkTextLine *linePtr = *(TkTextLine **)(recordPtr + internalOffset);
+
+ if (linePtr == NULL) {
+ return Tcl_NewObj();
+ }
+ return Tcl_NewIntObj(1 + TkBTreeLinesTo(NULL, linePtr));
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * SetLineStartEnd --
+ *
+ * Converts a Tcl_Obj representing a widget's (start or end) line into a
+ * TkTextLine* value. (Handler for the 'line' configuration option type.)
+ *
+ * Results:
+ * Standard Tcl result.
+ *
+ * Side effects:
+ * May store the TkTextLine* value into the internal representation
+ * pointer. May change the pointer to the Tcl_Obj to NULL to indicate
+ * that the specified string was empty and that is acceptable.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+SetLineStartEnd(
+ ClientData clientData,
+ Tcl_Interp *interp, /* Current interp; may be used for errors. */
+ Tk_Window tkwin, /* Window for which option is being set. */
+ Tcl_Obj **value, /* Pointer to the pointer to the value object.
+ * We use a pointer to the pointer because we
+ * may need to return a value (NULL). */
+ char *recordPtr, /* Pointer to storage for the widget record. */
+ int internalOffset, /* Offset within *recordPtr at which the
+ * internal value is to be stored. */
+ char *oldInternalPtr, /* Pointer to storage for the old value. */
+ int flags) /* Flags for the option, set Tk_SetOptions. */
+{
+ TkTextLine *linePtr = NULL;
+ char *internalPtr;
+ TkText *textPtr = (TkText *) recordPtr;
+
+ if (internalOffset >= 0) {
+ internalPtr = recordPtr + internalOffset;
+ } else {
+ internalPtr = NULL;
+ }
+
+ if (flags & TK_OPTION_NULL_OK && ObjectIsEmpty(*value)) {
+ *value = NULL;
+ } else {
+ int line;
+
+ if (Tcl_GetIntFromObj(interp, *value, &line) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ linePtr = TkBTreeFindLine(textPtr->sharedTextPtr->tree, NULL, line-1);
+ }
+
+ if (internalPtr != NULL) {
+ *((TkTextLine **) oldInternalPtr) = *((TkTextLine **) internalPtr);
+ *((TkTextLine **) internalPtr) = linePtr;
+ }
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * RestoreLineStartEnd --
+ *
+ * Restore a line option value from a saved value. (Handler for the
+ * 'line' configuration option type.)
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Restores the old value.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+RestoreLineStartEnd(
+ ClientData clientData,
+ Tk_Window tkwin,
+ char *internalPtr, /* Pointer to storage for value. */
+ char *oldInternalPtr) /* Pointer to old value. */
+{
+ *(TkTextLine **)internalPtr = *(TkTextLine **)oldInternalPtr;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ObjectIsEmpty --
+ *
+ * This function tests whether the string value of an object is empty.
+ *
+ * Results:
+ * The return value is 1 if the string value of objPtr has length zero,
+ * and 0 otherwise.
+ *
+ * Side effects:
+ * May cause object shimmering, since this function can force a
+ * conversion to a string object.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+ObjectIsEmpty(
+ Tcl_Obj *objPtr) /* Object to test. May be NULL. */
+{
+ if (objPtr == NULL) {
+ return 1;
+ }
+ if (objPtr->bytes != NULL) {
+ return (objPtr->length == 0);
+ }
+ (void)Tcl_GetString(objPtr);
+ return (objPtr->length == 0);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkpTesttextCmd --
+ *
+ * This function 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.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TkpTesttextCmd(
+ ClientData clientData, /* Main window for application. */
+ Tcl_Interp *interp, /* Current interpreter. */
+ int objc, /* Number of arguments. */
+ Tcl_Obj *const objv[]) /* Argument strings. */
+{
+ TkText *textPtr;
+ size_t len;
+ int lineIndex, byteIndex, byteOffset;
+ TkTextIndex index;
+ char buf[64];
+ Tcl_CmdInfo info;
+
+ if (objc < 3) {
+ return TCL_ERROR;
+ }
+
+ if (Tcl_GetCommandInfo(interp, Tcl_GetString(objv[1]), &info) == 0) {
+ return TCL_ERROR;
+ }
+ textPtr = info.objClientData;
+ len = strlen(Tcl_GetString(objv[2]));
+ if (strncmp(Tcl_GetString(objv[2]), "byteindex", len) == 0) {
+ if (objc != 5) {
+ return TCL_ERROR;
+ }
+ lineIndex = atoi(Tcl_GetString(objv[3])) - 1;
+ byteIndex = atoi(Tcl_GetString(objv[4]));
+
+ TkTextMakeByteIndex(textPtr->sharedTextPtr->tree, textPtr, lineIndex,
+ byteIndex, &index);
+ } else if (strncmp(Tcl_GetString(objv[2]), "forwbytes", len) == 0) {
+ if (objc != 5) {
+ return TCL_ERROR;
+ }
+ if (TkTextGetIndex(interp, textPtr, Tcl_GetString(objv[3]), &index) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ byteOffset = atoi(Tcl_GetString(objv[4]));
+ TkTextIndexForwBytes(textPtr, &index, byteOffset, &index);
+ } else if (strncmp(Tcl_GetString(objv[2]), "backbytes", len) == 0) {
+ if (objc != 5) {
+ return TCL_ERROR;
+ }
+ if (TkTextGetIndex(interp, textPtr, Tcl_GetString(objv[3]), &index) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ byteOffset = atoi(Tcl_GetString(objv[4]));
+ TkTextIndexBackBytes(textPtr, &index, byteOffset, &index);
+ } else {
+ return TCL_ERROR;
+ }
+
+ TkTextSetMark(textPtr, "insert", &index);
+ TkTextPrintIndex(textPtr, &index, buf);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf("%s %d", buf, index.byteIndex));
+ return TCL_OK;
+}
+
+/*
+ * Local Variables:
+ * mode: c
+ * c-basic-offset: 4
+ * fill-column: 78
+ * End:
+ */
diff --git a/tk8.6/generic/tkText.h b/tk8.6/generic/tkText.h
new file mode 100644
index 0000000..5d88784
--- /dev/null
+++ b/tk8.6/generic/tkText.h
@@ -0,0 +1,1171 @@
+/*
+ * tkText.h --
+ *
+ * Declarations shared among the files that implement text widgets.
+ *
+ * Copyright (c) 1992-1994 The Regents of the University of California.
+ * Copyright (c) 1994-1995 Sun Microsystems, Inc.
+ *
+ * See the file "license.terms" for information on usage and redistribution of
+ * this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ */
+
+#ifndef _TKTEXT
+#define _TKTEXT
+
+#ifndef _TK
+#include "tk.h"
+#endif
+
+#ifndef _TKUNDO
+#include "tkUndo.h"
+#endif
+
+/*
+ * The data structure below defines a single logical line of text (from
+ * newline to newline, not necessarily what appears on one display line of the
+ * screen).
+ */
+
+typedef struct TkTextLine {
+ struct Node *parentPtr; /* Pointer to parent node containing line. */
+ struct TkTextLine *nextPtr; /* Next in linked list of lines with same
+ * parent node in B-tree. NULL means end of
+ * list. */
+ struct TkTextSegment *segPtr;
+ /* First in ordered list of segments that make
+ * up the line. */
+ int *pixels; /* Array containing two integers for each
+ * referring text widget. The first of these
+ * is the number of vertical pixels taken up
+ * by this line, whether currently displayed
+ * or not. This number is only updated
+ * asychronously. The second of these is the
+ * last epoch at which the pixel height was
+ * recalculated. */
+} TkTextLine;
+
+/*
+ * -----------------------------------------------------------------------
+ * Segments: each line is divided into one or more segments, where each
+ * segment is one of several things, such as a group of characters, a tag
+ * toggle, a mark, or an embedded widget. Each segment starts with a standard
+ * header followed by a body that varies from type to type.
+ * -----------------------------------------------------------------------
+ */
+
+/*
+ * The data structure below defines the body of a segment that represents a
+ * tag toggle. There is one of these structures at both the beginning and end
+ * of each tagged range.
+ */
+
+typedef struct TkTextToggle {
+ struct TkTextTag *tagPtr; /* Tag that starts or ends here. */
+ int inNodeCounts; /* 1 means this toggle has been accounted for
+ * in node toggle counts; 0 means it hasn't,
+ * yet. */
+} TkTextToggle;
+
+/*
+ * The data structure below defines line segments that represent marks. There
+ * is one of these for each mark in the text.
+ */
+
+typedef struct TkTextMark {
+ struct TkText *textPtr; /* Overall information about text widget. */
+ TkTextLine *linePtr; /* Line structure that contains the
+ * segment. */
+ Tcl_HashEntry *hPtr; /* Pointer to hash table entry for mark (in
+ * sharedTextPtr->markTable). */
+} TkTextMark;
+
+/*
+ * A structure of the following type holds information for each window
+ * embedded in a text widget. This information is only used by the file
+ * tkTextWind.c
+ */
+
+typedef struct TkTextEmbWindowClient {
+ struct TkText *textPtr; /* Information about the overall text
+ * widget. */
+ Tk_Window tkwin; /* Window for this segment. NULL means that
+ * the window hasn't been created yet. */
+ int chunkCount; /* Number of display chunks that refer to this
+ * window. */
+ int displayed; /* Non-zero means that the window has been
+ * displayed on the screen recently. */
+ struct TkTextSegment *parent;
+ struct TkTextEmbWindowClient *next;
+} TkTextEmbWindowClient;
+
+typedef struct TkTextEmbWindow {
+ struct TkSharedText *sharedTextPtr;
+ /* Information about the shared portion of the
+ * text widget. */
+ Tk_Window tkwin; /* Window for this segment. This is just a
+ * temporary value, copied from 'clients', to
+ * make option table updating easier. NULL
+ * means that the window hasn't been created
+ * yet. */
+ TkTextLine *linePtr; /* Line structure that contains this
+ * window. */
+ char *create; /* Script to create window on-demand. NULL
+ * means no such script. Malloc-ed. */
+ int align; /* How to align window in vertical space. See
+ * definitions in tkTextWind.c. */
+ int padX, padY; /* Padding to leave around each side of
+ * window, in pixels. */
+ int stretch; /* Should window stretch to fill vertical
+ * space of line (except for pady)? 0 or 1. */
+ Tk_OptionTable optionTable; /* Token representing the configuration
+ * specifications. */
+ TkTextEmbWindowClient *clients;
+ /* Linked list of peer-widget specific
+ * information for this embedded window. */
+} TkTextEmbWindow;
+
+/*
+ * A structure of the following type holds information for each image embedded
+ * in a text widget. This information is only used by the file tkTextImage.c
+ */
+
+typedef struct TkTextEmbImage {
+ struct TkSharedText *sharedTextPtr;
+ /* Information about the shared portion of the
+ * text widget. This is used when the image
+ * changes or is deleted. */
+ TkTextLine *linePtr; /* Line structure that contains this image. */
+ char *imageString; /* Name of the image for this segment. */
+ char *imageName; /* Name used by text widget to identify this
+ * image. May be unique-ified. */
+ char *name; /* Name used in the hash table. Used by
+ * "image names" to identify this instance of
+ * the image. */
+ Tk_Image image; /* Image for this segment. NULL means that the
+ * image hasn't been created yet. */
+ int align; /* How to align image in vertical space. See
+ * definitions in tkTextImage.c. */
+ int padX, padY; /* Padding to leave around each side of image,
+ * in pixels. */
+ int chunkCount; /* Number of display chunks that refer to this
+ * image. */
+ Tk_OptionTable optionTable; /* Token representing the configuration
+ * specifications. */
+} TkTextEmbImage;
+
+/*
+ * The data structure below defines line segments.
+ */
+
+typedef struct TkTextSegment {
+ const struct Tk_SegType *typePtr;
+ /* Pointer to record describing segment's
+ * type. */
+ struct TkTextSegment *nextPtr;
+ /* Next in list of segments for this line, or
+ * NULL for end of list. */
+ int size; /* Size of this segment (# of bytes of index
+ * space it occupies). */
+ union {
+ char chars[2]; /* Characters that make up character info.
+ * Actual length varies to hold as many
+ * characters as needed.*/
+ TkTextToggle toggle; /* Information about tag toggle. */
+ TkTextMark mark; /* Information about mark. */
+ TkTextEmbWindow ew; /* Information about embedded window. */
+ TkTextEmbImage ei; /* Information about embedded image. */
+ } body;
+} TkTextSegment;
+
+/*
+ * Data structures of the type defined below are used during the execution of
+ * Tcl commands to keep track of various interesting places in a text. An
+ * index is only valid up until the next modification to the character
+ * structure of the b-tree so they can't be retained across Tcl commands.
+ * However, mods to marks or tags don't invalidate indices.
+ */
+
+typedef struct TkTextIndex {
+ TkTextBTree tree; /* Tree containing desired position. */
+ TkTextLine *linePtr; /* Pointer to line containing position of
+ * interest. */
+ int byteIndex; /* Index within line of desired character (0
+ * means first one). */
+ struct TkText *textPtr; /* May be NULL, but otherwise the text widget
+ * with which this index is associated. If not
+ * NULL, then we have a refCount on the
+ * widget. */
+} TkTextIndex;
+
+/*
+ * Types for procedure pointers stored in TkTextDispChunk strutures:
+ */
+
+typedef struct TkTextDispChunk TkTextDispChunk;
+
+typedef void Tk_ChunkDisplayProc(struct TkText *textPtr,
+ TkTextDispChunk *chunkPtr, int x, int y,
+ int height, int baseline, Display *display,
+ Drawable dst, int screenY);
+typedef void Tk_ChunkUndisplayProc(struct TkText *textPtr,
+ TkTextDispChunk *chunkPtr);
+typedef int Tk_ChunkMeasureProc(TkTextDispChunk *chunkPtr, int x);
+typedef void Tk_ChunkBboxProc(struct TkText *textPtr,
+ TkTextDispChunk *chunkPtr, int index, int y,
+ int lineHeight, int baseline, int *xPtr,
+ int *yPtr, int *widthPtr, int *heightPtr);
+
+/*
+ * The structure below represents a chunk of stuff that is displayed together
+ * on the screen. This structure is allocated and freed by generic display
+ * code but most of its fields are filled in by segment-type-specific code.
+ */
+
+struct TkTextDispChunk {
+ /*
+ * The fields below are set by the type-independent code before calling
+ * the segment-type-specific layoutProc. They should not be modified by
+ * segment-type-specific code.
+ */
+
+ int x; /* X position of chunk, in pixels. This
+ * position is measured from the left edge of
+ * the logical line, not from the left edge of
+ * the window (i.e. it doesn't change under
+ * horizontal scrolling). */
+ struct TkTextDispChunk *nextPtr;
+ /* Next chunk in the display line or NULL for
+ * the end of the list. */
+ struct TextStyle *stylePtr; /* Display information, known only to
+ * tkTextDisp.c. */
+
+ /*
+ * The fields below are set by the layoutProc that creates the chunk.
+ */
+
+ Tk_ChunkDisplayProc *displayProc;
+ /* Procedure to invoke to draw this chunk on
+ * the display or an off-screen pixmap. */
+ Tk_ChunkUndisplayProc *undisplayProc;
+ /* Procedure to invoke when segment ceases to
+ * be displayed on screen anymore. */
+ Tk_ChunkMeasureProc *measureProc;
+ /* Procedure to find character under a given
+ * x-location. */
+ Tk_ChunkBboxProc *bboxProc; /* Procedure to find bounding box of character
+ * in chunk. */
+ int numBytes; /* Number of bytes that will be displayed in
+ * the chunk. */
+ int minAscent; /* Minimum space above the baseline needed by
+ * this chunk. */
+ int minDescent; /* Minimum space below the baseline needed by
+ * this chunk. */
+ int minHeight; /* Minimum total line height needed by this
+ * chunk. */
+ int width; /* Width of this chunk, in pixels. Initially
+ * set by chunk-specific code, but may be
+ * increased to include tab or extra space at
+ * end of line. */
+ int breakIndex; /* Index within chunk of last acceptable
+ * position for a line (break just before this
+ * byte index). <= 0 means don't break during
+ * or immediately after this chunk. */
+ ClientData clientData; /* Additional information for use of
+ * displayProc and undisplayProc. */
+};
+
+/*
+ * One data structure of the following type is used for each tag in a text
+ * widget. These structures are kept in sharedTextPtr->tagTable and referred
+ * to in other structures.
+ */
+
+typedef enum {
+ TEXT_WRAPMODE_CHAR, TEXT_WRAPMODE_NONE, TEXT_WRAPMODE_WORD,
+ TEXT_WRAPMODE_NULL
+} TkWrapMode;
+
+typedef struct TkTextTag {
+ const char *name; /* Name of this tag. This field is actually a
+ * pointer to the key from the entry in
+ * sharedTextPtr->tagTable, so it needn't be
+ * freed explicitly. For 'sel' tags this is
+ * just a static string, so again need not be
+ * freed. */
+ const struct TkText *textPtr;
+ /* If non-NULL, then this tag only applies to
+ * the given text widget (when there are peer
+ * widgets). */
+ int priority; /* Priority of this tag within widget. 0 means
+ * lowest priority. Exactly one tag has each
+ * integer value between 0 and numTags-1. */
+ struct Node *tagRootPtr; /* Pointer into the B-Tree at the lowest node
+ * that completely dominates the ranges of
+ * text occupied by the tag. At this node
+ * there is no information about the tag. One
+ * or more children of the node do contain
+ * information about the tag. */
+ int toggleCount; /* Total number of tag toggles. */
+
+ /*
+ * Information for displaying text with this tag. The information belows
+ * acts as an override on information specified by lower-priority tags.
+ * If no value is specified, then the next-lower-priority tag on the text
+ * determins the value. The text widget itself provides defaults if no tag
+ * specifies an override.
+ */
+
+ Tk_3DBorder border; /* Used for drawing background. NULL means no
+ * value specified here. */
+ int borderWidth; /* Width of 3-D border for background. */
+ Tcl_Obj *borderWidthPtr; /* Width of 3-D border for background. */
+ char *reliefString; /* -relief option string (malloc-ed). NULL
+ * means option not specified. */
+ int relief; /* 3-D relief for background. */
+ Pixmap bgStipple; /* Stipple bitmap for background. None means
+ * no value specified here. */
+ XColor *fgColor; /* Foreground color for text. NULL means no
+ * value specified here. */
+ Tk_Font tkfont; /* Font for displaying text. NULL means no
+ * value specified here. */
+ Pixmap fgStipple; /* Stipple bitmap for text and other
+ * foreground stuff. None means no value
+ * specified here.*/
+ char *justifyString; /* -justify option string (malloc-ed). NULL
+ * means option not specified. */
+ Tk_Justify justify; /* How to justify text: TK_JUSTIFY_LEFT,
+ * TK_JUSTIFY_RIGHT, or TK_JUSTIFY_CENTER.
+ * Only valid if justifyString is non-NULL. */
+ char *lMargin1String; /* -lmargin1 option string (malloc-ed). NULL
+ * means option not specified. */
+ int lMargin1; /* Left margin for first display line of each
+ * text line, in pixels. Only valid if
+ * lMargin1String is non-NULL. */
+ char *lMargin2String; /* -lmargin2 option string (malloc-ed). NULL
+ * means option not specified. */
+ int lMargin2; /* Left margin for second and later display
+ * lines of each text line, in pixels. Only
+ * valid if lMargin2String is non-NULL. */
+ Tk_3DBorder lMarginColor; /* Used for drawing background in left margins.
+ * This is used for both lmargin1 and lmargin2.
+ * NULL means no value specified here. */
+ char *offsetString; /* -offset option string (malloc-ed). NULL
+ * means option not specified. */
+ int offset; /* Vertical offset of text's baseline from
+ * baseline of line. Used for superscripts and
+ * subscripts. Only valid if offsetString is
+ * non-NULL. */
+ char *overstrikeString; /* -overstrike option string (malloc-ed). NULL
+ * means option not specified. */
+ int overstrike; /* Non-zero means draw horizontal line through
+ * middle of text. Only valid if
+ * overstrikeString is non-NULL. */
+ XColor *overstrikeColor; /* Color for the overstrike. NULL means same
+ * color as foreground. */
+ char *rMarginString; /* -rmargin option string (malloc-ed). NULL
+ * means option not specified. */
+ int rMargin; /* Right margin for text, in pixels. Only
+ * valid if rMarginString is non-NULL. */
+ Tk_3DBorder rMarginColor; /* Used for drawing background in right margin.
+ * NULL means no value specified here. */
+ Tk_3DBorder selBorder; /* Used for drawing background for selected text.
+ * NULL means no value specified here. */
+ XColor *selFgColor; /* Foreground color for selected text. NULL means
+ * no value specified here. */
+ char *spacing1String; /* -spacing1 option string (malloc-ed). NULL
+ * means option not specified. */
+ int spacing1; /* Extra spacing above first display line for
+ * text line. Only valid if spacing1String is
+ * non-NULL. */
+ char *spacing2String; /* -spacing2 option string (malloc-ed). NULL
+ * means option not specified. */
+ int spacing2; /* Extra spacing between display lines for the
+ * same text line. Only valid if
+ * spacing2String is non-NULL. */
+ char *spacing3String; /* -spacing2 option string (malloc-ed). NULL
+ * means option not specified. */
+ int spacing3; /* Extra spacing below last display line for
+ * text line. Only valid if spacing3String is
+ * non-NULL. */
+ Tcl_Obj *tabStringPtr; /* -tabs option string. NULL means option not
+ * specified. */
+ struct TkTextTabArray *tabArrayPtr;
+ /* Info about tabs for tag (malloc-ed) or
+ * NULL. Corresponds to tabString. */
+ int tabStyle; /* One of TABULAR or WORDPROCESSOR or NONE (if
+ * not specified). */
+ char *underlineString; /* -underline option string (malloc-ed). NULL
+ * means option not specified. */
+ int underline; /* Non-zero means draw underline underneath
+ * text. Only valid if underlineString is
+ * non-NULL. */
+ XColor *underlineColor; /* Color for the underline. NULL means same
+ * color as foreground. */
+ 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). */
+ Tk_OptionTable optionTable; /* Token representing the configuration
+ * specifications. */
+ int affectsDisplayGeometry; /* Non-zero means that this tag affects the
+ * size with which information is displayed on
+ * the screen (so need to recalculate line
+ * dimensions if tag changes). */
+} TkTextTag;
+
+#define TK_TAG_AFFECTS_DISPLAY 0x1
+#define TK_TAG_UNDERLINE 0x2
+#define TK_TAG_JUSTIFY 0x4
+#define TK_TAG_OFFSET 0x10
+
+/*
+ * The data structure below is used for searching a B-tree for transitions on
+ * a single tag (or for all tag transitions). No code outside of tkTextBTree.c
+ * should ever modify any of the fields in these structures, but it's OK to
+ * use them for read-only information.
+ */
+
+typedef struct TkTextSearch {
+ TkTextIndex curIndex; /* Position of last tag transition returned by
+ * TkBTreeNextTag, or index of start of
+ * segment containing starting position for
+ * search if TkBTreeNextTag hasn't been called
+ * yet, or same as stopIndex if search is
+ * over. */
+ TkTextSegment *segPtr; /* Actual tag segment returned by last call to
+ * TkBTreeNextTag, or NULL if TkBTreeNextTag
+ * hasn't returned anything yet. */
+ TkTextSegment *nextPtr; /* Where to resume search in next call to
+ * TkBTreeNextTag. */
+ TkTextSegment *lastPtr; /* Stop search before just before considering
+ * this segment. */
+ TkTextTag *tagPtr; /* Tag to search for (or tag found, if allTags
+ * is non-zero). */
+ int linesLeft; /* Lines left to search (including curIndex
+ * and stopIndex). When this becomes <= 0 the
+ * search is over. */
+ int allTags; /* Non-zero means ignore tag check: search for
+ * transitions on all tags. */
+} TkTextSearch;
+
+/*
+ * The following data structure describes a single tab stop. It must be kept
+ * in sync with the 'tabOptionStrings' array in the function 'TkTextGetTabs'
+ */
+
+typedef enum {LEFT, RIGHT, CENTER, NUMERIC} TkTextTabAlign;
+
+/*
+ * The following are the supported styles of tabbing, used for the -tabstyle
+ * option of the text widget. The last element is only used for tag options.
+ */
+
+typedef enum {
+ TK_TEXT_TABSTYLE_TABULAR,
+ TK_TEXT_TABSTYLE_WORDPROCESSOR,
+ TK_TEXT_TABSTYLE_NONE
+} TkTextTabStyle;
+
+typedef struct TkTextTab {
+ int location; /* Offset in pixels of this tab stop from the
+ * left margin (lmargin2) of the text. */
+ TkTextTabAlign alignment; /* Where the tab stop appears relative to the
+ * text. */
+} TkTextTab;
+
+typedef struct TkTextTabArray {
+ int numTabs; /* Number of tab stops. */
+ double lastTab; /* The accurate fractional pixel position of
+ * the last tab. */
+ double tabIncrement; /* The accurate fractional pixel increment
+ * between interpolated tabs we have to create
+ * when we exceed numTabs. */
+ TkTextTab tabs[1]; /* Array of tabs. The actual size will be
+ * numTabs. THIS FIELD MUST BE THE LAST IN THE
+ * STRUCTURE. */
+} TkTextTabArray;
+
+/*
+ * Enumeration defining the edit modes of the widget.
+ */
+
+typedef enum {
+ TK_TEXT_EDIT_INSERT, /* insert mode */
+ TK_TEXT_EDIT_DELETE, /* delete mode */
+ TK_TEXT_EDIT_REPLACE, /* replace mode */
+ TK_TEXT_EDIT_OTHER /* none of the above */
+} TkTextEditMode;
+
+/*
+ * Enumeration defining the ways in which a text widget may be modified (for
+ * undo/redo handling).
+ */
+
+typedef enum {
+ TK_TEXT_DIRTY_NORMAL, /* Normal behavior. */
+ TK_TEXT_DIRTY_UNDO, /* Reverting a compound action. */
+ TK_TEXT_DIRTY_REDO, /* Reapplying a compound action. */
+ TK_TEXT_DIRTY_FIXED /* Forced to be dirty; can't be undone/redone
+ * by normal activity. */
+} TkTextDirtyMode;
+
+/*
+ * The following enum is used to define a type for the -state option of the
+ * Text widget.
+ */
+
+typedef enum {
+ TK_TEXT_STATE_DISABLED, TK_TEXT_STATE_NORMAL
+} TkTextState;
+
+/*
+ * A data structure of the following type is shared between each text widget
+ * that are peers.
+ */
+
+typedef struct TkSharedText {
+ int refCount; /* Reference count this shared object. */
+ TkTextBTree tree; /* B-tree representation of text and tags for
+ * widget. */
+ Tcl_HashTable tagTable; /* Hash table that maps from tag names to
+ * pointers to TkTextTag structures. The "sel"
+ * tag does not feature in this table, since
+ * there's one of those for each text peer. */
+ int numTags; /* Number of tags currently defined for
+ * widget; needed to keep track of
+ * priorities. */
+ Tcl_HashTable markTable; /* Hash table that maps from mark names to
+ * pointers to mark segments. The special
+ * "insert" and "current" marks are not stored
+ * in this table, but directly accessed as
+ * fields of textPtr. */
+ Tcl_HashTable windowTable; /* Hash table that maps from window names to
+ * pointers to window segments. If a window
+ * segment doesn't yet have an associated
+ * window, there is no entry for it here. */
+ Tcl_HashTable imageTable; /* Hash table that maps from image names to
+ * pointers to image segments. If an image
+ * segment doesn't yet have an associated
+ * image, there is no entry for it here. */
+ Tk_BindingTable bindingTable;
+ /* Table of all bindings currently defined for
+ * this widget. NULL means that no bindings
+ * exist, so the table hasn't been created.
+ * Each "object" used for this table is the
+ * name of a tag. */
+ int stateEpoch; /* This is incremented each time the B-tree's
+ * contents change structurally, or when the
+ * start/end limits change, and means that any
+ * cached TkTextIndex objects are no longer
+ * valid. */
+
+ /*
+ * Information related to the undo/redo functionality.
+ */
+
+ TkUndoRedoStack *undoStack; /* The undo/redo stack. */
+ int undo; /* Non-zero means the undo/redo behaviour is
+ * enabled. */
+ int maxUndo; /* The maximum depth of the undo stack
+ * expressed as the maximum number of compound
+ * statements. */
+ int autoSeparators; /* Non-zero means the separators will be
+ * inserted automatically. */
+ int isDirty; /* Flag indicating the 'dirtyness' of the
+ * text widget. If the flag is not zero,
+ * unsaved modifications have been applied to
+ * the text widget. */
+ TkTextDirtyMode dirtyMode; /* The nature of the dirtyness characterized
+ * by the isDirty flag. */
+ TkTextEditMode lastEditMode;/* Keeps track of what the last edit mode
+ * was. */
+
+ /*
+ * Keep track of all the peers
+ */
+
+ struct TkText *peers;
+} TkSharedText;
+
+/*
+ * The following enum is used to define a type for the -insertunfocussed
+ * option of the Text widget.
+ */
+
+typedef enum {
+ TK_TEXT_INSERT_NOFOCUS_HOLLOW,
+ TK_TEXT_INSERT_NOFOCUS_NONE,
+ TK_TEXT_INSERT_NOFOCUS_SOLID
+} TkTextInsertUnfocussed;
+
+/*
+ * A data structure of the following type is kept for each text widget that
+ * currently exists for this process:
+ */
+
+typedef struct TkText {
+ /*
+ * Information related to and accessed by widget peers and the
+ * TkSharedText handling routines.
+ */
+
+ TkSharedText *sharedTextPtr;/* Shared section of all peers. */
+ struct TkText *next; /* Next in list of linked peers. */
+ TkTextLine *start; /* First B-tree line to show, or NULL to start
+ * at the beginning. */
+ TkTextLine *end; /* Last B-tree line to show, or NULL for up to
+ * the end. */
+ int pixelReference; /* Counter into the current tree reference
+ * index corresponding to this widget. */
+ int abortSelections; /* Set to 1 whenever the text is modified in a
+ * way that interferes with selection
+ * retrieval: used to abort incremental
+ * selection retrievals. */
+
+ /*
+ * Standard Tk widget information and text-widget specific items
+ */
+
+ Tk_Window tkwin; /* Window that embodies the text. NULL means
+ * that the window has been destroyed but the
+ * data structures haven't yet been cleaned
+ * up.*/
+ Display *display; /* Display for widget. Needed, among other
+ * things, to allow resources to be freed even
+ * after tkwin has gone away. */
+ Tcl_Interp *interp; /* Interpreter associated with widget. Used to
+ * delete widget command. */
+ Tcl_Command widgetCmd; /* Token for text's widget command. */
+ int state; /* Either STATE_NORMAL or STATE_DISABLED. A
+ * text widget is read-only when disabled. */
+
+ /*
+ * Default information for displaying (may be overridden by tags applied
+ * to ranges of characters).
+ */
+
+ Tk_3DBorder border; /* Structure used to draw 3-D border and
+ * default background. */
+ int borderWidth; /* Width of 3-D border to draw around entire
+ * widget. */
+ int padX, padY; /* Padding between text and window border. */
+ int relief; /* 3-d effect for border around entire widget:
+ * TK_RELIEF_RAISED etc. */
+ int highlightWidth; /* Width in pixels of highlight to draw around
+ * widget when it has the focus. <= 0 means
+ * don't draw a highlight. */
+ XColor *highlightBgColorPtr;
+ /* Color for drawing traversal highlight area
+ * when highlight is off. */
+ XColor *highlightColorPtr; /* Color for drawing traversal highlight. */
+ Tk_Cursor cursor; /* Current cursor for window, or None. */
+ XColor *fgColor; /* Default foreground color for text. */
+ Tk_Font tkfont; /* Default font for displaying text. */
+ int charWidth; /* Width of average character in default
+ * font. */
+ int charHeight; /* Height of average character in default
+ * font, including line spacing. */
+ int spacing1; /* Default extra spacing above first display
+ * line for each text line. */
+ int spacing2; /* Default extra spacing between display lines
+ * for the same text line. */
+ int spacing3; /* Default extra spacing below last display
+ * line for each text line. */
+ Tcl_Obj *tabOptionPtr; /* Value of -tabs option string. */
+ TkTextTabArray *tabArrayPtr;
+ /* Information about tab stops (malloc'ed).
+ * NULL means perform default tabbing
+ * behavior. */
+ int tabStyle; /* One of TABULAR or WORDPROCESSOR. */
+
+ /*
+ * Additional information used for displaying:
+ */
+
+ TkWrapMode wrapMode; /* How to handle wrap-around. Must be
+ * TEXT_WRAPMODE_CHAR, TEXT_WRAPMODE_NONE, or
+ * TEXT_WRAPMODE_WORD. */
+ int width, height; /* Desired dimensions for window, measured in
+ * characters. */
+ int setGrid; /* Non-zero means pass gridding information to
+ * window manager. */
+ int prevWidth, prevHeight; /* Last known dimensions of window; used to
+ * detect changes in size. */
+ TkTextIndex topIndex; /* Identifies first character in top display
+ * line of window. */
+ struct TextDInfo *dInfoPtr; /* Information maintained by tkTextDisp.c. */
+
+ /*
+ * Information related to selection.
+ */
+
+ TkTextTag *selTagPtr; /* Pointer to "sel" tag. Used to tell when a
+ * new selection has been made. */
+ Tk_3DBorder selBorder; /* Border and background for selected
+ * characters. This is a copy of information
+ * in *selTagPtr, so it shouldn't be
+ * explicitly freed. */
+ Tk_3DBorder inactiveSelBorder;
+ /* Border and background for selected
+ * characters when they don't have the
+ * focus. */
+ int selBorderWidth; /* Width of border around selection. */
+ Tcl_Obj *selBorderWidthPtr; /* Width of border around selection. */
+ XColor *selFgColorPtr; /* Foreground color for selected text. This is
+ * a copy of information in *selTagPtr, so it
+ * shouldn't be explicitly freed. */
+ int exportSelection; /* Non-zero means tie "sel" tag to X
+ * selection. */
+ TkTextIndex selIndex; /* Used during multi-pass selection
+ * retrievals. This index identifies the next
+ * character to be returned from the
+ * selection. */
+
+ /*
+ * Information related to insertion cursor:
+ */
+
+ TkTextSegment *insertMarkPtr;
+ /* Points to segment for "insert" mark. */
+ Tk_3DBorder insertBorder; /* Used to draw vertical bar for insertion
+ * cursor. */
+ int insertWidth; /* Total width of insert cursor. */
+ int insertBorderWidth; /* Width of 3-D border around insert cursor */
+ TkTextInsertUnfocussed insertUnfocussed;
+ /* How to display the insert cursor when the
+ * text widget does not have the focus. */
+ int insertOnTime; /* Number of milliseconds cursor should spend
+ * in "on" state for each blink. */
+ int insertOffTime; /* Number of milliseconds cursor should spend
+ * in "off" state for each blink. */
+ Tcl_TimerToken insertBlinkHandler;
+ /* Timer handler used to blink cursor on and
+ * off. */
+
+ /*
+ * Information used for event bindings associated with tags:
+ */
+
+ TkTextSegment *currentMarkPtr;
+ /* Pointer to segment for "current" mark, or
+ * NULL if none. */
+ XEvent pickEvent; /* The event from which the current character
+ * was chosen. Must be saved so that we can
+ * repick after modifications to the text. */
+ int numCurTags; /* Number of tags associated with character at
+ * current mark. */
+ TkTextTag **curTagArrayPtr; /* Pointer to array of tags for current mark,
+ * or NULL if none. */
+
+ /*
+ * Miscellaneous additional information:
+ */
+
+ char *takeFocus; /* Value of -takeFocus option; not used in the
+ * C code, but used by keyboard traversal
+ * scripts. Malloc'ed, but may be NULL. */
+ char *xScrollCmd; /* Prefix of command to issue to update
+ * horizontal scrollbar when view changes. */
+ char *yScrollCmd; /* Prefix of command to issue to update
+ * vertical scrollbar when view changes. */
+ int flags; /* Miscellaneous flags; see below for
+ * definitions. */
+ Tk_OptionTable optionTable; /* Token representing the configuration
+ * specifications. */
+ int refCount; /* Number of cached TkTextIndex objects
+ * refering to us. */
+ int insertCursorType; /* 0 = standard insertion cursor, 1 = block
+ * cursor. */
+
+ /*
+ * Copies of information from the shared section relating to the undo/redo
+ * functonality
+ */
+
+ int undo; /* Non-zero means the undo/redo behaviour is
+ * enabled. */
+ int maxUndo; /* The maximum depth of the undo stack
+ * expressed as the maximum number of compound
+ * statements. */
+ int autoSeparators; /* Non-zero means the separators will be
+ * inserted automatically. */
+ Tcl_Obj *afterSyncCmd; /* Command to be executed when lines are up to
+ * date */
+} TkText;
+
+/*
+ * Flag values for TkText records:
+ *
+ * GOT_SELECTION: Non-zero means we've already claimed the
+ * selection.
+ * INSERT_ON: Non-zero means insertion cursor should be
+ * displayed on screen.
+ * GOT_FOCUS: Non-zero means this window has the input
+ * focus.
+ * BUTTON_DOWN: 1 means that a mouse button is currently down;
+ * this is used to implement grabs for the
+ * duration of button presses.
+ * UPDATE_SCROLLBARS: Non-zero means scrollbar(s) should be updated
+ * during next redisplay operation.
+ * NEED_REPICK This appears unused and should probably be
+ * ignored.
+ * OPTIONS_FREED The widget's options have been freed.
+ * DESTROYED The widget is going away.
+ */
+
+#define GOT_SELECTION 1
+#define INSERT_ON 2
+#define GOT_FOCUS 4
+#define BUTTON_DOWN 8
+#define UPDATE_SCROLLBARS 0x10
+#define NEED_REPICK 0x20
+#define OPTIONS_FREED 0x40
+#define DESTROYED 0x80
+
+/*
+ * Records of the following type define segment types in terms of a collection
+ * of procedures that may be called to manipulate segments of that type.
+ */
+
+typedef TkTextSegment * Tk_SegSplitProc(struct TkTextSegment *segPtr,
+ int index);
+typedef int Tk_SegDeleteProc(struct TkTextSegment *segPtr,
+ TkTextLine *linePtr, int treeGone);
+typedef TkTextSegment * Tk_SegCleanupProc(struct TkTextSegment *segPtr,
+ TkTextLine *linePtr);
+typedef void Tk_SegLineChangeProc(struct TkTextSegment *segPtr,
+ TkTextLine *linePtr);
+typedef int Tk_SegLayoutProc(struct TkText *textPtr,
+ struct TkTextIndex *indexPtr,
+ TkTextSegment *segPtr, int offset, int maxX,
+ int maxChars, int noCharsYet, TkWrapMode wrapMode,
+ struct TkTextDispChunk *chunkPtr);
+typedef void Tk_SegCheckProc(TkTextSegment *segPtr,
+ TkTextLine *linePtr);
+
+typedef struct Tk_SegType {
+ const char *name; /* Name of this kind of segment. */
+ int leftGravity; /* If a segment has zero size (e.g. a mark or
+ * tag toggle), does it attach to character to
+ * its left or right? 1 means left, 0 means
+ * right. */
+ Tk_SegSplitProc *splitProc; /* Procedure to split large segment into two
+ * smaller ones. */
+ Tk_SegDeleteProc *deleteProc;
+ /* Procedure to call to delete segment. */
+ Tk_SegCleanupProc *cleanupProc;
+ /* After any change to a line, this procedure
+ * is invoked for all segments left in the
+ * line to perform any cleanup they wish
+ * (e.g. joining neighboring segments). */
+ Tk_SegLineChangeProc *lineChangeProc;
+ /* Invoked when a segment is about to be moved
+ * from its current line to an earlier line
+ * because of a deletion. The linePtr is that
+ * for the segment's old line. CleanupProc
+ * will be invoked after the deletion is
+ * finished. */
+ Tk_SegLayoutProc *layoutProc;
+ /* Returns size information when figuring out
+ * what to display in window. */
+ Tk_SegCheckProc *checkProc; /* Called during consistency checks to check
+ * internal consistency of segment. */
+} Tk_SegType;
+
+/*
+ * The following type and items describe different flags for text widget items
+ * to count. They are used in both tkText.c and tkTextIndex.c, in
+ * 'CountIndices', 'TkTextIndexBackChars', 'TkTextIndexForwChars', and
+ * 'TkTextIndexCount'.
+ */
+
+typedef int TkTextCountType;
+
+#define COUNT_CHARS 0
+#define COUNT_INDICES 1
+#define COUNT_DISPLAY 2
+#define COUNT_DISPLAY_CHARS (COUNT_CHARS | COUNT_DISPLAY)
+#define COUNT_DISPLAY_INDICES (COUNT_INDICES | COUNT_DISPLAY)
+
+/*
+ * The following structure is used to keep track of elided text taking account
+ * of different tag priorities, it is need for quick calculations of whether a
+ * single index is elided, and to start at a given index and maintain a
+ * correct elide state as we move or count forwards or backwards.
+ */
+
+#define LOTSA_TAGS 1000
+typedef struct TkTextElideInfo {
+ int numTags; /* Total tags in widget. */
+ int elide; /* Is the state currently elided. */
+ int elidePriority; /* Tag priority controlling elide state. */
+ TkTextSegment *segPtr; /* Segment to look at next. */
+ int segOffset; /* Offset of segment within line. */
+ int deftagCnts[LOTSA_TAGS];
+ TkTextTag *deftagPtrs[LOTSA_TAGS];
+ int *tagCnts; /* 0 or 1 depending if the tag with that
+ * priority is on or off. */
+ TkTextTag **tagPtrs; /* Only filled with a tagPtr if the
+ * corresponding tagCnt is 1. */
+} TkTextElideInfo;
+
+/*
+ * The constant below is used to specify a line when what is really wanted is
+ * the entire text. For now, just use a very big number.
+ */
+
+#define TK_END_OF_TEXT 1000000
+
+/*
+ * The following definition specifies the maximum number of characters needed
+ * in a string to hold a position specifier.
+ */
+
+#define TK_POS_CHARS 30
+
+/*
+ * Mask used for those options which may impact the pixel height calculations
+ * of individual lines displayed in the widget.
+ */
+
+#define TK_TEXT_LINE_GEOMETRY 1
+
+/*
+ * Mask used for those options which may impact the start and end lines used
+ * in the widget.
+ */
+
+#define TK_TEXT_LINE_RANGE 2
+
+/*
+ * Used as 'action' values in calls to TkTextInvalidateLineMetrics
+ */
+
+#define TK_TEXT_INVALIDATE_ONLY 0
+#define TK_TEXT_INVALIDATE_INSERT 1
+#define TK_TEXT_INVALIDATE_DELETE 2
+
+/*
+ * Used as special 'pickPlace' values in calls to TkTextSetYView. Zero or
+ * positive values indicate a number of pixels.
+ */
+
+#define TK_TEXT_PICKPLACE -1
+#define TK_TEXT_NOPIXELADJUST -2
+
+/*
+ * Declarations for variables shared among the text-related files:
+ */
+
+MODULE_SCOPE int tkBTreeDebug;
+MODULE_SCOPE int tkTextDebug;
+MODULE_SCOPE const Tk_SegType tkTextCharType;
+MODULE_SCOPE const Tk_SegType tkTextLeftMarkType;
+MODULE_SCOPE const Tk_SegType tkTextRightMarkType;
+MODULE_SCOPE const Tk_SegType tkTextToggleOnType;
+MODULE_SCOPE const Tk_SegType tkTextToggleOffType;
+MODULE_SCOPE const Tk_SegType tkTextEmbWindowType;
+MODULE_SCOPE const Tk_SegType tkTextEmbImageType;
+
+/*
+ * Convenience macros for use by B-tree clients which want to access pixel
+ * information on each line. Currently only used by TkTextDisp.c
+ */
+
+#define TkBTreeLinePixelCount(text, line) \
+ (line)->pixels[2*(text)->pixelReference]
+#define TkBTreeLinePixelEpoch(text, line) \
+ (line)->pixels[1+2*(text)->pixelReference]
+
+/*
+ * Declarations for procedures that are used by the text-related files but
+ * shouldn't be used anywhere else in Tk (or by Tk clients):
+ */
+
+MODULE_SCOPE int TkBTreeAdjustPixelHeight(const TkText *textPtr,
+ TkTextLine *linePtr, int newPixelHeight,
+ int mergedLogicalLines);
+MODULE_SCOPE int TkBTreeCharTagged(const TkTextIndex *indexPtr,
+ TkTextTag *tagPtr);
+MODULE_SCOPE void TkBTreeCheck(TkTextBTree tree);
+MODULE_SCOPE TkTextBTree TkBTreeCreate(TkSharedText *sharedTextPtr);
+MODULE_SCOPE void TkBTreeAddClient(TkTextBTree tree, TkText *textPtr,
+ int defaultHeight);
+MODULE_SCOPE void TkBTreeClientRangeChanged(TkText *textPtr,
+ int defaultHeight);
+MODULE_SCOPE void TkBTreeRemoveClient(TkTextBTree tree,
+ TkText *textPtr);
+MODULE_SCOPE void TkBTreeDestroy(TkTextBTree tree);
+MODULE_SCOPE void TkBTreeDeleteIndexRange(TkTextBTree tree,
+ TkTextIndex *index1Ptr, TkTextIndex *index2Ptr);
+MODULE_SCOPE int TkBTreeEpoch(TkTextBTree tree);
+MODULE_SCOPE TkTextLine *TkBTreeFindLine(TkTextBTree tree,
+ const TkText *textPtr, int line);
+MODULE_SCOPE TkTextLine *TkBTreeFindPixelLine(TkTextBTree tree,
+ const TkText *textPtr, int pixels,
+ int *pixelOffset);
+MODULE_SCOPE TkTextTag **TkBTreeGetTags(const TkTextIndex *indexPtr,
+ const TkText *textPtr, int *numTagsPtr);
+MODULE_SCOPE void TkBTreeInsertChars(TkTextBTree tree,
+ TkTextIndex *indexPtr, const char *string);
+MODULE_SCOPE int TkBTreeLinesTo(const TkText *textPtr,
+ TkTextLine *linePtr);
+MODULE_SCOPE int TkBTreePixelsTo(const TkText *textPtr,
+ TkTextLine *linePtr);
+MODULE_SCOPE void TkBTreeLinkSegment(TkTextSegment *segPtr,
+ TkTextIndex *indexPtr);
+MODULE_SCOPE TkTextLine *TkBTreeNextLine(const TkText *textPtr,
+ TkTextLine *linePtr);
+MODULE_SCOPE int TkBTreeNextTag(TkTextSearch *searchPtr);
+MODULE_SCOPE int TkBTreeNumPixels(TkTextBTree tree,
+ const TkText *textPtr);
+MODULE_SCOPE TkTextLine *TkBTreePreviousLine(TkText *textPtr,
+ TkTextLine *linePtr);
+MODULE_SCOPE int TkBTreePrevTag(TkTextSearch *searchPtr);
+MODULE_SCOPE void TkBTreeStartSearch(TkTextIndex *index1Ptr,
+ TkTextIndex *index2Ptr, TkTextTag *tagPtr,
+ TkTextSearch *searchPtr);
+MODULE_SCOPE void TkBTreeStartSearchBack(TkTextIndex *index1Ptr,
+ TkTextIndex *index2Ptr, TkTextTag *tagPtr,
+ TkTextSearch *searchPtr);
+MODULE_SCOPE int TkBTreeTag(TkTextIndex *index1Ptr,
+ TkTextIndex *index2Ptr, TkTextTag *tagPtr,
+ int add);
+MODULE_SCOPE void TkBTreeUnlinkSegment(TkTextSegment *segPtr,
+ TkTextLine *linePtr);
+MODULE_SCOPE void TkTextBindProc(ClientData clientData,
+ XEvent *eventPtr);
+MODULE_SCOPE void TkTextSelectionEvent(TkText *textPtr);
+MODULE_SCOPE int TkTextIndexBbox(TkText *textPtr,
+ const TkTextIndex *indexPtr, int *xPtr, int *yPtr,
+ int *widthPtr, int *heightPtr, int *charWidthPtr);
+MODULE_SCOPE int TkTextCharLayoutProc(TkText *textPtr,
+ TkTextIndex *indexPtr, TkTextSegment *segPtr,
+ int offset, int maxX, int maxChars, int noBreakYet,
+ TkWrapMode wrapMode, TkTextDispChunk *chunkPtr);
+MODULE_SCOPE void TkTextCreateDInfo(TkText *textPtr);
+MODULE_SCOPE int TkTextDLineInfo(TkText *textPtr,
+ const TkTextIndex *indexPtr, int *xPtr, int *yPtr,
+ int *widthPtr, int *heightPtr, int *basePtr);
+MODULE_SCOPE void TkTextEmbWinDisplayProc(TkText *textPtr,
+ TkTextDispChunk *chunkPtr, int x, int y,
+ int lineHeight, int baseline, Display *display,
+ Drawable dst, int screenY);
+MODULE_SCOPE TkTextTag *TkTextCreateTag(TkText *textPtr,
+ const char *tagName, int *newTag);
+MODULE_SCOPE void TkTextFreeDInfo(TkText *textPtr);
+MODULE_SCOPE void TkTextDeleteTag(TkText *textPtr, TkTextTag *tagPtr);
+MODULE_SCOPE void TkTextFreeTag(TkText *textPtr, TkTextTag *tagPtr);
+MODULE_SCOPE int TkTextGetObjIndex(Tcl_Interp *interp, TkText *textPtr,
+ Tcl_Obj *idxPtr, TkTextIndex *indexPtr);
+MODULE_SCOPE int TkTextSharedGetObjIndex(Tcl_Interp *interp,
+ TkSharedText *sharedTextPtr, Tcl_Obj *idxPtr,
+ TkTextIndex *indexPtr);
+MODULE_SCOPE const TkTextIndex *TkTextGetIndexFromObj(Tcl_Interp *interp,
+ TkText *textPtr, Tcl_Obj *objPtr);
+MODULE_SCOPE TkTextTabArray *TkTextGetTabs(Tcl_Interp *interp,
+ TkText *textPtr, Tcl_Obj *stringPtr);
+MODULE_SCOPE void TkTextFindDisplayLineEnd(TkText *textPtr,
+ TkTextIndex *indexPtr, int end, int *xOffset);
+MODULE_SCOPE void TkTextIndexBackChars(const TkText *textPtr,
+ const TkTextIndex *srcPtr, int count,
+ TkTextIndex *dstPtr, TkTextCountType type);
+MODULE_SCOPE int TkTextIndexCmp(const TkTextIndex *index1Ptr,
+ const TkTextIndex *index2Ptr);
+MODULE_SCOPE int TkTextIndexCountBytes(const TkText *textPtr,
+ const TkTextIndex *index1Ptr,
+ const TkTextIndex *index2Ptr);
+MODULE_SCOPE int TkTextIndexCount(const TkText *textPtr,
+ const TkTextIndex *index1Ptr,
+ const TkTextIndex *index2Ptr,
+ TkTextCountType type);
+MODULE_SCOPE void TkTextIndexForwChars(const TkText *textPtr,
+ const TkTextIndex *srcPtr, int count,
+ TkTextIndex *dstPtr, TkTextCountType type);
+MODULE_SCOPE void TkTextIndexOfX(TkText *textPtr, int x,
+ TkTextIndex *indexPtr);
+MODULE_SCOPE int TkTextIndexYPixels(TkText *textPtr,
+ const TkTextIndex *indexPtr);
+MODULE_SCOPE TkTextSegment *TkTextIndexToSeg(const TkTextIndex *indexPtr,
+ int *offsetPtr);
+MODULE_SCOPE void TkTextLostSelection(ClientData clientData);
+MODULE_SCOPE TkTextIndex *TkTextMakeCharIndex(TkTextBTree tree, TkText *textPtr,
+ int lineIndex, int charIndex,
+ TkTextIndex *indexPtr);
+MODULE_SCOPE int TkTextMeasureDown(TkText *textPtr,
+ TkTextIndex *srcPtr, int distance);
+MODULE_SCOPE void TkTextFreeElideInfo(TkTextElideInfo *infoPtr);
+MODULE_SCOPE int TkTextIsElided(const TkText *textPtr,
+ const TkTextIndex *indexPtr,
+ TkTextElideInfo *infoPtr);
+MODULE_SCOPE int TkTextMakePixelIndex(TkText *textPtr,
+ int pixelIndex, TkTextIndex *indexPtr);
+MODULE_SCOPE void TkTextInvalidateLineMetrics(
+ TkSharedText *sharedTextPtr, TkText *textPtr,
+ TkTextLine *linePtr, int lineCount, int action);
+MODULE_SCOPE int TkTextUpdateLineMetrics(TkText *textPtr, int lineNum,
+ int endLine, int doThisMuch);
+MODULE_SCOPE int TkTextUpdateOneLine(TkText *textPtr,
+ TkTextLine *linePtr, int pixelHeight,
+ TkTextIndex *indexPtr, int partialCalc);
+MODULE_SCOPE int TkTextMarkCmd(TkText *textPtr, Tcl_Interp *interp,
+ int objc, Tcl_Obj *const objv[]);
+MODULE_SCOPE int TkTextMarkNameToIndex(TkText *textPtr,
+ const char *name, TkTextIndex *indexPtr);
+MODULE_SCOPE void TkTextMarkSegToIndex(TkText *textPtr,
+ TkTextSegment *markPtr, TkTextIndex *indexPtr);
+MODULE_SCOPE void TkTextEventuallyRepick(TkText *textPtr);
+MODULE_SCOPE Bool TkTextPendingsync(TkText *textPtr);
+MODULE_SCOPE void TkTextPickCurrent(TkText *textPtr, XEvent *eventPtr);
+MODULE_SCOPE void TkTextPixelIndex(TkText *textPtr, int x, int y,
+ TkTextIndex *indexPtr, int *nearest);
+MODULE_SCOPE Tcl_Obj * TkTextNewIndexObj(TkText *textPtr,
+ const TkTextIndex *indexPtr);
+MODULE_SCOPE void TkTextRedrawRegion(TkText *textPtr, int x, int y,
+ int width, int height);
+MODULE_SCOPE void TkTextRedrawTag(TkSharedText *sharedTextPtr,
+ TkText *textPtr, TkTextIndex *index1Ptr,
+ TkTextIndex *index2Ptr, TkTextTag *tagPtr,
+ int withTag);
+MODULE_SCOPE void TkTextRelayoutWindow(TkText *textPtr, int mask);
+MODULE_SCOPE int TkTextScanCmd(TkText *textPtr, Tcl_Interp *interp,
+ int objc, Tcl_Obj *const objv[]);
+MODULE_SCOPE int TkTextSeeCmd(TkText *textPtr, Tcl_Interp *interp,
+ int objc, Tcl_Obj *const objv[]);
+MODULE_SCOPE int TkTextSegToOffset(const TkTextSegment *segPtr,
+ const TkTextLine *linePtr);
+MODULE_SCOPE void TkTextSetYView(TkText *textPtr,
+ TkTextIndex *indexPtr, int pickPlace);
+MODULE_SCOPE int TkTextTagCmd(TkText *textPtr, Tcl_Interp *interp,
+ int objc, Tcl_Obj *const objv[]);
+MODULE_SCOPE int TkTextImageCmd(TkText *textPtr, Tcl_Interp *interp,
+ int objc, Tcl_Obj *const objv[]);
+MODULE_SCOPE int TkTextImageIndex(TkText *textPtr,
+ const char *name, TkTextIndex *indexPtr);
+MODULE_SCOPE int TkTextWindowCmd(TkText *textPtr, Tcl_Interp *interp,
+ int objc, Tcl_Obj *const objv[]);
+MODULE_SCOPE int TkTextWindowIndex(TkText *textPtr, const char *name,
+ TkTextIndex *indexPtr);
+MODULE_SCOPE int TkTextYviewCmd(TkText *textPtr, Tcl_Interp *interp,
+ int objc, Tcl_Obj *const objv[]);
+MODULE_SCOPE void TkTextWinFreeClient(Tcl_HashEntry *hPtr,
+ TkTextEmbWindowClient *client);
+
+#endif /* _TKTEXT */
+
+/*
+ * Local Variables:
+ * mode: c
+ * c-basic-offset: 4
+ * fill-column: 78
+ * End:
+ */
diff --git a/tk8.6/generic/tkTextBTree.c b/tk8.6/generic/tkTextBTree.c
new file mode 100644
index 0000000..0fdc280
--- /dev/null
+++ b/tk8.6/generic/tkTextBTree.c
@@ -0,0 +1,4890 @@
+/*
+ * tkTextBTree.c --
+ *
+ * This file contains code that manages the B-tree representation of text
+ * for Tk's text widget and implements character and toggle segment
+ * types.
+ *
+ * Copyright (c) 1992-1994 The Regents of the University of California.
+ * Copyright (c) 1994-1995 Sun Microsystems, Inc.
+ *
+ * See the file "license.terms" for information on usage and redistribution of
+ * this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ */
+
+#include "tkInt.h"
+#include "tkText.h"
+
+/*
+ * Implementation notes:
+ *
+ * Most of this file is independent of the text widget implementation and
+ * representation now. Without much effort this could be developed further
+ * into a new Tcl object type of which the Tk text widget is one example of a
+ * client.
+ *
+ * The B-tree is set up with a dummy last line of text which must not be
+ * displayed, and must _never_ have a non-zero pixel count. This dummy line is
+ * a historical convenience to avoid other code having to deal with NULL
+ * TkTextLines. Since Tk 8.5, with pixel line height calculations and peer
+ * widgets, this dummy line is becoming somewhat of a liability, and special
+ * case code has been required to deal with it. It is probably a good idea to
+ * investigate removing the dummy line completely. This could result in an
+ * overall simplification (although it would require new special case code to
+ * deal with the fact that '.text index end' would then not really point to a
+ * valid line, rather it would point to the beginning of a non-existent line
+ * one beyond all current lines - we could perhaps define that as a
+ * TkTextIndex with a NULL TkTextLine ptr).
+ */
+
+/*
+ * The data structure below keeps summary information about one tag as part of
+ * the tag information in a node.
+ */
+
+typedef struct Summary {
+ TkTextTag *tagPtr; /* Handle for tag. */
+ int toggleCount; /* Number of transitions into or out of this
+ * tag that occur in the subtree rooted at
+ * this node. */
+ struct Summary *nextPtr; /* Next in list of all tags for same node, or
+ * NULL if at end of list. */
+} Summary;
+
+/*
+ * The data structure below defines a node in the B-tree.
+ */
+
+typedef struct Node {
+ struct Node *parentPtr; /* Pointer to parent node, or NULL if this is
+ * the root. */
+ struct Node *nextPtr; /* Next in list of siblings with the same
+ * parent node, or NULL for end of list. */
+ Summary *summaryPtr; /* First in malloc-ed list of info about tags
+ * in this subtree (NULL if no tag info in the
+ * subtree). */
+ int level; /* Level of this node in the B-tree. 0 refers
+ * to the bottom of the tree (children are
+ * lines, not nodes). */
+ union { /* First in linked list of children. */
+ struct Node *nodePtr; /* Used if level > 0. */
+ TkTextLine *linePtr; /* Used if level == 0. */
+ } children;
+ int numChildren; /* Number of children of this node. */
+ int numLines; /* Total number of lines (leaves) in the
+ * subtree rooted here. */
+ int *numPixels; /* Array containing total number of vertical
+ * display pixels in the subtree rooted here,
+ * one entry for each peer widget. */
+} Node;
+
+/*
+ * Used to avoid having to allocate and deallocate arrays on the fly for
+ * commonly used functions. Must be > 0.
+ */
+
+#define PIXEL_CLIENTS 5
+
+/*
+ * Upper and lower bounds on how many children a node may have: rebalance when
+ * either of these limits is exceeded. MAX_CHILDREN should be twice
+ * MIN_CHILDREN and MIN_CHILDREN must be >= 2.
+ */
+
+#define MAX_CHILDREN 12
+#define MIN_CHILDREN 6
+
+/*
+ * The data structure below defines an entire B-tree. Since text widgets are
+ * the only current B-tree clients, 'clients' and 'pixelReferences' are
+ * identical.
+ */
+
+typedef struct BTree {
+ Node *rootPtr; /* Pointer to root of B-tree. */
+ int clients; /* Number of clients of this B-tree. */
+ int pixelReferences; /* Number of clients of this B-tree which care
+ * about pixel heights. */
+ int stateEpoch; /* Updated each time any aspect of the B-tree
+ * changes. */
+ TkSharedText *sharedTextPtr;/* Used to find tagTable in consistency
+ * checking code, and to access list of all
+ * B-tree clients. */
+ int startEndCount;
+ TkTextLine **startEnd;
+ TkText **startEndRef;
+} BTree;
+
+/*
+ * The structure below is used to pass information between
+ * TkBTreeGetTags and IncCount:
+ */
+
+typedef struct TagInfo {
+ int numTags; /* Number of tags for which there is currently
+ * information in tags and counts. */
+ int arraySize; /* Number of entries allocated for tags and
+ * counts. */
+ TkTextTag **tagPtrs; /* Array of tags seen so far. Malloc-ed. */
+ int *counts; /* Toggle count (so far) for each entry in
+ * tags. Malloc-ed. */
+} TagInfo;
+
+/*
+ * Variable that indicates whether to enable consistency checks for debugging.
+ */
+
+int tkBTreeDebug = 0;
+
+/*
+ * Macros that determine how much space to allocate for new segments:
+ */
+
+#define CSEG_SIZE(chars) ((unsigned) (Tk_Offset(TkTextSegment, body) \
+ + 1 + (chars)))
+#define TSEG_SIZE ((unsigned) (Tk_Offset(TkTextSegment, body) \
+ + sizeof(TkTextToggle)))
+
+/*
+ * Forward declarations for functions defined in this file:
+ */
+
+static int AdjustPixelClient(BTree *treePtr, int defaultHeight,
+ Node *nodePtr, TkTextLine *start, TkTextLine *end,
+ int useReference, int newPixelReferences,
+ int *counting);
+static void ChangeNodeToggleCount(Node *nodePtr,
+ TkTextTag *tagPtr, int delta);
+static void CharCheckProc(TkTextSegment *segPtr,
+ TkTextLine *linePtr);
+static int CharDeleteProc(TkTextSegment *segPtr,
+ TkTextLine *linePtr, int treeGone);
+static TkTextSegment * CharCleanupProc(TkTextSegment *segPtr,
+ TkTextLine *linePtr);
+static TkTextSegment * CharSplitProc(TkTextSegment *segPtr, int index);
+static void CheckNodeConsistency(Node *nodePtr, int references);
+static void CleanupLine(TkTextLine *linePtr);
+static void DeleteSummaries(Summary *tagPtr);
+static void DestroyNode(Node *nodePtr);
+static TkTextSegment * FindTagEnd(TkTextBTree tree, TkTextTag *tagPtr,
+ TkTextIndex *indexPtr);
+static void IncCount(TkTextTag *tagPtr, int inc,
+ TagInfo *tagInfoPtr);
+static void Rebalance(BTree *treePtr, Node *nodePtr);
+static void RecomputeNodeCounts(BTree *treePtr, Node *nodePtr);
+static void RemovePixelClient(BTree *treePtr, Node *nodePtr,
+ int overwriteWithLast);
+static TkTextSegment * SplitSeg(TkTextIndex *indexPtr);
+static void ToggleCheckProc(TkTextSegment *segPtr,
+ TkTextLine *linePtr);
+static TkTextSegment * ToggleCleanupProc(TkTextSegment *segPtr,
+ TkTextLine *linePtr);
+static int ToggleDeleteProc(TkTextSegment *segPtr,
+ TkTextLine *linePtr, int treeGone);
+static void ToggleLineChangeProc(TkTextSegment *segPtr,
+ TkTextLine *linePtr);
+static TkTextSegment * FindTagStart(TkTextBTree tree, TkTextTag *tagPtr,
+ TkTextIndex *indexPtr);
+static void AdjustStartEndRefs(BTree *treePtr, TkText *textPtr,
+ int action);
+
+/*
+ * Actions for use by AdjustStartEndRefs
+ */
+
+#define TEXT_ADD_REFS 1
+#define TEXT_REMOVE_REFS 2
+
+/*
+ * Type record for character segments:
+ */
+
+const Tk_SegType tkTextCharType = {
+ "character", /* name */
+ 0, /* leftGravity */
+ CharSplitProc, /* splitProc */
+ CharDeleteProc, /* deleteProc */
+ CharCleanupProc, /* cleanupProc */
+ NULL, /* lineChangeProc */
+ TkTextCharLayoutProc, /* layoutProc */
+ CharCheckProc /* checkProc */
+};
+
+/*
+ * Type record for segments marking the beginning of a tagged range:
+ */
+
+const Tk_SegType tkTextToggleOnType = {
+ "toggleOn", /* name */
+ 0, /* leftGravity */
+ NULL, /* splitProc */
+ ToggleDeleteProc, /* deleteProc */
+ ToggleCleanupProc, /* cleanupProc */
+ ToggleLineChangeProc, /* lineChangeProc */
+ NULL, /* layoutProc */
+ ToggleCheckProc /* checkProc */
+};
+
+/*
+ * Type record for segments marking the end of a tagged range:
+ */
+
+const Tk_SegType tkTextToggleOffType = {
+ "toggleOff", /* name */
+ 1, /* leftGravity */
+ NULL, /* splitProc */
+ ToggleDeleteProc, /* deleteProc */
+ ToggleCleanupProc, /* cleanupProc */
+ ToggleLineChangeProc, /* lineChangeProc */
+ NULL, /* layoutProc */
+ ToggleCheckProc /* checkProc */
+};
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkBTreeCreate --
+ *
+ * This function is called to create a new text B-tree.
+ *
+ * Results:
+ * The return value is a pointer to a new B-tree containing one line with
+ * nothing but a newline character.
+ *
+ * Side effects:
+ * Memory is allocated and initialized.
+ *
+ *----------------------------------------------------------------------
+ */
+
+TkTextBTree
+TkBTreeCreate(
+ TkSharedText *sharedTextPtr)
+{
+ register BTree *treePtr;
+ register Node *rootPtr;
+ register TkTextLine *linePtr, *linePtr2;
+ register TkTextSegment *segPtr;
+
+ /*
+ * The tree will initially have two empty lines. The second line isn't
+ * actually part of the tree's contents, but its presence makes several
+ * operations easier. The tree will have one node, which is also the root
+ * of the tree.
+ */
+
+ rootPtr = ckalloc(sizeof(Node));
+ linePtr = ckalloc(sizeof(TkTextLine));
+ linePtr2 = ckalloc(sizeof(TkTextLine));
+
+ rootPtr->parentPtr = NULL;
+ rootPtr->nextPtr = NULL;
+ rootPtr->summaryPtr = NULL;
+ rootPtr->level = 0;
+ rootPtr->children.linePtr = linePtr;
+ rootPtr->numChildren = 2;
+ rootPtr->numLines = 2;
+
+ /*
+ * The tree currently has no registered clients, so all pixel count
+ * pointers are simply NULL.
+ */
+
+ rootPtr->numPixels = NULL;
+ linePtr->pixels = NULL;
+ linePtr2->pixels = NULL;
+
+ linePtr->parentPtr = rootPtr;
+ linePtr->nextPtr = linePtr2;
+ segPtr = ckalloc(CSEG_SIZE(1));
+ linePtr->segPtr = segPtr;
+ segPtr->typePtr = &tkTextCharType;
+ segPtr->nextPtr = NULL;
+ segPtr->size = 1;
+ segPtr->body.chars[0] = '\n';
+ segPtr->body.chars[1] = 0;
+
+ linePtr2->parentPtr = rootPtr;
+ linePtr2->nextPtr = NULL;
+ segPtr = ckalloc(CSEG_SIZE(1));
+ linePtr2->segPtr = segPtr;
+ segPtr->typePtr = &tkTextCharType;
+ segPtr->nextPtr = NULL;
+ segPtr->size = 1;
+ segPtr->body.chars[0] = '\n';
+ segPtr->body.chars[1] = 0;
+
+ treePtr = ckalloc(sizeof(BTree));
+ treePtr->sharedTextPtr = sharedTextPtr;
+ treePtr->rootPtr = rootPtr;
+ treePtr->clients = 0;
+ treePtr->stateEpoch = 0;
+ treePtr->pixelReferences = 0;
+ treePtr->startEndCount = 0;
+ treePtr->startEnd = NULL;
+ treePtr->startEndRef = NULL;
+
+ return (TkTextBTree) treePtr;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkBTreeAddClient --
+ *
+ * This function is called to provide a client with access to a given
+ * B-tree. If the client wishes to make use of the B-tree's pixel height
+ * storage, caching and calculation mechanisms, then a non-negative
+ * 'defaultHeight' must be provided. In this case the return value is a
+ * pixel tree reference which must be provided in all of the B-tree API
+ * which refers to or modifies pixel heights:
+ *
+ * TkBTreeAdjustPixelHeight,
+ * TkBTreeFindPixelLine,
+ * TkBTreeNumPixels,
+ * TkBTreePixelsTo,
+ * (and two private functions AdjustPixelClient, RemovePixelClient).
+ *
+ * If this is not provided, then the above functions must never be called
+ * for this client.
+ *
+ * Results:
+ * The return value is the pixelReference used by the B-tree to refer to
+ * pixel counts for the new client. It should be stored by the caller. If
+ * defaultHeight was negative, then the return value will be -1.
+ *
+ * Side effects:
+ * Memory may be allocated and initialized.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TkBTreeAddClient(
+ TkTextBTree tree, /* B-tree to add a client to. */
+ TkText *textPtr, /* Client to add. */
+ int defaultHeight) /* Default line height for the new client, or
+ * -1 if no pixel heights are to be kept. */
+{
+ register BTree *treePtr = (BTree *) tree;
+
+ if (treePtr == NULL) {
+ Tcl_Panic("NULL treePtr in TkBTreeAddClient");
+ }
+
+ if (textPtr->start != NULL || textPtr->end != NULL) {
+ AdjustStartEndRefs(treePtr, textPtr, TEXT_ADD_REFS);
+ }
+
+ if (defaultHeight >= 0) {
+ TkTextLine *end;
+ int counting = (textPtr->start == NULL ? 1 : 0);
+ int useReference = treePtr->pixelReferences;
+
+ /*
+ * We must set the 'end' value in AdjustPixelClient so that the last
+ * dummy line in the B-tree doesn't contain a pixel height.
+ */
+
+ end = textPtr->end;
+ if (end == NULL) {
+ end = TkBTreeFindLine(tree, NULL, TkBTreeNumLines(tree, NULL));
+ }
+ AdjustPixelClient(treePtr, defaultHeight, treePtr->rootPtr,
+ textPtr->start, end, useReference, useReference+1, &counting);
+
+ textPtr->pixelReference = useReference;
+ treePtr->pixelReferences++;
+ } else {
+ textPtr->pixelReference = -1;
+ }
+ treePtr->clients++;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkBTreeClientRangeChanged --
+ *
+ * Called when the -startline or -endline options of a text widget client
+ * of the B-tree have changed.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Lots of processing of the B-tree is done, with potential for memory to
+ * be allocated and initialized for the pixel heights of the widget.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TkBTreeClientRangeChanged(
+ TkText *textPtr, /* Client whose start, end have changed. */
+ int defaultHeight) /* Default line height for the new client, or
+ * -1 if no pixel heights are to be kept. */
+{
+ TkTextLine *end;
+ BTree *treePtr = (BTree *) textPtr->sharedTextPtr->tree;
+
+ int counting = (textPtr->start == NULL ? 1 : 0);
+ int useReference = textPtr->pixelReference;
+
+ AdjustStartEndRefs(treePtr, textPtr, TEXT_ADD_REFS | TEXT_REMOVE_REFS);
+
+ /*
+ * We must set the 'end' value in AdjustPixelClient so that the last dummy
+ * line in the B-tree doesn't contain a pixel height.
+ */
+
+ end = textPtr->end;
+ if (end == NULL) {
+ end = TkBTreeFindLine(textPtr->sharedTextPtr->tree,
+ NULL, TkBTreeNumLines(textPtr->sharedTextPtr->tree, NULL));
+ }
+ AdjustPixelClient(treePtr, defaultHeight, treePtr->rootPtr,
+ textPtr->start, end, useReference, treePtr->pixelReferences,
+ &counting);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkBTreeDestroy --
+ *
+ * Delete a B-tree, recycling all of the storage it contains.
+ *
+ * Results:
+ * The tree is deleted, so 'tree' should never again be used.
+ *
+ * Side effects:
+ * Memory is freed.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TkBTreeDestroy(
+ TkTextBTree tree) /* Tree to clean up. */
+{
+ BTree *treePtr = (BTree *) tree;
+
+ /*
+ * There's no need to loop over each client of the tree, calling
+ * 'TkBTreeRemoveClient', since the 'DestroyNode' will clean everything up
+ * itself.
+ */
+
+ DestroyNode(treePtr->rootPtr);
+ if (treePtr->startEnd != NULL) {
+ ckfree(treePtr->startEnd);
+ ckfree(treePtr->startEndRef);
+ }
+ ckfree(treePtr);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkBTreeEpoch --
+ *
+ * Return the epoch for the B-tree. This number is incremented any time
+ * anything changes in the tree.
+ *
+ * Results:
+ * The epoch number.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TkBTreeEpoch(
+ TkTextBTree tree) /* Tree to get epoch for. */
+{
+ BTree *treePtr = (BTree *) tree;
+ return treePtr->stateEpoch;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkBTreeRemoveClient --
+ *
+ * Remove a client widget from its B-tree, cleaning up the pixel arrays
+ * which it uses if necessary. If this is the last such widget, we also
+ * destroy the whole tree.
+ *
+ * Results:
+ * All tree-specific aspects of the given client are deleted. If no more
+ * references exist, then the given tree is also deleted (in which case
+ * 'tree' must not be used again).
+ *
+ * Side effects:
+ * Memory may be freed.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TkBTreeRemoveClient(
+ TkTextBTree tree, /* Tree to remove client from. */
+ TkText *textPtr) /* Client to remove. */
+{
+ BTree *treePtr = (BTree *) tree;
+ int pixelReference = textPtr->pixelReference;
+
+ if (treePtr->clients == 1) {
+ /*
+ * The last reference to the tree.
+ */
+
+ DestroyNode(treePtr->rootPtr);
+ ckfree(treePtr);
+ return;
+ } else if (pixelReference == -1) {
+ /*
+ * A client which doesn't care about pixels.
+ */
+
+ treePtr->clients--;
+ } else {
+ /*
+ * Clean up pixel data for the given reference.
+ */
+
+ if (pixelReference == (treePtr->pixelReferences-1)) {
+ /*
+ * The widget we're removing has the last index, so deletion is
+ * easier.
+ */
+
+ RemovePixelClient(treePtr, treePtr->rootPtr, -1);
+ } else {
+ TkText *adjustPtr;
+
+ RemovePixelClient(treePtr, treePtr->rootPtr, pixelReference);
+
+ /*
+ * Now we need to adjust the 'pixelReference' of the peer widget
+ * whose storage we've just moved.
+ */
+
+ adjustPtr = treePtr->sharedTextPtr->peers;
+ while (adjustPtr != NULL) {
+ if (adjustPtr->pixelReference == treePtr->pixelReferences-1) {
+ adjustPtr->pixelReference = pixelReference;
+ break;
+ }
+ adjustPtr = adjustPtr->next;
+ }
+ if (adjustPtr == NULL) {
+ Tcl_Panic("Couldn't find text widget with correct reference");
+ }
+ }
+ treePtr->pixelReferences--;
+ treePtr->clients--;
+ }
+
+ if (textPtr->start != NULL || textPtr->end != NULL) {
+ AdjustStartEndRefs(treePtr, textPtr, TEXT_REMOVE_REFS);
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * AdjustStartEndRefs --
+ *
+ * Modify B-tree's cache of start, end lines for the given text widget.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The number of cached items may change (treePtr->startEndCount).
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+AdjustStartEndRefs(
+ BTree *treePtr, /* The entire B-tree. */
+ TkText *textPtr, /* The text widget for which we want to adjust
+ * it's start and end cache. */
+ int action) /* Action to perform. */
+{
+ if (action & TEXT_REMOVE_REFS) {
+ int i = 0;
+ int count = 0;
+
+ while (i < treePtr->startEndCount) {
+ if (i != count) {
+ treePtr->startEnd[count] = treePtr->startEnd[i];
+ treePtr->startEndRef[count] = treePtr->startEndRef[i];
+ }
+ if (treePtr->startEndRef[i] != textPtr) {
+ count++;
+ }
+ i++;
+ }
+ treePtr->startEndCount = count;
+ treePtr->startEnd = ckrealloc(treePtr->startEnd,
+ sizeof(TkTextLine *) * count);
+ treePtr->startEndRef = ckrealloc(treePtr->startEndRef,
+ sizeof(TkText *) * count);
+ }
+ if ((action & TEXT_ADD_REFS)
+ && (textPtr->start != NULL || textPtr->end != NULL)) {
+ int count;
+
+ if (textPtr->start != NULL) {
+ treePtr->startEndCount++;
+ }
+ if (textPtr->end != NULL) {
+ treePtr->startEndCount++;
+ }
+
+ count = treePtr->startEndCount;
+
+ treePtr->startEnd = ckrealloc(treePtr->startEnd,
+ sizeof(TkTextLine *) * count);
+ treePtr->startEndRef = ckrealloc(treePtr->startEndRef,
+ sizeof(TkText *) * count);
+
+ if (textPtr->start != NULL) {
+ count--;
+ treePtr->startEnd[count] = textPtr->start;
+ treePtr->startEndRef[count] = textPtr;
+ }
+ if (textPtr->end != NULL) {
+ count--;
+ treePtr->startEnd[count] = textPtr->end;
+ treePtr->startEndRef[count] = textPtr;
+ }
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * AdjustPixelClient --
+ *
+ * Utility function used to update all data structures for the existence
+ * of a new peer widget based on this B-tree, or for the modification of
+ * the start, end lines of an existing peer widget.
+ *
+ * Immediately _after_ calling this, treePtr->pixelReferences and
+ * treePtr->clients should be adjusted if needed (i.e. if this is a new
+ * peer).
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * All the storage for Nodes and TkTextLines in the tree may be adjusted.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+AdjustPixelClient(
+ BTree *treePtr, /* Pointer to tree. */
+ int defaultHeight, /* Default pixel line height, which can be
+ * zero. */
+ Node *nodePtr, /* Adjust from this node downwards. */
+ TkTextLine *start, /* First line for this pixel client. */
+ TkTextLine *end, /* Last line for this pixel client. */
+ int useReference, /* pixel reference for the client we are
+ * adding or changing. */
+ int newPixelReferences, /* New number of pixel references to this
+ * B-tree. */
+ int *counting) /* References an integer which is zero if
+ * we're outside the relevant range for this
+ * client, and 1 if we're inside. */
+{
+ int pixelCount = 0;
+
+ /*
+ * Traverse entire tree down from nodePtr, reallocating pixel structures
+ * for each Node and TkTextLine, adding room for the new peer's pixel
+ * information (1 extra int per Node, 2 extra ints per TkTextLine). Also
+ * copy the information from the last peer into the new space (so it
+ * contains something sensible).
+ */
+
+ if (nodePtr->level != 0) {
+ Node *loopPtr = nodePtr->children.nodePtr;
+
+ while (loopPtr != NULL) {
+ pixelCount += AdjustPixelClient(treePtr, defaultHeight, loopPtr,
+ start, end, useReference, newPixelReferences, counting);
+ loopPtr = loopPtr->nextPtr;
+ }
+ } else {
+ register TkTextLine *linePtr = nodePtr->children.linePtr;
+
+ while (linePtr != NULL) {
+ if (!*counting && (linePtr == start)) {
+ *counting = 1;
+ }
+ if (*counting && (linePtr == end)) {
+ *counting = 0;
+ }
+ if (newPixelReferences != treePtr->pixelReferences) {
+ linePtr->pixels = ckrealloc(linePtr->pixels,
+ sizeof(int) * 2 * newPixelReferences);
+ }
+
+ /*
+ * Notice that for the very last line, we are never counting and
+ * therefore this always has a height of 0 and an epoch of 1.
+ */
+
+ linePtr->pixels[2*useReference] = (*counting ? defaultHeight : 0);
+ linePtr->pixels[2*useReference+1] = (*counting ? 0 : 1);
+ pixelCount += linePtr->pixels[2*useReference];
+
+ linePtr = linePtr->nextPtr;
+ }
+ }
+ if (newPixelReferences != treePtr->pixelReferences) {
+ nodePtr->numPixels = ckrealloc(nodePtr->numPixels,
+ sizeof(int) * newPixelReferences);
+ }
+ nodePtr->numPixels[useReference] = pixelCount;
+ return pixelCount;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * RemovePixelClient --
+ *
+ * Utility function used to update all data structures for the removal of
+ * a peer widget which used to be based on this B-tree.
+ *
+ * Immediately _after_ calling this, treePtr->clients should be
+ * decremented.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * All the storage for Nodes and TkTextLines in the tree may be adjusted.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+RemovePixelClient(
+ BTree *treePtr, /* Pointer to tree. */
+ Node *nodePtr, /* Adjust from this node downwards. */
+ int overwriteWithLast) /* Over-write this peer widget's information
+ * with the last one. */
+{
+ /*
+ * Traverse entire tree down from nodePtr, reallocating pixel structures
+ * for each Node and TkTextLine, removing space allocated for one peer. If
+ * 'overwriteWithLast' is not -1, then copy the information which was in
+ * the last slot on top of one of the others (i.e. it's not the last one
+ * we're deleting).
+ */
+
+ if (overwriteWithLast != -1) {
+ nodePtr->numPixels[overwriteWithLast] =
+ nodePtr->numPixels[treePtr->pixelReferences-1];
+ }
+ if (treePtr->pixelReferences == 1) {
+ nodePtr->numPixels = NULL;
+ } else {
+ nodePtr->numPixels = ckrealloc(nodePtr->numPixels,
+ sizeof(int) * (treePtr->pixelReferences - 1));
+ }
+ if (nodePtr->level != 0) {
+ nodePtr = nodePtr->children.nodePtr;
+ while (nodePtr != NULL) {
+ RemovePixelClient(treePtr, nodePtr, overwriteWithLast);
+ nodePtr = nodePtr->nextPtr;
+ }
+ } else {
+ register TkTextLine *linePtr = nodePtr->children.linePtr;
+ while (linePtr != NULL) {
+ if (overwriteWithLast != -1) {
+ linePtr->pixels[2*overwriteWithLast] =
+ linePtr->pixels[2*(treePtr->pixelReferences-1)];
+ linePtr->pixels[1+2*overwriteWithLast] =
+ linePtr->pixels[1+2*(treePtr->pixelReferences-1)];
+ }
+ if (treePtr->pixelReferences == 1) {
+ linePtr->pixels = NULL;
+ } else {
+ linePtr->pixels = ckrealloc(linePtr->pixels,
+ sizeof(int) * 2 * (treePtr->pixelReferences-1));
+ }
+ linePtr = linePtr->nextPtr;
+ }
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * DestroyNode --
+ *
+ * This is a recursive utility function used during the deletion of a
+ * B-tree.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * All the storage for nodePtr and its descendants is freed.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+DestroyNode(
+ register Node *nodePtr) /* Destroy from this node downwards. */
+{
+ if (nodePtr->level == 0) {
+ TkTextLine *linePtr;
+ TkTextSegment *segPtr;
+
+ while (nodePtr->children.linePtr != NULL) {
+ linePtr = nodePtr->children.linePtr;
+ nodePtr->children.linePtr = linePtr->nextPtr;
+ while (linePtr->segPtr != NULL) {
+ segPtr = linePtr->segPtr;
+ linePtr->segPtr = segPtr->nextPtr;
+ segPtr->typePtr->deleteProc(segPtr, linePtr, 1);
+ }
+ ckfree(linePtr->pixels);
+ ckfree(linePtr);
+ }
+ } else {
+ register Node *childPtr;
+
+ while (nodePtr->children.nodePtr != NULL) {
+ childPtr = nodePtr->children.nodePtr;
+ nodePtr->children.nodePtr = childPtr->nextPtr;
+ DestroyNode(childPtr);
+ }
+ }
+ DeleteSummaries(nodePtr->summaryPtr);
+ ckfree(nodePtr->numPixels);
+ ckfree(nodePtr);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * DeleteSummaries --
+ *
+ * Free up all of the memory in a list of tag summaries associated with a
+ * node.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Storage is released.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+DeleteSummaries(
+ register Summary *summaryPtr)
+ /* First in list of node's tag summaries. */
+{
+ register Summary *nextPtr;
+
+ while (summaryPtr != NULL) {
+ nextPtr = summaryPtr->nextPtr;
+ ckfree(summaryPtr);
+ summaryPtr = nextPtr;
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkBTreeAdjustPixelHeight --
+ *
+ * Adjust the pixel height of a given logical line to the specified
+ * value.
+ *
+ * Results:
+ * Total number of valid pixels currently known in the tree.
+ *
+ * Side effects:
+ * Updates overall data structures so pixel height count is consistent.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TkBTreeAdjustPixelHeight(
+ const TkText *textPtr, /* Client of the B-tree. */
+ register TkTextLine *linePtr,
+ /* The logical line to update. */
+ int newPixelHeight, /* The line's known height in pixels. */
+ int mergedLogicalLines) /* The number of extra logical lines which
+ * have been merged with this one (due to
+ * elided eols). They will have their pixel
+ * height set to zero, and the total pixel
+ * height associated with the given
+ * linePtr. */
+{
+ register Node *nodePtr;
+ int changeToPixelCount; /* Counts change to total number of pixels in
+ * file. */
+ int pixelReference = textPtr->pixelReference;
+
+ changeToPixelCount = newPixelHeight - linePtr->pixels[2 * pixelReference];
+
+ /*
+ * Increment the pixel counts in all the parent nodes of the current line,
+ * then rebalance the tree if necessary.
+ */
+
+ nodePtr = linePtr->parentPtr;
+ nodePtr->numPixels[pixelReference] += changeToPixelCount;
+
+ while (nodePtr->parentPtr != NULL) {
+ nodePtr = nodePtr->parentPtr;
+ nodePtr->numPixels[pixelReference] += changeToPixelCount;
+ }
+
+ linePtr->pixels[2 * pixelReference] = newPixelHeight;
+
+ /*
+ * Any merged logical lines must have their height set to zero.
+ */
+
+ while (mergedLogicalLines-- > 0) {
+ linePtr = TkBTreeNextLine(textPtr, linePtr);
+ TkBTreeAdjustPixelHeight(textPtr, linePtr, 0, 0);
+ }
+
+ /*
+ * Return total number of pixels in the tree.
+ */
+
+ return nodePtr->numPixels[pixelReference];
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkBTreeInsertChars --
+ *
+ * Insert characters at a given position in a B-tree.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Characters are added to the B-tree at the given position. If the
+ * string contains newlines, new lines will be added, which could cause
+ * the structure of the B-tree to change.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TkBTreeInsertChars(
+ TkTextBTree tree, /* Tree to insert into. */
+ register TkTextIndex *indexPtr,
+ /* Indicates where to insert text. When the
+ * function returns, this index is no longer
+ * valid because of changes to the segment
+ * structure. */
+ const char *string) /* Pointer to bytes to insert (may contain
+ * newlines, must be null-terminated). */
+{
+ register Node *nodePtr;
+ register TkTextSegment *prevPtr;
+ /* The segment just before the first new
+ * segment (NULL means new segment is at
+ * beginning of line). */
+ TkTextSegment *curPtr; /* Current segment; new characters are
+ * inserted just after this one. NULL means
+ * insert at beginning of line. */
+ TkTextLine *linePtr; /* Current line (new segments are added to
+ * this line). */
+ register TkTextSegment *segPtr;
+ TkTextLine *newLinePtr;
+ int chunkSize; /* # characters in current chunk. */
+ register const char *eol; /* Pointer to character just after last one in
+ * current chunk. */
+ int changeToLineCount; /* Counts change to total number of lines in
+ * file. */
+ int *changeToPixelCount; /* Counts change to total number of pixels in
+ * file. */
+ int ref;
+ int pixels[PIXEL_CLIENTS];
+
+ BTree *treePtr = (BTree *) tree;
+ treePtr->stateEpoch++;
+ prevPtr = SplitSeg(indexPtr);
+ linePtr = indexPtr->linePtr;
+ curPtr = prevPtr;
+
+ /*
+ * Chop the string up into lines and create a new segment for each line,
+ * plus a new line for the leftovers from the previous line.
+ */
+
+ changeToLineCount = 0;
+ if (treePtr->pixelReferences > PIXEL_CLIENTS) {
+ changeToPixelCount = ckalloc(sizeof(int) * treePtr->pixelReferences);
+ } else {
+ changeToPixelCount = pixels;
+ }
+ for (ref = 0; ref < treePtr->pixelReferences; ref++) {
+ changeToPixelCount[ref] = 0;
+ }
+
+ while (*string != 0) {
+ for (eol = string; *eol != 0; eol++) {
+ if (*eol == '\n') {
+ eol++;
+ break;
+ }
+ }
+ chunkSize = eol-string;
+ segPtr = ckalloc(CSEG_SIZE(chunkSize));
+ segPtr->typePtr = &tkTextCharType;
+ if (curPtr == NULL) {
+ segPtr->nextPtr = linePtr->segPtr;
+ linePtr->segPtr = segPtr;
+ } else {
+ segPtr->nextPtr = curPtr->nextPtr;
+ curPtr->nextPtr = segPtr;
+ }
+ segPtr->size = chunkSize;
+ memcpy(segPtr->body.chars, string, (size_t) chunkSize);
+ segPtr->body.chars[chunkSize] = 0;
+
+ if (eol[-1] != '\n') {
+ break;
+ }
+
+ /*
+ * The chunk ended with a newline, so create a new TkTextLine and move
+ * the remainder of the old line to it.
+ */
+
+ newLinePtr = ckalloc(sizeof(TkTextLine));
+ newLinePtr->pixels =
+ ckalloc(sizeof(int) * 2 * treePtr->pixelReferences);
+
+ newLinePtr->parentPtr = linePtr->parentPtr;
+ newLinePtr->nextPtr = linePtr->nextPtr;
+ linePtr->nextPtr = newLinePtr;
+ newLinePtr->segPtr = segPtr->nextPtr;
+
+ /*
+ * Set up a starting default height, which will be re-adjusted later.
+ * We need to do this for each referenced widget.
+ */
+
+ for (ref = 0; ref < treePtr->pixelReferences; ref++) {
+ newLinePtr->pixels[2 * ref] = linePtr->pixels[2 * ref];
+ newLinePtr->pixels[2 * ref + 1] = 0;
+ changeToPixelCount[ref] += newLinePtr->pixels[2 * ref];
+ }
+
+ segPtr->nextPtr = NULL;
+ linePtr = newLinePtr;
+ curPtr = NULL;
+ changeToLineCount++;
+
+ string = eol;
+ }
+
+ /*
+ * I don't believe it's possible for either of the two lines passed to
+ * this function to be the last line of text, but the function is robust
+ * to that case anyway. (We must never re-calculate the line height of
+ * the last line).
+ */
+
+ TkTextInvalidateLineMetrics(treePtr->sharedTextPtr, NULL,
+ indexPtr->linePtr, changeToLineCount, TK_TEXT_INVALIDATE_INSERT);
+
+ /*
+ * Cleanup the starting line for the insertion, plus the ending line if
+ * it's different.
+ */
+
+ CleanupLine(indexPtr->linePtr);
+ if (linePtr != indexPtr->linePtr) {
+ CleanupLine(linePtr);
+ }
+
+ /*
+ * Increment the line and pixel counts in all the parent nodes of the
+ * insertion point, then rebalance the tree if necessary.
+ */
+
+ for (nodePtr = linePtr->parentPtr ; nodePtr != NULL;
+ nodePtr = nodePtr->parentPtr) {
+ nodePtr->numLines += changeToLineCount;
+ for (ref = 0; ref < treePtr->pixelReferences; ref++) {
+ nodePtr->numPixels[ref] += changeToPixelCount[ref];
+ }
+ }
+ if (treePtr->pixelReferences > PIXEL_CLIENTS) {
+ ckfree(changeToPixelCount);
+ }
+
+ nodePtr = linePtr->parentPtr;
+ nodePtr->numChildren += changeToLineCount;
+ if (nodePtr->numChildren > MAX_CHILDREN) {
+ Rebalance(treePtr, nodePtr);
+ }
+
+ if (tkBTreeDebug) {
+ TkBTreeCheck(indexPtr->tree);
+ }
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * SplitSeg --
+ *
+ * This function is called before adding or deleting segments. It does
+ * three things: (a) it finds the segment containing indexPtr; (b) if
+ * there are several such segments (because some segments have zero
+ * length) then it picks the first segment that does not have left
+ * gravity; (c) if the index refers to the middle of a segment then it
+ * splits the segment so that the index now refers to the beginning of a
+ * segment.
+ *
+ * Results:
+ * The return value is a pointer to the segment just before the segment
+ * corresponding to indexPtr (as described above). If the segment
+ * corresponding to indexPtr is the first in its line then the return
+ * value is NULL.
+ *
+ * Side effects:
+ * The segment referred to by indexPtr is split unless indexPtr refers to
+ * its first character.
+ *
+ *--------------------------------------------------------------
+ */
+
+static TkTextSegment *
+SplitSeg(
+ TkTextIndex *indexPtr) /* Index identifying position at which to
+ * split a segment. */
+{
+ TkTextSegment *prevPtr, *segPtr;
+ TkTextLine *linePtr;
+ int count = indexPtr->byteIndex;
+
+ linePtr = indexPtr->linePtr;
+ prevPtr = NULL;
+ segPtr = linePtr->segPtr;
+
+ while (segPtr != NULL) {
+ if (segPtr->size > count) {
+ if (count == 0) {
+ return prevPtr;
+ }
+ segPtr = segPtr->typePtr->splitProc(segPtr, count);
+ if (prevPtr == NULL) {
+ indexPtr->linePtr->segPtr = segPtr;
+ } else {
+ prevPtr->nextPtr = segPtr;
+ }
+ return segPtr;
+ } else if ((segPtr->size == 0) && (count == 0)
+ && !segPtr->typePtr->leftGravity) {
+ return prevPtr;
+ }
+
+ count -= segPtr->size;
+ prevPtr = segPtr;
+ segPtr = segPtr->nextPtr;
+ if (segPtr == NULL) {
+ /*
+ * Two logical lines merged into one display line through eliding
+ * of a newline.
+ */
+
+ linePtr = TkBTreeNextLine(NULL, linePtr);
+ if (linePtr == NULL) {
+ /*
+ * Reached end of the text.
+ */
+ } else {
+ segPtr = linePtr->segPtr;
+ }
+ }
+ }
+ Tcl_Panic("SplitSeg reached end of line!");
+ return NULL;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * CleanupLine --
+ *
+ * This function is called after modifications have been made to a line.
+ * It scans over all of the segments in the line, giving each a chance to
+ * clean itself up, e.g. by merging with the following segments, updating
+ * internal information, etc.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Depends on what the segment-specific cleanup functions do.
+ *
+ *--------------------------------------------------------------
+ */
+
+static void
+CleanupLine(
+ TkTextLine *linePtr) /* Line to be cleaned up. */
+{
+ TkTextSegment *segPtr, **prevPtrPtr;
+ int anyChanges;
+
+ /*
+ * Make a pass over all of the segments in the line, giving each a chance
+ * to clean itself up. This could potentially change the structure of the
+ * line, e.g. by merging two segments together or having two segments
+ * cancel themselves; if so, then repeat the whole process again, since
+ * the first structure change might make other structure changes possible.
+ * Repeat until eventually there are no changes.
+ */
+
+ while (1) {
+ anyChanges = 0;
+ for (prevPtrPtr = &linePtr->segPtr, segPtr = *prevPtrPtr;
+ segPtr != NULL;
+ prevPtrPtr = &(*prevPtrPtr)->nextPtr, segPtr = *prevPtrPtr) {
+ if (segPtr->typePtr->cleanupProc != NULL) {
+ *prevPtrPtr = segPtr->typePtr->cleanupProc(segPtr, linePtr);
+ if (segPtr != *prevPtrPtr) {
+ anyChanges = 1;
+ }
+ }
+ }
+ if (!anyChanges) {
+ break;
+ }
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkBTreeDeleteIndexRange --
+ *
+ * Delete a range of characters from a B-tree. The caller must make sure
+ * that the final newline of the B-tree is never deleted.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Information is deleted from the B-tree. This can cause the internal
+ * structure of the B-tree to change. Note: because of changes to the
+ * B-tree structure, the indices pointed to by index1Ptr and index2Ptr
+ * should not be used after this function returns.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TkBTreeDeleteIndexRange(
+ TkTextBTree tree, /* Tree to delete from. */
+ register TkTextIndex *index1Ptr,
+ /* Indicates first character that is to be
+ * deleted. */
+ register TkTextIndex *index2Ptr)
+ /* Indicates character just after the last one
+ * that is to be deleted. */
+{
+ TkTextSegment *prevPtr; /* The segment just before the start of the
+ * deletion range. */
+ TkTextSegment *lastPtr; /* The segment just after the end of the
+ * deletion range. */
+ TkTextSegment *segPtr, *nextPtr;
+ TkTextLine *curLinePtr;
+ Node *curNodePtr, *nodePtr;
+ int changeToLineCount = 0;
+ int ref;
+ BTree *treePtr = (BTree *) tree;
+
+ treePtr->stateEpoch++;
+
+ /*
+ * Tricky point: split at index2Ptr first; otherwise the split at
+ * index2Ptr may invalidate segPtr and/or prevPtr.
+ */
+
+ lastPtr = SplitSeg(index2Ptr);
+ if (lastPtr != NULL) {
+ lastPtr = lastPtr->nextPtr;
+ } else {
+ lastPtr = index2Ptr->linePtr->segPtr;
+ }
+ prevPtr = SplitSeg(index1Ptr);
+ if (prevPtr != NULL) {
+ segPtr = prevPtr->nextPtr;
+ prevPtr->nextPtr = lastPtr;
+ } else {
+ segPtr = index1Ptr->linePtr->segPtr;
+ index1Ptr->linePtr->segPtr = lastPtr;
+ }
+
+ /*
+ * Delete all of the segments between prevPtr and lastPtr.
+ */
+
+ curLinePtr = index1Ptr->linePtr;
+
+ curNodePtr = curLinePtr->parentPtr;
+ while (segPtr != lastPtr) {
+ if (segPtr == NULL) {
+ TkTextLine *nextLinePtr;
+
+ /*
+ * We just ran off the end of a line. First find the next line,
+ * then go back to the old line and delete it (unless it's the
+ * starting line for the range).
+ */
+
+ nextLinePtr = TkBTreeNextLine(NULL, curLinePtr);
+ if (curLinePtr != index1Ptr->linePtr) {
+ if (curNodePtr == index1Ptr->linePtr->parentPtr) {
+ index1Ptr->linePtr->nextPtr = curLinePtr->nextPtr;
+ } else {
+ curNodePtr->children.linePtr = curLinePtr->nextPtr;
+ }
+ for (nodePtr = curNodePtr; nodePtr != NULL;
+ nodePtr = nodePtr->parentPtr) {
+ nodePtr->numLines--;
+ for (ref = 0; ref < treePtr->pixelReferences; ref++) {
+ nodePtr->numPixels[ref] -= curLinePtr->pixels[2*ref];
+ }
+ }
+ changeToLineCount++;
+ CLANG_ASSERT(curNodePtr);
+ curNodePtr->numChildren--;
+
+ /*
+ * Check if we need to adjust any partial clients.
+ */
+
+ if (treePtr->startEnd != NULL) {
+ int checkCount = 0;
+
+ while (checkCount < treePtr->startEndCount) {
+ if (treePtr->startEnd[checkCount] == curLinePtr) {
+ TkText *peer = treePtr->startEndRef[checkCount];
+
+ /*
+ * We're deleting a line which is the start or end
+ * of a current client. This means we need to
+ * adjust that client.
+ */
+
+ treePtr->startEnd[checkCount] = nextLinePtr;
+ if (peer->start == curLinePtr) {
+ peer->start = nextLinePtr;
+ }
+ if (peer->end == curLinePtr) {
+ peer->end = nextLinePtr;
+ }
+ }
+ checkCount++;
+ }
+ }
+ ckfree(curLinePtr->pixels);
+ ckfree(curLinePtr);
+ }
+ curLinePtr = nextLinePtr;
+ segPtr = curLinePtr->segPtr;
+
+ /*
+ * If the node is empty then delete it and its parents recursively
+ * upwards until a non-empty node is found.
+ */
+
+ while (curNodePtr->numChildren == 0) {
+ Node *parentPtr;
+
+ parentPtr = curNodePtr->parentPtr;
+ if (parentPtr->children.nodePtr == curNodePtr) {
+ parentPtr->children.nodePtr = curNodePtr->nextPtr;
+ } else {
+ Node *prevNodePtr = parentPtr->children.nodePtr;
+ while (prevNodePtr->nextPtr != curNodePtr) {
+ prevNodePtr = prevNodePtr->nextPtr;
+ }
+ prevNodePtr->nextPtr = curNodePtr->nextPtr;
+ }
+ parentPtr->numChildren--;
+ ckfree(curNodePtr);
+ curNodePtr = parentPtr;
+ }
+ curNodePtr = curLinePtr->parentPtr;
+ continue;
+ }
+
+ nextPtr = segPtr->nextPtr;
+ if (segPtr->typePtr->deleteProc(segPtr, curLinePtr, 0) != 0) {
+ /*
+ * This segment refuses to die. Move it to prevPtr and advance
+ * prevPtr if the segment has left gravity.
+ */
+
+ if (prevPtr == NULL) {
+ segPtr->nextPtr = index1Ptr->linePtr->segPtr;
+ index1Ptr->linePtr->segPtr = segPtr;
+ } else {
+ segPtr->nextPtr = prevPtr->nextPtr;
+ prevPtr->nextPtr = segPtr;
+ }
+ if (segPtr->typePtr->leftGravity) {
+ prevPtr = segPtr;
+ }
+ }
+ segPtr = nextPtr;
+ }
+
+ /*
+ * If the beginning and end of the deletion range are in different lines,
+ * join the two lines together and discard the ending line.
+ */
+
+ if (index1Ptr->linePtr != index2Ptr->linePtr) {
+ TkTextLine *prevLinePtr;
+
+ for (segPtr = lastPtr; segPtr != NULL;
+ segPtr = segPtr->nextPtr) {
+ if (segPtr->typePtr->lineChangeProc != NULL) {
+ segPtr->typePtr->lineChangeProc(segPtr, index2Ptr->linePtr);
+ }
+ }
+ curNodePtr = index2Ptr->linePtr->parentPtr;
+ for (nodePtr = curNodePtr; nodePtr != NULL;
+ nodePtr = nodePtr->parentPtr) {
+ nodePtr->numLines--;
+ for (ref = 0; ref < treePtr->pixelReferences; ref++) {
+ nodePtr->numPixels[ref] -= index2Ptr->linePtr->pixels[2*ref];
+ }
+ }
+ changeToLineCount++;
+ curNodePtr->numChildren--;
+ prevLinePtr = curNodePtr->children.linePtr;
+ if (prevLinePtr == index2Ptr->linePtr) {
+ curNodePtr->children.linePtr = index2Ptr->linePtr->nextPtr;
+ } else {
+ while (prevLinePtr->nextPtr != index2Ptr->linePtr) {
+ prevLinePtr = prevLinePtr->nextPtr;
+ }
+ prevLinePtr->nextPtr = index2Ptr->linePtr->nextPtr;
+ }
+
+ /*
+ * Check if we need to adjust any partial clients. In this case if
+ * we're deleting the line, we actually move back to the previous line
+ * for our (start,end) storage. We do this because we still want the
+ * portion of the second line that still exists to be in the start,end
+ * range.
+ */
+
+ if (treePtr->startEnd != NULL) {
+ int checkCount = 0;
+
+ while (checkCount < treePtr->startEndCount &&
+ treePtr->startEnd[checkCount] != NULL) {
+ if (treePtr->startEnd[checkCount] == index2Ptr->linePtr) {
+ TkText *peer = treePtr->startEndRef[checkCount];
+
+ /*
+ * We're deleting a line which is the start or end of a
+ * current client. This means we need to adjust that
+ * client.
+ */
+
+ treePtr->startEnd[checkCount] = index1Ptr->linePtr;
+ if (peer->start == index2Ptr->linePtr) {
+ peer->start = index1Ptr->linePtr;
+ }
+ if (peer->end == index2Ptr->linePtr) {
+ peer->end = index1Ptr->linePtr;
+ }
+ }
+ checkCount++;
+ }
+ }
+ ckfree(index2Ptr->linePtr->pixels);
+ ckfree(index2Ptr->linePtr);
+
+ Rebalance((BTree *) index2Ptr->tree, curNodePtr);
+ }
+
+ /*
+ * Cleanup the segments in the new line.
+ */
+
+ CleanupLine(index1Ptr->linePtr);
+
+ /*
+ * This line now needs to have its height recalculated. For safety, ensure
+ * we don't call this function with the last artificial line of text. I
+ * _believe_ that it isn't possible to get this far with the last line,
+ * but it is good to be safe.
+ */
+
+ if (TkBTreeNextLine(NULL, index1Ptr->linePtr) != NULL) {
+ TkTextInvalidateLineMetrics(treePtr->sharedTextPtr, NULL,
+ index1Ptr->linePtr, changeToLineCount,
+ TK_TEXT_INVALIDATE_DELETE);
+ }
+
+ /*
+ * Lastly, rebalance the first node of the range.
+ */
+
+ Rebalance((BTree *) index1Ptr->tree, index1Ptr->linePtr->parentPtr);
+ if (tkBTreeDebug) {
+ TkBTreeCheck(index1Ptr->tree);
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkBTreeFindLine --
+ *
+ * Find a particular line in a B-tree based on its line number.
+ *
+ * Results:
+ * The return value is a pointer to the line structure for the line whose
+ * index is "line", or NULL if no such line exists.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+TkTextLine *
+TkBTreeFindLine(
+ TkTextBTree tree, /* B-tree in which to find line. */
+ const TkText *textPtr, /* Relative to this client of the B-tree. */
+ int line) /* Index of desired line. */
+{
+ BTree *treePtr = (BTree *) tree;
+ register Node *nodePtr;
+ register TkTextLine *linePtr;
+
+ if (treePtr == NULL) {
+ treePtr = (BTree *) textPtr->sharedTextPtr->tree;
+ }
+
+ nodePtr = treePtr->rootPtr;
+ if ((line < 0) || (line >= nodePtr->numLines)) {
+ return NULL;
+ }
+
+ /*
+ * Check for any start/end offset for this text widget.
+ */
+
+ if (textPtr != NULL) {
+ if (textPtr->start != NULL) {
+ line += TkBTreeLinesTo(NULL, textPtr->start);
+ if (line >= nodePtr->numLines) {
+ return NULL;
+ }
+ }
+ if (textPtr->end != NULL) {
+ if (line > TkBTreeLinesTo(NULL, textPtr->end)) {
+ return NULL;
+ }
+ }
+ }
+
+ /*
+ * Work down through levels of the tree until a node is found at level 0.
+ */
+
+ while (nodePtr->level != 0) {
+ for (nodePtr = nodePtr->children.nodePtr;
+ nodePtr->numLines <= line;
+ nodePtr = nodePtr->nextPtr) {
+ if (nodePtr == NULL) {
+ Tcl_Panic("TkBTreeFindLine ran out of nodes");
+ }
+ line -= nodePtr->numLines;
+ }
+ }
+
+ /*
+ * Work through the lines attached to the level-0 node.
+ */
+
+ for (linePtr = nodePtr->children.linePtr; line > 0;
+ linePtr = linePtr->nextPtr) {
+ if (linePtr == NULL) {
+ Tcl_Panic("TkBTreeFindLine ran out of lines");
+ }
+ line -= 1;
+ }
+ return linePtr;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkBTreeFindPixelLine --
+ *
+ * Find a particular line in a B-tree based on its pixel count.
+ *
+ * Results:
+ * The return value is a pointer to the line structure for the line which
+ * contains the pixel "pixels", or NULL if no such line exists. If the
+ * first line is of height 20, then pixels 0-19 will return it, and
+ * pixels = 20 will return the next line.
+ *
+ * If pixelOffset is non-NULL, it is set to the amount by which 'pixels'
+ * exceeds the first pixel located on the returned line. This should
+ * always be non-negative.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+TkTextLine *
+TkBTreeFindPixelLine(
+ TkTextBTree tree, /* B-tree to use. */
+ const TkText *textPtr, /* Relative to this client of the B-tree. */
+ int pixels, /* Pixel index of desired line. */
+ int *pixelOffset) /* Used to return offset. */
+{
+ BTree *treePtr = (BTree *) tree;
+ register Node *nodePtr;
+ register TkTextLine *linePtr;
+ int pixelReference = textPtr->pixelReference;
+
+ nodePtr = treePtr->rootPtr;
+
+ if ((pixels < 0) || (pixels > nodePtr->numPixels[pixelReference])) {
+ return NULL;
+ }
+
+ if (nodePtr->numPixels[pixelReference] == 0) {
+ Tcl_Panic("TkBTreeFindPixelLine called with empty window");
+ }
+
+ /*
+ * Work down through levels of the tree until a node is found at level 0.
+ */
+
+ while (nodePtr->level != 0) {
+ for (nodePtr = nodePtr->children.nodePtr;
+ nodePtr->numPixels[pixelReference] <= pixels;
+ nodePtr = nodePtr->nextPtr) {
+ if (nodePtr == NULL) {
+ Tcl_Panic("TkBTreeFindPixelLine ran out of nodes");
+ }
+ pixels -= nodePtr->numPixels[pixelReference];
+ }
+ }
+
+ /*
+ * Work through the lines attached to the level-0 node.
+ */
+
+ for (linePtr = nodePtr->children.linePtr;
+ linePtr->pixels[2 * pixelReference] < pixels;
+ linePtr = linePtr->nextPtr) {
+ if (linePtr == NULL) {
+ Tcl_Panic("TkBTreeFindPixelLine ran out of lines");
+ }
+ pixels -= linePtr->pixels[2 * pixelReference];
+ }
+ if (pixelOffset != NULL && linePtr != NULL) {
+ *pixelOffset = pixels;
+ }
+ return linePtr;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkBTreeNextLine --
+ *
+ * Given an existing line in a B-tree, this function locates the next
+ * line in the B-tree. This function is used for scanning through the
+ * B-tree.
+ *
+ * Results:
+ * The return value is a pointer to the line that immediately follows
+ * linePtr, or NULL if there is no such line.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+TkTextLine *
+TkBTreeNextLine(
+ const TkText *textPtr, /* Next line in the context of this client. */
+ register TkTextLine *linePtr)
+ /* Pointer to existing line in B-tree. */
+{
+ register Node *nodePtr;
+
+ if (linePtr->nextPtr != NULL) {
+ if (textPtr != NULL && (linePtr == textPtr->end)) {
+ return NULL;
+ } else {
+ return linePtr->nextPtr;
+ }
+ }
+
+ /*
+ * This was the last line associated with the particular parent node.
+ * Search up the tree for the next node, then search down from that node
+ * to find the first line.
+ */
+
+ for (nodePtr = linePtr->parentPtr; ; nodePtr = nodePtr->parentPtr) {
+ if (nodePtr->nextPtr != NULL) {
+ nodePtr = nodePtr->nextPtr;
+ break;
+ }
+ if (nodePtr->parentPtr == NULL) {
+ return NULL;
+ }
+ }
+ while (nodePtr->level > 0) {
+ nodePtr = nodePtr->children.nodePtr;
+ }
+ return nodePtr->children.linePtr;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkBTreePreviousLine --
+ *
+ * Given an existing line in a B-tree, this function locates the previous
+ * line in the B-tree. This function is used for scanning through the
+ * B-tree in the reverse direction.
+ *
+ * Results:
+ * The return value is a pointer to the line that immediately preceeds
+ * linePtr, or NULL if there is no such line.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+TkTextLine *
+TkBTreePreviousLine(
+ TkText *textPtr, /* Relative to this client of the B-tree. */
+ register TkTextLine *linePtr)
+ /* Pointer to existing line in B-tree. */
+{
+ register Node *nodePtr;
+ register Node *node2Ptr;
+ register TkTextLine *prevPtr;
+
+ if (textPtr != NULL && textPtr->start == linePtr) {
+ return NULL;
+ }
+
+ /*
+ * Find the line under this node just before the starting line.
+ */
+
+ prevPtr = linePtr->parentPtr->children.linePtr; /* First line at leaf. */
+ while (prevPtr != linePtr) {
+ if (prevPtr->nextPtr == linePtr) {
+ return prevPtr;
+ }
+ prevPtr = prevPtr->nextPtr;
+ if (prevPtr == NULL) {
+ Tcl_Panic("TkBTreePreviousLine ran out of lines");
+ }
+ }
+
+ /*
+ * This was the first line associated with the particular parent node.
+ * Search up the tree for the previous node, then search down from that
+ * node to find its last line.
+ */
+
+ for (nodePtr = linePtr->parentPtr; ; nodePtr = nodePtr->parentPtr) {
+ if (nodePtr == NULL || nodePtr->parentPtr == NULL) {
+ return NULL;
+ }
+ if (nodePtr != nodePtr->parentPtr->children.nodePtr) {
+ break;
+ }
+ }
+ for (node2Ptr = nodePtr->parentPtr->children.nodePtr; ;
+ node2Ptr = node2Ptr->children.nodePtr) {
+ while (node2Ptr->nextPtr != nodePtr) {
+ node2Ptr = node2Ptr->nextPtr;
+ }
+ if (node2Ptr->level == 0) {
+ break;
+ }
+ nodePtr = NULL;
+ }
+ for (prevPtr = node2Ptr->children.linePtr ; ; prevPtr = prevPtr->nextPtr) {
+ if (prevPtr->nextPtr == NULL) {
+ return prevPtr;
+ }
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkBTreePixelsTo --
+ *
+ * Given a pointer to a line in a B-tree, return the numerical pixel
+ * index of the top of that line (i.e. the result does not include the
+ * height of the given line).
+ *
+ * Since the last line of text (the artificial one) has zero height by
+ * defintion, calling this with the last line will return the total
+ * number of pixels in the widget.
+ *
+ * Results:
+ * The result is the pixel height of the top of the given line.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TkBTreePixelsTo(
+ const TkText *textPtr, /* Relative to this client of the B-tree. */
+ TkTextLine *linePtr) /* Pointer to existing line in B-tree. */
+{
+ register TkTextLine *linePtr2;
+ register Node *nodePtr, *parentPtr;
+ int index;
+ int pixelReference = textPtr->pixelReference;
+
+ /*
+ * First count how many pixels precede this line in its level-0 node.
+ */
+
+ nodePtr = linePtr->parentPtr;
+ index = 0;
+ for (linePtr2 = nodePtr->children.linePtr; linePtr2 != linePtr;
+ linePtr2 = linePtr2->nextPtr) {
+ if (linePtr2 == NULL) {
+ Tcl_Panic("TkBTreePixelsTo couldn't find line");
+ }
+ index += linePtr2->pixels[2 * pixelReference];
+ }
+
+ /*
+ * Now work up through the levels of the tree one at a time, counting how
+ * many pixels are in nodes preceding the current node.
+ */
+
+ for (parentPtr = nodePtr->parentPtr ; parentPtr != NULL;
+ nodePtr = parentPtr, parentPtr = parentPtr->parentPtr) {
+ register Node *nodePtr2;
+
+ for (nodePtr2 = parentPtr->children.nodePtr; nodePtr2 != nodePtr;
+ nodePtr2 = nodePtr2->nextPtr) {
+ if (nodePtr2 == NULL) {
+ Tcl_Panic("TkBTreePixelsTo couldn't find node");
+ }
+ index += nodePtr2->numPixels[pixelReference];
+ }
+ }
+ return index;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkBTreeLinesTo --
+ *
+ * Given a pointer to a line in a B-tree, return the numerical index of
+ * that line.
+ *
+ * Results:
+ * The result is the index of linePtr within the tree, where 0
+ * corresponds to the first line in the tree.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TkBTreeLinesTo(
+ const TkText *textPtr, /* Relative to this client of the B-tree. */
+ TkTextLine *linePtr) /* Pointer to existing line in B-tree. */
+{
+ register TkTextLine *linePtr2;
+ register Node *nodePtr, *parentPtr, *nodePtr2;
+ int index;
+
+ /*
+ * First count how many lines precede this one in its level-0 node.
+ */
+
+ nodePtr = linePtr->parentPtr;
+ index = 0;
+ for (linePtr2 = nodePtr->children.linePtr; linePtr2 != linePtr;
+ linePtr2 = linePtr2->nextPtr) {
+ if (linePtr2 == NULL) {
+ Tcl_Panic("TkBTreeLinesTo couldn't find line");
+ }
+ index += 1;
+ }
+
+ /*
+ * Now work up through the levels of the tree one at a time, counting how
+ * many lines are in nodes preceding the current node.
+ */
+
+ for (parentPtr = nodePtr->parentPtr ; parentPtr != NULL;
+ nodePtr = parentPtr, parentPtr = parentPtr->parentPtr) {
+ for (nodePtr2 = parentPtr->children.nodePtr; nodePtr2 != nodePtr;
+ nodePtr2 = nodePtr2->nextPtr) {
+ if (nodePtr2 == NULL) {
+ Tcl_Panic("TkBTreeLinesTo couldn't find node");
+ }
+ index += nodePtr2->numLines;
+ }
+ }
+ if (textPtr != NULL) {
+ /*
+ * The index to return must be relative to textPtr, not to the entire
+ * tree. Take care to never return a negative index when linePtr
+ * denotes a line before -startline, or an index larger than the
+ * number of lines in textPtr when linePtr is a line past -endline.
+ */
+
+ int indexStart, indexEnd;
+
+ if (textPtr->start != NULL) {
+ indexStart = TkBTreeLinesTo(NULL, textPtr->start);
+ } else {
+ indexStart = 0;
+ }
+ if (textPtr->end != NULL) {
+ indexEnd = TkBTreeLinesTo(NULL, textPtr->end);
+ } else {
+ indexEnd = TkBTreeNumLines(textPtr->sharedTextPtr->tree, NULL);
+ }
+ if (index < indexStart) {
+ index = 0;
+ } else if (index > indexEnd) {
+ index = TkBTreeNumLines(textPtr->sharedTextPtr->tree, textPtr);
+ } else {
+ index -= indexStart;
+ }
+ }
+ return index;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkBTreeLinkSegment --
+ *
+ * This function adds a new segment to a B-tree at a given location.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * SegPtr will be linked into its tree.
+ *
+ *----------------------------------------------------------------------
+ */
+
+ /* ARGSUSED */
+void
+TkBTreeLinkSegment(
+ TkTextSegment *segPtr, /* Pointer to new segment to be added to
+ * B-tree. Should be completely initialized by
+ * caller except for nextPtr field. */
+ TkTextIndex *indexPtr) /* Where to add segment: it gets linked in
+ * just before the segment indicated here. */
+{
+ register TkTextSegment *prevPtr;
+
+ prevPtr = SplitSeg(indexPtr);
+ if (prevPtr == NULL) {
+ segPtr->nextPtr = indexPtr->linePtr->segPtr;
+ indexPtr->linePtr->segPtr = segPtr;
+ } else {
+ segPtr->nextPtr = prevPtr->nextPtr;
+ prevPtr->nextPtr = segPtr;
+ }
+ CleanupLine(indexPtr->linePtr);
+ if (tkBTreeDebug) {
+ TkBTreeCheck(indexPtr->tree);
+ }
+ ((BTree *)indexPtr->tree)->stateEpoch++;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkBTreeUnlinkSegment --
+ *
+ * This function unlinks a segment from its line in a B-tree.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * SegPtr will be unlinked from linePtr. The segment itself isn't
+ * modified by this function.
+ *
+ *----------------------------------------------------------------------
+ */
+
+ /* ARGSUSED */
+void
+TkBTreeUnlinkSegment(
+ TkTextSegment *segPtr, /* Segment to be unlinked. */
+ TkTextLine *linePtr) /* Line that currently contains segment. */
+{
+ register TkTextSegment *prevPtr;
+
+ if (linePtr->segPtr == segPtr) {
+ linePtr->segPtr = segPtr->nextPtr;
+ } else {
+ prevPtr = linePtr->segPtr;
+ while (prevPtr->nextPtr != segPtr) {
+ prevPtr = prevPtr->nextPtr;
+
+ if (prevPtr == NULL) {
+ /*
+ * Two logical lines merged into one display line through
+ * eliding of a newline.
+ */
+
+ linePtr = TkBTreeNextLine(NULL, linePtr);
+ prevPtr = linePtr->segPtr;
+ }
+ }
+ prevPtr->nextPtr = segPtr->nextPtr;
+ }
+ CleanupLine(linePtr);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkBTreeTag --
+ *
+ * Turn a given tag on or off for a given range of characters in a B-tree
+ * of text.
+ *
+ * Results:
+ * 1 if the tags on any characters in the range were changed, and zero
+ * otherwise (i.e. if the tag was already absent (add = 0) or present
+ * (add = 1) on the index range in question).
+ *
+ * Side effects:
+ * The given tag is added to the given range of characters in the tree or
+ * removed from all those characters, depending on the "add" argument.
+ * The structure of the btree is modified enough that index1Ptr and
+ * index2Ptr are no longer valid after this function returns, and the
+ * indexes may be modified by this function.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TkBTreeTag(
+ register TkTextIndex *index1Ptr,
+ /* Indicates first character in range. */
+ register TkTextIndex *index2Ptr,
+ /* Indicates character just after the last one
+ * in range. */
+ TkTextTag *tagPtr, /* Tag to add or remove. */
+ int add) /* One means add tag to the given range of
+ * characters; zero means remove the tag from
+ * the range. */
+{
+ TkTextSegment *segPtr, *prevPtr;
+ TkTextSearch search;
+ TkTextLine *cleanupLinePtr;
+ int oldState, changed, anyChanges = 0;
+
+ /*
+ * See whether the tag is present at the start of the range. If the state
+ * doesn't already match what we want then add a toggle there.
+ */
+
+ oldState = TkBTreeCharTagged(index1Ptr, tagPtr);
+ if ((add != 0) ^ oldState) {
+ segPtr = ckalloc(TSEG_SIZE);
+ segPtr->typePtr = (add) ? &tkTextToggleOnType : &tkTextToggleOffType;
+ prevPtr = SplitSeg(index1Ptr);
+ if (prevPtr == NULL) {
+ segPtr->nextPtr = index1Ptr->linePtr->segPtr;
+ index1Ptr->linePtr->segPtr = segPtr;
+ } else {
+ segPtr->nextPtr = prevPtr->nextPtr;
+ prevPtr->nextPtr = segPtr;
+ }
+ segPtr->size = 0;
+ segPtr->body.toggle.tagPtr = tagPtr;
+ segPtr->body.toggle.inNodeCounts = 0;
+ anyChanges = 1;
+ }
+
+ /*
+ * Scan the range of characters and delete any internal tag transitions.
+ * Keep track of what the old state was at the end of the range, and add a
+ * toggle there if it's needed.
+ */
+
+ TkBTreeStartSearch(index1Ptr, index2Ptr, tagPtr, &search);
+ cleanupLinePtr = index1Ptr->linePtr;
+ while (TkBTreeNextTag(&search)) {
+ anyChanges = 1;
+ oldState ^= 1;
+ segPtr = search.segPtr;
+ prevPtr = search.curIndex.linePtr->segPtr;
+ if (prevPtr == segPtr) {
+ search.curIndex.linePtr->segPtr = segPtr->nextPtr;
+ } else {
+ while (prevPtr->nextPtr != segPtr) {
+ prevPtr = prevPtr->nextPtr;
+ }
+ prevPtr->nextPtr = segPtr->nextPtr;
+ }
+ if (segPtr->body.toggle.inNodeCounts) {
+ ChangeNodeToggleCount(search.curIndex.linePtr->parentPtr,
+ segPtr->body.toggle.tagPtr, -1);
+ segPtr->body.toggle.inNodeCounts = 0;
+ changed = 1;
+ } else {
+ changed = 0;
+ }
+ ckfree(segPtr);
+
+ /*
+ * The code below is a bit tricky. After deleting a toggle we
+ * eventually have to call CleanupLine, in order to allow character
+ * segments to be merged together. To do this, we remember in
+ * cleanupLinePtr a line that needs to be cleaned up, but we don't
+ * clean it up until we've moved on to a different line. That way the
+ * cleanup process won't goof up segPtr.
+ */
+
+ if (cleanupLinePtr != search.curIndex.linePtr) {
+ CleanupLine(cleanupLinePtr);
+ cleanupLinePtr = search.curIndex.linePtr;
+ }
+
+ /*
+ * Quick hack. ChangeNodeToggleCount may move the tag's root location
+ * around and leave the search in the void. This resets the search.
+ */
+
+ if (changed) {
+ TkBTreeStartSearch(index1Ptr, index2Ptr, tagPtr, &search);
+ }
+ }
+ if ((add != 0) ^ oldState) {
+ segPtr = ckalloc(TSEG_SIZE);
+ segPtr->typePtr = (add) ? &tkTextToggleOffType : &tkTextToggleOnType;
+ prevPtr = SplitSeg(index2Ptr);
+ if (prevPtr == NULL) {
+ segPtr->nextPtr = index2Ptr->linePtr->segPtr;
+ index2Ptr->linePtr->segPtr = segPtr;
+ } else {
+ segPtr->nextPtr = prevPtr->nextPtr;
+ prevPtr->nextPtr = segPtr;
+ }
+ segPtr->size = 0;
+ segPtr->body.toggle.tagPtr = tagPtr;
+ segPtr->body.toggle.inNodeCounts = 0;
+ anyChanges = 1;
+ }
+
+ /*
+ * Cleanup cleanupLinePtr and the last line of the range, if these are
+ * different.
+ */
+
+ if (anyChanges) {
+ CleanupLine(cleanupLinePtr);
+ if (cleanupLinePtr != index2Ptr->linePtr) {
+ CleanupLine(index2Ptr->linePtr);
+ }
+ ((BTree *)index1Ptr->tree)->stateEpoch++;
+ }
+
+ if (tkBTreeDebug) {
+ TkBTreeCheck(index1Ptr->tree);
+ }
+ return anyChanges;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ChangeNodeToggleCount --
+ *
+ * This function increments or decrements the toggle count for a
+ * particular tag in a particular node and all its ancestors up to the
+ * per-tag root node.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The toggle count for tag is adjusted up or down by "delta" in nodePtr.
+ * This routine maintains the tagRootPtr that identifies the root node
+ * for the tag, moving it up or down the tree as needed.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+ChangeNodeToggleCount(
+ register Node *nodePtr, /* Node whose toggle count for a tag must be
+ * changed. */
+ TkTextTag *tagPtr, /* Information about tag. */
+ int delta) /* Amount to add to current toggle count for
+ * tag (may be negative). */
+{
+ register Summary *summaryPtr, *prevPtr;
+ register Node *node2Ptr;
+ int rootLevel; /* Level of original tag root. */
+
+ tagPtr->toggleCount += delta;
+ if (tagPtr->tagRootPtr == NULL) {
+ tagPtr->tagRootPtr = nodePtr;
+ return;
+ }
+
+ /*
+ * Note the level of the existing root for the tag so we can detect if it
+ * needs to be moved because of the toggle count change.
+ */
+
+ rootLevel = tagPtr->tagRootPtr->level;
+
+ /*
+ * Iterate over the node and its ancestors up to the tag root, adjusting
+ * summary counts at each node and moving the tag's root upwards if
+ * necessary.
+ */
+
+ for ( ; nodePtr != tagPtr->tagRootPtr; nodePtr = nodePtr->parentPtr) {
+ /*
+ * See if there's already an entry for this tag for this node. If so,
+ * perhaps all we have to do is adjust its count.
+ */
+
+ for (prevPtr = NULL, summaryPtr = nodePtr->summaryPtr;
+ summaryPtr != NULL;
+ prevPtr = summaryPtr, summaryPtr = summaryPtr->nextPtr) {
+ if (summaryPtr->tagPtr == tagPtr) {
+ break;
+ }
+ }
+ if (summaryPtr != NULL) {
+ summaryPtr->toggleCount += delta;
+ if (summaryPtr->toggleCount > 0 &&
+ summaryPtr->toggleCount < tagPtr->toggleCount) {
+ continue;
+ }
+ if (summaryPtr->toggleCount != 0) {
+ /*
+ * Should never find a node with max toggle count at this
+ * point (there shouldn't have been a summary entry in the
+ * first place).
+ */
+
+ Tcl_Panic("ChangeNodeToggleCount: bad toggle count (%d) max (%d)",
+ summaryPtr->toggleCount, tagPtr->toggleCount);
+ }
+
+ /*
+ * Zero toggle count; must remove this tag from the list.
+ */
+
+ if (prevPtr == NULL) {
+ nodePtr->summaryPtr = summaryPtr->nextPtr;
+ } else {
+ prevPtr->nextPtr = summaryPtr->nextPtr;
+ }
+ ckfree(summaryPtr);
+ } else {
+ /*
+ * This tag isn't currently in the summary information list.
+ */
+
+ if (rootLevel == nodePtr->level) {
+ /*
+ * The old tag root is at the same level in the tree as this
+ * node, but it isn't at this node. Move the tag root up a
+ * level, in the hopes that it will now cover this node as
+ * well as the old root (if not, we'll move it up again the
+ * next time through the loop). To push it up one level we
+ * copy the original toggle count into the summary information
+ * at the old root and change the root to its parent node.
+ */
+
+ Node *rootNodePtr = tagPtr->tagRootPtr;
+
+ summaryPtr = ckalloc(sizeof(Summary));
+ summaryPtr->tagPtr = tagPtr;
+ summaryPtr->toggleCount = tagPtr->toggleCount - delta;
+ summaryPtr->nextPtr = rootNodePtr->summaryPtr;
+ rootNodePtr->summaryPtr = summaryPtr;
+ rootNodePtr = rootNodePtr->parentPtr;
+ rootLevel = rootNodePtr->level;
+ tagPtr->tagRootPtr = rootNodePtr;
+ }
+ summaryPtr = ckalloc(sizeof(Summary));
+ summaryPtr->tagPtr = tagPtr;
+ summaryPtr->toggleCount = delta;
+ summaryPtr->nextPtr = nodePtr->summaryPtr;
+ nodePtr->summaryPtr = summaryPtr;
+ }
+ }
+
+ /*
+ * If we've decremented the toggle count, then it may be necessary to push
+ * the tag root down one or more levels.
+ */
+
+ if (delta >= 0) {
+ return;
+ }
+ if (tagPtr->toggleCount == 0) {
+ tagPtr->tagRootPtr = NULL;
+ return;
+ }
+ nodePtr = tagPtr->tagRootPtr;
+ while (nodePtr->level > 0) {
+ /*
+ * See if a single child node accounts for all of the tag's toggles.
+ * If so, push the root down one level.
+ */
+
+ for (node2Ptr = nodePtr->children.nodePtr;
+ node2Ptr != NULL ;
+ node2Ptr = node2Ptr->nextPtr) {
+ for (prevPtr = NULL, summaryPtr = node2Ptr->summaryPtr;
+ summaryPtr != NULL;
+ prevPtr = summaryPtr, summaryPtr = summaryPtr->nextPtr) {
+ if (summaryPtr->tagPtr == tagPtr) {
+ break;
+ }
+ }
+ if (summaryPtr == NULL) {
+ continue;
+ }
+ if (summaryPtr->toggleCount != tagPtr->toggleCount) {
+ /*
+ * No node has all toggles, so the root is still valid.
+ */
+
+ return;
+ }
+
+ /*
+ * This node has all the toggles, so push down the root.
+ */
+
+ if (prevPtr == NULL) {
+ node2Ptr->summaryPtr = summaryPtr->nextPtr;
+ } else {
+ prevPtr->nextPtr = summaryPtr->nextPtr;
+ }
+ ckfree(summaryPtr);
+ tagPtr->tagRootPtr = node2Ptr;
+ break;
+ }
+ nodePtr = tagPtr->tagRootPtr;
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * FindTagStart --
+ *
+ * Find the start of the first range of a tag.
+ *
+ * Results:
+ * The return value is a pointer to the first tag toggle segment for the
+ * tag. This can be either a tagon or tagoff segments because of the way
+ * TkBTreeAdd removes a tag. Sets *indexPtr to be the index of the tag
+ * toggle.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static TkTextSegment *
+FindTagStart(
+ TkTextBTree tree, /* Tree to search within. */
+ TkTextTag *tagPtr, /* Tag to search for. */
+ TkTextIndex *indexPtr) /* Return - index information. */
+{
+ register Node *nodePtr;
+ register TkTextLine *linePtr;
+ register TkTextSegment *segPtr;
+ register Summary *summaryPtr;
+ int offset;
+
+ nodePtr = tagPtr->tagRootPtr;
+ if (nodePtr == NULL) {
+ return NULL;
+ }
+
+ /*
+ * Search from the root of the subtree that contains the tag down to the
+ * level 0 node.
+ */
+
+ while (nodePtr && nodePtr->level > 0) {
+ for (nodePtr = nodePtr->children.nodePtr ; nodePtr != NULL;
+ nodePtr = nodePtr->nextPtr) {
+ for (summaryPtr = nodePtr->summaryPtr ; summaryPtr != NULL;
+ summaryPtr = summaryPtr->nextPtr) {
+ if (summaryPtr->tagPtr == tagPtr) {
+ goto gotNodeWithTag;
+ }
+ }
+ }
+ gotNodeWithTag:
+ continue;
+ }
+
+ if (nodePtr == NULL) {
+ return NULL;
+ }
+
+ /*
+ * Work through the lines attached to the level-0 node.
+ */
+
+ for (linePtr = nodePtr->children.linePtr; linePtr != NULL;
+ linePtr = linePtr->nextPtr) {
+ for (offset = 0, segPtr = linePtr->segPtr ; segPtr != NULL;
+ offset += segPtr->size, segPtr = segPtr->nextPtr) {
+ if (((segPtr->typePtr == &tkTextToggleOnType)
+ || (segPtr->typePtr == &tkTextToggleOffType))
+ && (segPtr->body.toggle.tagPtr == tagPtr)) {
+ /*
+ * It is possible that this is a tagoff tag, but that gets
+ * cleaned up later.
+ */
+
+ indexPtr->tree = tree;
+ indexPtr->linePtr = linePtr;
+ indexPtr->byteIndex = offset;
+ return segPtr;
+ }
+ }
+ }
+ return NULL;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * FindTagEnd --
+ *
+ * Find the end of the last range of a tag.
+ *
+ * Results:
+ * The return value is a pointer to the last tag toggle segment for the
+ * tag. This can be either a tagon or tagoff segments because of the way
+ * TkBTreeAdd removes a tag. Sets *indexPtr to be the index of the tag
+ * toggle.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static TkTextSegment *
+FindTagEnd(
+ TkTextBTree tree, /* Tree to search within. */
+ TkTextTag *tagPtr, /* Tag to search for. */
+ TkTextIndex *indexPtr) /* Return - index information. */
+{
+ register Node *nodePtr, *lastNodePtr;
+ register TkTextLine *linePtr ,*lastLinePtr;
+ register TkTextSegment *segPtr, *lastSegPtr, *last2SegPtr;
+ register Summary *summaryPtr;
+ int lastoffset, lastoffset2, offset;
+
+ nodePtr = tagPtr->tagRootPtr;
+ if (nodePtr == NULL) {
+ return NULL;
+ }
+
+ /*
+ * Search from the root of the subtree that contains the tag down to the
+ * level 0 node.
+ */
+
+ while (nodePtr && nodePtr->level > 0) {
+ for (lastNodePtr = NULL, nodePtr = nodePtr->children.nodePtr ;
+ nodePtr != NULL; nodePtr = nodePtr->nextPtr) {
+ for (summaryPtr = nodePtr->summaryPtr ; summaryPtr != NULL;
+ summaryPtr = summaryPtr->nextPtr) {
+ if (summaryPtr->tagPtr == tagPtr) {
+ lastNodePtr = nodePtr;
+ break;
+ }
+ }
+ }
+ nodePtr = lastNodePtr;
+ }
+
+ if (nodePtr == NULL) {
+ return NULL;
+ }
+
+ /*
+ * Work through the lines attached to the level-0 node.
+ */
+
+ last2SegPtr = NULL;
+ lastoffset2 = 0;
+ lastoffset = 0;
+ for (lastLinePtr = NULL, linePtr = nodePtr->children.linePtr;
+ linePtr != NULL; linePtr = linePtr->nextPtr) {
+ for (offset = 0, lastSegPtr = NULL, segPtr = linePtr->segPtr ;
+ segPtr != NULL;
+ offset += segPtr->size, segPtr = segPtr->nextPtr) {
+ if (((segPtr->typePtr == &tkTextToggleOnType)
+ || (segPtr->typePtr == &tkTextToggleOffType))
+ && (segPtr->body.toggle.tagPtr == tagPtr)) {
+ lastSegPtr = segPtr;
+ lastoffset = offset;
+ }
+ }
+ if (lastSegPtr != NULL) {
+ lastLinePtr = linePtr;
+ last2SegPtr = lastSegPtr;
+ lastoffset2 = lastoffset;
+ }
+ }
+ indexPtr->tree = tree;
+ indexPtr->linePtr = lastLinePtr;
+ indexPtr->byteIndex = lastoffset2;
+ return last2SegPtr;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkBTreeStartSearch --
+ *
+ * This function sets up a search for tag transitions involving a given
+ * tag (or all tags) in a given range of the text.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The information at *searchPtr is set up so that subsequent calls to
+ * TkBTreeNextTag or TkBTreePrevTag will return information about the
+ * locations of tag transitions. Note that TkBTreeNextTag or
+ * TkBTreePrevTag must be called to get the first transition. Note:
+ * unlike TkBTreeNextTag and TkBTreePrevTag, this routine does not
+ * guarantee that searchPtr->curIndex is equal to *index1Ptr. It may be
+ * greater than that if *index1Ptr is less than the first tag transition.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TkBTreeStartSearch(
+ TkTextIndex *index1Ptr, /* Search starts here. Tag toggles at this
+ * position will not be returned. */
+ TkTextIndex *index2Ptr, /* Search stops here. Tag toggles at this
+ * position *will* be returned. */
+ TkTextTag *tagPtr, /* Tag to search for. NULL means search for
+ * any tag. */
+ register TkTextSearch *searchPtr)
+ /* Where to store information about search's
+ * progress. */
+{
+ int offset;
+ TkTextIndex index0; /* First index of the tag. */
+ TkTextSegment *seg0Ptr; /* First segment of the tag. */
+
+ /*
+ * Find the segment that contains the first toggle for the tag. This may
+ * become the starting point in the search.
+ */
+
+ seg0Ptr = FindTagStart(index1Ptr->tree, tagPtr, &index0);
+ if (seg0Ptr == NULL) {
+ /*
+ * Even though there are no toggles, the display code still uses the
+ * search curIndex, so initialize that anyway.
+ */
+
+ searchPtr->linesLeft = 0;
+ searchPtr->curIndex = *index1Ptr;
+ searchPtr->segPtr = NULL;
+ searchPtr->nextPtr = NULL;
+ return;
+ }
+ if (TkTextIndexCmp(index1Ptr, &index0) < 0) {
+ /*
+ * Adjust start of search up to the first range of the tag.
+ */
+
+ searchPtr->curIndex = index0;
+ searchPtr->segPtr = NULL;
+ searchPtr->nextPtr = seg0Ptr; /* Will be returned by NextTag. */
+ index1Ptr = &index0;
+ } else {
+ searchPtr->curIndex = *index1Ptr;
+ searchPtr->segPtr = NULL;
+ searchPtr->nextPtr = TkTextIndexToSeg(index1Ptr, &offset);
+ searchPtr->curIndex.byteIndex -= offset;
+ }
+ searchPtr->lastPtr = TkTextIndexToSeg(index2Ptr, NULL);
+ searchPtr->tagPtr = tagPtr;
+ searchPtr->linesLeft = TkBTreeLinesTo(NULL, index2Ptr->linePtr) + 1
+ - TkBTreeLinesTo(NULL, index1Ptr->linePtr);
+ searchPtr->allTags = (tagPtr == NULL);
+ if (searchPtr->linesLeft == 1) {
+ /*
+ * Starting and stopping segments are in the same line; mark the
+ * search as over immediately if the second segment is before the
+ * first. A search does not return a toggle at the very start of the
+ * range, unless the range is artificially moved up to index0.
+ */
+
+ if (((index1Ptr == &index0) &&
+ (index1Ptr->byteIndex > index2Ptr->byteIndex)) ||
+ ((index1Ptr != &index0) &&
+ (index1Ptr->byteIndex >= index2Ptr->byteIndex))) {
+ searchPtr->linesLeft = 0;
+ }
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkBTreeStartSearchBack --
+ *
+ * This function sets up a search backwards for tag transitions involving
+ * a given tag (or all tags) in a given range of the text. In the normal
+ * case the first index (*index1Ptr) is beyond the second index
+ * (*index2Ptr).
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The information at *searchPtr is set up so that subsequent calls to
+ * TkBTreePrevTag will return information about the locations of tag
+ * transitions. Note that TkBTreePrevTag must be called to get the first
+ * transition. Note: unlike TkBTreeNextTag and TkBTreePrevTag, this
+ * routine does not guarantee that searchPtr->curIndex is equal to
+ * *index1Ptr. It may be less than that if *index1Ptr is greater than the
+ * last tag transition.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TkBTreeStartSearchBack(
+ TkTextIndex *index1Ptr, /* Search starts here. Tag toggles at this
+ * position will not be returned. */
+ TkTextIndex *index2Ptr, /* Search stops here. Tag toggles at this
+ * position *will* be returned. */
+ TkTextTag *tagPtr, /* Tag to search for. NULL means search for
+ * any tag. */
+ register TkTextSearch *searchPtr)
+ /* Where to store information about search's
+ * progress. */
+{
+ int offset;
+ TkTextIndex index0; /* Last index of the tag. */
+ TkTextIndex backOne; /* One character before starting index. */
+ TkTextSegment *seg0Ptr; /* Last segment of the tag. */
+
+ /*
+ * Find the segment that contains the last toggle for the tag. This may
+ * become the starting point in the search.
+ */
+
+ seg0Ptr = FindTagEnd(index1Ptr->tree, tagPtr, &index0);
+ if (seg0Ptr == NULL) {
+ /*
+ * Even though there are no toggles, the display code still uses the
+ * search curIndex, so initialize that anyway.
+ */
+
+ searchPtr->linesLeft = 0;
+ searchPtr->curIndex = *index1Ptr;
+ searchPtr->segPtr = NULL;
+ searchPtr->nextPtr = NULL;
+ return;
+ }
+
+ /*
+ * Adjust the start of the search so it doesn't find any tag toggles
+ * that are right at the index specified by the user.
+ */
+
+ if (TkTextIndexCmp(index1Ptr, &index0) > 0) {
+ searchPtr->curIndex = index0;
+ index1Ptr = &index0;
+ } else {
+ TkTextIndexBackChars(NULL, index1Ptr, 1, &searchPtr->curIndex,
+ COUNT_INDICES);
+ }
+ searchPtr->segPtr = NULL;
+ searchPtr->nextPtr = TkTextIndexToSeg(&searchPtr->curIndex, &offset);
+ searchPtr->curIndex.byteIndex -= offset;
+
+ /*
+ * Adjust the end of the search so it does find toggles that are right at
+ * the second index specified by the user.
+ */
+
+ if ((TkBTreeLinesTo(NULL, index2Ptr->linePtr) == 0) &&
+ (index2Ptr->byteIndex == 0)) {
+ backOne = *index2Ptr;
+ searchPtr->lastPtr = NULL; /* Signals special case for 1.0. */
+ } else {
+ TkTextIndexBackChars(NULL, index2Ptr, 1, &backOne, COUNT_INDICES);
+ searchPtr->lastPtr = TkTextIndexToSeg(&backOne, NULL);
+ }
+ searchPtr->tagPtr = tagPtr;
+ searchPtr->linesLeft = TkBTreeLinesTo(NULL, index1Ptr->linePtr) + 1
+ - TkBTreeLinesTo(NULL, backOne.linePtr);
+ searchPtr->allTags = (tagPtr == NULL);
+ if (searchPtr->linesLeft == 1) {
+ /*
+ * Starting and stopping segments are in the same line; mark the
+ * search as over immediately if the second segment is after the
+ * first.
+ */
+
+ if (index1Ptr->byteIndex <= backOne.byteIndex) {
+ searchPtr->linesLeft = 0;
+ }
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkBTreeNextTag --
+ *
+ * Once a tag search has begun, successive calls to this function return
+ * successive tag toggles. Note: it is NOT SAFE to call this function if
+ * characters have been inserted into or deleted from the B-tree since
+ * the call to TkBTreeStartSearch.
+ *
+ * Results:
+ * The return value is 1 if another toggle was found that met the
+ * criteria specified in the call to TkBTreeStartSearch; in this case
+ * searchPtr->curIndex gives the toggle's position and
+ * searchPtr->curTagPtr points to its segment. 0 is returned if no more
+ * matching tag transitions were found; in this case searchPtr->curIndex
+ * is the same as searchPtr->stopIndex.
+ *
+ * Side effects:
+ * Information in *searchPtr is modified to update the state of the
+ * search and indicate where the next tag toggle is located.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TkBTreeNextTag(
+ register TkTextSearch *searchPtr)
+ /* Information about search in progress; must
+ * have been set up by call to
+ * TkBTreeStartSearch. */
+{
+ register TkTextSegment *segPtr;
+ register Node *nodePtr;
+ register Summary *summaryPtr;
+
+ if (searchPtr->linesLeft <= 0) {
+ goto searchOver;
+ }
+
+ /*
+ * The outermost loop iterates over lines that may potentially contain a
+ * relevant tag transition, starting from the current segment in the
+ * current line.
+ */
+
+ segPtr = searchPtr->nextPtr;
+ while (1) {
+ /*
+ * Check for more tags on the current line.
+ */
+
+ for ( ; segPtr != NULL; segPtr = segPtr->nextPtr) {
+ if (segPtr == searchPtr->lastPtr) {
+ goto searchOver;
+ }
+ if (((segPtr->typePtr == &tkTextToggleOnType)
+ || (segPtr->typePtr == &tkTextToggleOffType))
+ && (searchPtr->allTags
+ || (segPtr->body.toggle.tagPtr == searchPtr->tagPtr))) {
+ searchPtr->segPtr = segPtr;
+ searchPtr->nextPtr = segPtr->nextPtr;
+ searchPtr->tagPtr = segPtr->body.toggle.tagPtr;
+ return 1;
+ }
+ searchPtr->curIndex.byteIndex += segPtr->size;
+ }
+
+ /*
+ * See if there are more lines associated with the current parent
+ * node. If so, go back to the top of the loop to search the next one.
+ */
+
+ nodePtr = searchPtr->curIndex.linePtr->parentPtr;
+ searchPtr->curIndex.linePtr = searchPtr->curIndex.linePtr->nextPtr;
+ searchPtr->linesLeft--;
+ if (searchPtr->linesLeft <= 0) {
+ goto searchOver;
+ }
+ if (searchPtr->curIndex.linePtr != NULL) {
+ segPtr = searchPtr->curIndex.linePtr->segPtr;
+ searchPtr->curIndex.byteIndex = 0;
+ continue;
+ }
+ if (nodePtr == searchPtr->tagPtr->tagRootPtr) {
+ goto searchOver;
+ }
+
+ /*
+ * Search across and up through the B-tree's node hierarchy looking
+ * for the next node that has a relevant tag transition somewhere in
+ * its subtree. Be sure to update linesLeft as we skip over large
+ * chunks of lines.
+ */
+
+ while (1) {
+ while (nodePtr->nextPtr == NULL) {
+ if (nodePtr->parentPtr == NULL ||
+ nodePtr->parentPtr == searchPtr->tagPtr->tagRootPtr) {
+ goto searchOver;
+ }
+ nodePtr = nodePtr->parentPtr;
+ }
+ nodePtr = nodePtr->nextPtr;
+ for (summaryPtr = nodePtr->summaryPtr; summaryPtr != NULL;
+ summaryPtr = summaryPtr->nextPtr) {
+ if ((searchPtr->allTags) ||
+ (summaryPtr->tagPtr == searchPtr->tagPtr)) {
+ goto gotNodeWithTag;
+ }
+ }
+ searchPtr->linesLeft -= nodePtr->numLines;
+ }
+
+ /*
+ * At this point we've found a subtree that has a relevant tag
+ * transition. Now search down (and across) through that subtree to
+ * find the first level-0 node that has a relevant tag transition.
+ */
+
+ gotNodeWithTag:
+ while (nodePtr->level > 0) {
+ for (nodePtr = nodePtr->children.nodePtr; ;
+ nodePtr = nodePtr->nextPtr) {
+ for (summaryPtr = nodePtr->summaryPtr; summaryPtr != NULL;
+ summaryPtr = summaryPtr->nextPtr) {
+ if ((searchPtr->allTags)
+ || (summaryPtr->tagPtr == searchPtr->tagPtr)) {
+ /*
+ * Would really like a multi-level continue here...
+ */
+
+ goto nextChild;
+ }
+ }
+ searchPtr->linesLeft -= nodePtr->numLines;
+ if (nodePtr->nextPtr == NULL) {
+ Tcl_Panic("TkBTreeNextTag found incorrect tag summary info");
+ }
+ }
+ nextChild:
+ continue;
+ }
+
+ /*
+ * Now we're down to a level-0 node that contains a line that contains
+ * a relevant tag transition. Set up line information and go back to
+ * the beginning of the loop to search through lines.
+ */
+
+ searchPtr->curIndex.linePtr = nodePtr->children.linePtr;
+ searchPtr->curIndex.byteIndex = 0;
+ segPtr = searchPtr->curIndex.linePtr->segPtr;
+ if (searchPtr->linesLeft <= 0) {
+ goto searchOver;
+ }
+ continue;
+ }
+
+ searchOver:
+ searchPtr->linesLeft = 0;
+ searchPtr->segPtr = NULL;
+ return 0;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkBTreePrevTag --
+ *
+ * Once a tag search has begun, successive calls to this function return
+ * successive tag toggles in the reverse direction. Note: it is NOT SAFE
+ * to call this function if characters have been inserted into or deleted
+ * from the B-tree since the call to TkBTreeStartSearch.
+ *
+ * Results:
+ * The return value is 1 if another toggle was found that met the
+ * criteria specified in the call to TkBTreeStartSearch; in this case
+ * searchPtr->curIndex gives the toggle's position and
+ * searchPtr->curTagPtr points to its segment. 0 is returned if no more
+ * matching tag transitions were found; in this case searchPtr->curIndex
+ * is the same as searchPtr->stopIndex.
+ *
+ * Side effects:
+ * Information in *searchPtr is modified to update the state of the
+ * search and indicate where the next tag toggle is located.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TkBTreePrevTag(
+ register TkTextSearch *searchPtr)
+ /* Information about search in progress; must
+ * have been set up by call to
+ * TkBTreeStartSearch. */
+{
+ register TkTextSegment *segPtr, *prevPtr;
+ register TkTextLine *linePtr, *prevLinePtr;
+ register Node *nodePtr, *node2Ptr, *prevNodePtr;
+ register Summary *summaryPtr;
+ int byteIndex, linesSkipped;
+ int pastLast; /* Saw last marker during scan. */
+
+ if (searchPtr->linesLeft <= 0) {
+ goto searchOver;
+ }
+
+ /*
+ * The outermost loop iterates over lines that may potentially contain a
+ * relevant tag transition, starting from the current segment in the
+ * current line. "nextPtr" is maintained as the last segment in a line
+ * that we can look at.
+ */
+
+ while (1) {
+ /*
+ * Check for the last toggle before the current segment on this line.
+ */
+
+ byteIndex = 0;
+ if (searchPtr->lastPtr == NULL) {
+ /*
+ * Search back to the very beginning, so pastLast is irrelevent.
+ */
+
+ pastLast = 1;
+ } else {
+ pastLast = 0;
+ }
+
+ for (prevPtr = NULL, segPtr = searchPtr->curIndex.linePtr->segPtr ;
+ segPtr != NULL && segPtr != searchPtr->nextPtr;
+ segPtr = segPtr->nextPtr) {
+ if (((segPtr->typePtr == &tkTextToggleOnType)
+ || (segPtr->typePtr == &tkTextToggleOffType))
+ && (searchPtr->allTags
+ || (segPtr->body.toggle.tagPtr == searchPtr->tagPtr))) {
+ prevPtr = segPtr;
+ searchPtr->curIndex.byteIndex = byteIndex;
+ }
+ if (segPtr == searchPtr->lastPtr) {
+ prevPtr = NULL; /* Segments earlier than last don't
+ * count. */
+ pastLast = 1;
+ }
+ byteIndex += segPtr->size;
+ }
+ if (prevPtr != NULL) {
+ if (searchPtr->linesLeft == 1 && !pastLast) {
+ /*
+ * We found a segment that is before the stopping index. Note
+ * that it is OK if prevPtr == lastPtr.
+ */
+
+ goto searchOver;
+ }
+ searchPtr->segPtr = prevPtr;
+ searchPtr->nextPtr = prevPtr;
+ searchPtr->tagPtr = prevPtr->body.toggle.tagPtr;
+ return 1;
+ }
+
+ searchPtr->linesLeft--;
+ if (searchPtr->linesLeft <= 0) {
+ goto searchOver;
+ }
+
+ /*
+ * See if there are more lines associated with the current parent
+ * node. If so, go back to the top of the loop to search the previous
+ * one.
+ */
+
+ nodePtr = searchPtr->curIndex.linePtr->parentPtr;
+ for (prevLinePtr = NULL, linePtr = nodePtr->children.linePtr;
+ linePtr != NULL && linePtr != searchPtr->curIndex.linePtr;
+ prevLinePtr = linePtr, linePtr = linePtr->nextPtr) {
+ /* empty loop body */ ;
+ }
+ if (prevLinePtr != NULL) {
+ searchPtr->curIndex.linePtr = prevLinePtr;
+ searchPtr->nextPtr = NULL;
+ continue;
+ }
+ if (nodePtr == searchPtr->tagPtr->tagRootPtr) {
+ goto searchOver;
+ }
+
+ /*
+ * Search across and up through the B-tree's node hierarchy looking
+ * for the previous node that has a relevant tag transition somewhere
+ * in its subtree. The search and line counting is trickier with/out
+ * back pointers. We'll scan all the nodes under a parent up to the
+ * current node, searching all of them for tag state. The last one we
+ * find, if any, is recorded in prevNodePtr, and any nodes past
+ * prevNodePtr that don't have tag state increment linesSkipped.
+ */
+
+ while (1) {
+ for (prevNodePtr = NULL, linesSkipped = 0,
+ node2Ptr = nodePtr->parentPtr->children.nodePtr ;
+ node2Ptr != nodePtr; node2Ptr = node2Ptr->nextPtr) {
+ for (summaryPtr = node2Ptr->summaryPtr; summaryPtr != NULL;
+ summaryPtr = summaryPtr->nextPtr) {
+ if ((searchPtr->allTags) ||
+ (summaryPtr->tagPtr == searchPtr->tagPtr)) {
+ prevNodePtr = node2Ptr;
+ linesSkipped = 0;
+ goto keepLooking;
+ }
+ }
+ linesSkipped += node2Ptr->numLines;
+
+ keepLooking:
+ continue;
+ }
+ if (prevNodePtr != NULL) {
+ nodePtr = prevNodePtr;
+ searchPtr->linesLeft -= linesSkipped;
+ goto gotNodeWithTag;
+ }
+ nodePtr = nodePtr->parentPtr;
+ if (nodePtr->parentPtr == NULL ||
+ nodePtr == searchPtr->tagPtr->tagRootPtr) {
+ goto searchOver;
+ }
+ }
+
+ /*
+ * At this point we've found a subtree that has a relevant tag
+ * transition. Now search down (and across) through that subtree to
+ * find the last level-0 node that has a relevant tag transition.
+ */
+
+ gotNodeWithTag:
+ while (nodePtr->level > 0) {
+ for (linesSkipped = 0, prevNodePtr = NULL,
+ nodePtr = nodePtr->children.nodePtr; nodePtr != NULL ;
+ nodePtr = nodePtr->nextPtr) {
+ for (summaryPtr = nodePtr->summaryPtr; summaryPtr != NULL;
+ summaryPtr = summaryPtr->nextPtr) {
+ if ((searchPtr->allTags)
+ || (summaryPtr->tagPtr == searchPtr->tagPtr)) {
+ prevNodePtr = nodePtr;
+ linesSkipped = 0;
+ goto keepLooking2;
+ }
+ }
+ linesSkipped += nodePtr->numLines;
+
+ keepLooking2:
+ continue;
+ }
+ if (prevNodePtr == NULL) {
+ Tcl_Panic("TkBTreePrevTag found incorrect tag summary info");
+ }
+ searchPtr->linesLeft -= linesSkipped;
+ nodePtr = prevNodePtr;
+ }
+
+ /*
+ * Now we're down to a level-0 node that contains a line that contains
+ * a relevant tag transition. Set up line information and go back to
+ * the beginning of the loop to search through lines. We start with
+ * the last line below the node.
+ */
+
+ for (prevLinePtr = NULL, linePtr = nodePtr->children.linePtr;
+ linePtr != NULL ;
+ prevLinePtr = linePtr, linePtr = linePtr->nextPtr) {
+ /* empty loop body */ ;
+ }
+ searchPtr->curIndex.linePtr = prevLinePtr;
+ searchPtr->curIndex.byteIndex = 0;
+ if (searchPtr->linesLeft <= 0) {
+ goto searchOver;
+ }
+ continue;
+ }
+
+ searchOver:
+ searchPtr->linesLeft = 0;
+ searchPtr->segPtr = NULL;
+ return 0;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkBTreeCharTagged --
+ *
+ * Determine whether a particular character has a particular tag.
+ *
+ * Results:
+ * The return value is 1 if the given tag is in effect at the character
+ * given by linePtr and ch, and 0 otherwise.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TkBTreeCharTagged(
+ const TkTextIndex *indexPtr,/* Indicates a character position at which to
+ * check for a tag. */
+ TkTextTag *tagPtr) /* Tag of interest. */
+{
+ register Node *nodePtr;
+ register TkTextLine *siblingLinePtr;
+ register TkTextSegment *segPtr;
+ TkTextSegment *toggleSegPtr;
+ int toggles, index;
+
+ /*
+ * Check for toggles for the tag in indexPtr's line but before indexPtr.
+ * If there is one, its type indicates whether or not the character is
+ * tagged.
+ */
+
+ toggleSegPtr = NULL;
+ for (index = 0, segPtr = indexPtr->linePtr->segPtr;
+ (index + segPtr->size) <= indexPtr->byteIndex;
+ index += segPtr->size, segPtr = segPtr->nextPtr) {
+ if (((segPtr->typePtr == &tkTextToggleOnType)
+ || (segPtr->typePtr == &tkTextToggleOffType))
+ && (segPtr->body.toggle.tagPtr == tagPtr)) {
+ toggleSegPtr = segPtr;
+ }
+ }
+ if (toggleSegPtr != NULL) {
+ return (toggleSegPtr->typePtr == &tkTextToggleOnType);
+ }
+
+ /*
+ * No toggle in this line. Look for toggles for the tag in lines that are
+ * predecessors of indexPtr->linePtr but under the same level-0 node.
+ */
+
+ for (siblingLinePtr = indexPtr->linePtr->parentPtr->children.linePtr;
+ siblingLinePtr != indexPtr->linePtr;
+ siblingLinePtr = siblingLinePtr->nextPtr) {
+ for (segPtr = siblingLinePtr->segPtr; segPtr != NULL;
+ segPtr = segPtr->nextPtr) {
+ if (((segPtr->typePtr == &tkTextToggleOnType)
+ || (segPtr->typePtr == &tkTextToggleOffType))
+ && (segPtr->body.toggle.tagPtr == tagPtr)) {
+ toggleSegPtr = segPtr;
+ }
+ }
+ }
+ if (toggleSegPtr != NULL) {
+ return (toggleSegPtr->typePtr == &tkTextToggleOnType);
+ }
+
+ /*
+ * No toggle in this node. Scan upwards through the ancestors of this
+ * node, counting the number of toggles of the given tag in siblings that
+ * precede that node.
+ */
+
+ toggles = 0;
+ for (nodePtr = indexPtr->linePtr->parentPtr; nodePtr->parentPtr != NULL;
+ nodePtr = nodePtr->parentPtr) {
+ register Node *siblingPtr;
+ register Summary *summaryPtr;
+
+ for (siblingPtr = nodePtr->parentPtr->children.nodePtr;
+ siblingPtr != nodePtr; siblingPtr = siblingPtr->nextPtr) {
+ for (summaryPtr = siblingPtr->summaryPtr; summaryPtr != NULL;
+ summaryPtr = summaryPtr->nextPtr) {
+ if (summaryPtr->tagPtr == tagPtr) {
+ toggles += summaryPtr->toggleCount;
+ }
+ }
+ }
+ if (nodePtr == tagPtr->tagRootPtr) {
+ break;
+ }
+ }
+
+ /*
+ * An odd number of toggles means that the tag is present at the given
+ * point.
+ */
+
+ return toggles & 1;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkBTreeGetTags --
+ *
+ * Return information about all of the tags that are associated with a
+ * particular character in a B-tree of text.
+ *
+ * Results:
+ * The return value is a malloc-ed array containing pointers to
+ * information for each of the tags that is associated with the character
+ * at the position given by linePtr and ch. The word at *numTagsPtr is
+ * filled in with the number of pointers in the array. It is up to the
+ * caller to free the array by passing it to free. If there are no tags
+ * at the given character then a NULL pointer is returned and *numTagsPtr
+ * will be set to 0.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+ /* ARGSUSED */
+TkTextTag **
+TkBTreeGetTags(
+ const TkTextIndex *indexPtr,/* Indicates a particular position in the
+ * B-tree. */
+ const TkText *textPtr, /* If non-NULL, then only return tags for this
+ * text widget (when there are peer
+ * widgets). */
+ int *numTagsPtr) /* Store number of tags found at this
+ * location. */
+{
+ register Node *nodePtr;
+ register TkTextLine *siblingLinePtr;
+ register TkTextSegment *segPtr;
+ TkTextLine *linePtr;
+ int src, dst, index;
+ TagInfo tagInfo;
+#define NUM_TAG_INFOS 10
+
+ tagInfo.numTags = 0;
+ tagInfo.arraySize = NUM_TAG_INFOS;
+ tagInfo.tagPtrs = ckalloc(NUM_TAG_INFOS * sizeof(TkTextTag *));
+ tagInfo.counts = ckalloc(NUM_TAG_INFOS * sizeof(int));
+
+ /*
+ * Record tag toggles within the line of indexPtr but preceding indexPtr.
+ */
+
+ linePtr = indexPtr->linePtr;
+ index = 0;
+ segPtr = linePtr->segPtr;
+ while ((index + segPtr->size) <= indexPtr->byteIndex) {
+ if ((segPtr->typePtr == &tkTextToggleOnType)
+ || (segPtr->typePtr == &tkTextToggleOffType)) {
+ IncCount(segPtr->body.toggle.tagPtr, 1, &tagInfo);
+ }
+ index += segPtr->size;
+ segPtr = segPtr->nextPtr;
+
+ if (segPtr == NULL) {
+ /*
+ * Two logical lines merged into one display line through eliding
+ * of a newline.
+ */
+
+ linePtr = TkBTreeNextLine(NULL, linePtr);
+ segPtr = linePtr->segPtr;
+ }
+ }
+
+ /*
+ * Record toggles for tags in lines that are predecessors of
+ * indexPtr->linePtr but under the same level-0 node.
+ */
+
+ for (siblingLinePtr = indexPtr->linePtr->parentPtr->children.linePtr;
+ siblingLinePtr != indexPtr->linePtr;
+ siblingLinePtr = siblingLinePtr->nextPtr) {
+ for (segPtr = siblingLinePtr->segPtr; segPtr != NULL;
+ segPtr = segPtr->nextPtr) {
+ if ((segPtr->typePtr == &tkTextToggleOnType)
+ || (segPtr->typePtr == &tkTextToggleOffType)) {
+ IncCount(segPtr->body.toggle.tagPtr, 1, &tagInfo);
+ }
+ }
+ }
+
+ /*
+ * For each node in the ancestry of this line, record tag toggles for all
+ * siblings that precede that node.
+ */
+
+ for (nodePtr = indexPtr->linePtr->parentPtr; nodePtr->parentPtr != NULL;
+ nodePtr = nodePtr->parentPtr) {
+ register Node *siblingPtr;
+ register Summary *summaryPtr;
+
+ for (siblingPtr = nodePtr->parentPtr->children.nodePtr;
+ siblingPtr != nodePtr; siblingPtr = siblingPtr->nextPtr) {
+ for (summaryPtr = siblingPtr->summaryPtr; summaryPtr != NULL;
+ summaryPtr = summaryPtr->nextPtr) {
+ if (summaryPtr->toggleCount & 1) {
+ IncCount(summaryPtr->tagPtr, summaryPtr->toggleCount,
+ &tagInfo);
+ }
+ }
+ }
+ }
+
+ /*
+ * Go through the tag information and squash out all of the tags that have
+ * even toggle counts (these tags exist before the point of interest, but
+ * not at the desired character itself). Also squash out all tags that
+ * don't belong to the requested widget.
+ */
+
+ for (src = 0, dst = 0; src < tagInfo.numTags; src++) {
+ if (tagInfo.counts[src] & 1) {
+ const TkText *tagTextPtr = tagInfo.tagPtrs[src]->textPtr;
+
+ if (tagTextPtr==NULL || textPtr==NULL || tagTextPtr==textPtr) {
+ tagInfo.tagPtrs[dst] = tagInfo.tagPtrs[src];
+ dst++;
+ }
+ }
+ }
+ *numTagsPtr = dst;
+ ckfree(tagInfo.counts);
+ if (dst == 0) {
+ ckfree(tagInfo.tagPtrs);
+ return NULL;
+ }
+ return tagInfo.tagPtrs;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkTextIsElided --
+ *
+ * Special case to just return information about elided attribute.
+ * Specialized from TkBTreeGetTags(indexPtr, textPtr, numTagsPtr) and
+ * GetStyle(textPtr, indexPtr). Just need to keep track of invisibility
+ * settings for each priority, pick highest one active at end.
+ *
+ * Note that this returns all elide information up to and including the
+ * given index (quite obviously). However, this does mean that if
+ * indexPtr is a line-start and one then iterates from the beginning of
+ * that line forwards, one will actually revisit the segPtrs of size zero
+ * (for tag toggling, for example) which have already been seen here.
+ *
+ * For this reason we fill in the fields 'segPtr' and 'segOffset' of
+ * elideInfo, enabling our caller easily to calculate incremental changes
+ * from where we left off.
+ *
+ * Results:
+ * Returns whether this text should be elided or not.
+ *
+ * Optionally returns more detailed information in elideInfo.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+ /* ARGSUSED */
+int
+TkTextIsElided(
+ const TkText *textPtr, /* Overall information about text widget. */
+ const TkTextIndex *indexPtr,/* The character in the text for which display
+ * information is wanted. */
+ TkTextElideInfo *elideInfo) /* NULL or a pointer to a structure in which
+ * indexPtr's elide state will be stored and
+ * returned. */
+{
+ register Node *nodePtr;
+ register TkTextLine *siblingLinePtr;
+ register TkTextSegment *segPtr;
+ register TkTextTag *tagPtr = NULL;
+ register int i, index;
+ register TkTextElideInfo *infoPtr;
+ TkTextLine *linePtr;
+ int elide;
+
+ if (elideInfo == NULL) {
+ infoPtr = ckalloc(sizeof(TkTextElideInfo));
+ } else {
+ infoPtr = elideInfo;
+ }
+
+ infoPtr->elide = 0; /* If nobody says otherwise, it's visible. */
+ infoPtr->tagCnts = infoPtr->deftagCnts;
+ infoPtr->tagPtrs = infoPtr->deftagPtrs;
+ infoPtr->numTags = textPtr->sharedTextPtr->numTags;
+
+ /*
+ * Almost always avoid malloc, so stay out of system calls.
+ */
+
+ if (LOTSA_TAGS < infoPtr->numTags) {
+ infoPtr->tagCnts = ckalloc(sizeof(int) * infoPtr->numTags);
+ infoPtr->tagPtrs = ckalloc(sizeof(TkTextTag *) * infoPtr->numTags);
+ }
+
+ for (i=0; i<infoPtr->numTags; i++) {
+ infoPtr->tagCnts[i] = 0;
+ }
+
+ /*
+ * Record tag toggles within the line of indexPtr but preceding indexPtr.
+ */
+
+ index = 0;
+ linePtr = indexPtr->linePtr;
+ segPtr = linePtr->segPtr;
+ while ((index + segPtr->size) <= indexPtr->byteIndex) {
+ if ((segPtr->typePtr == &tkTextToggleOnType)
+ || (segPtr->typePtr == &tkTextToggleOffType)) {
+ tagPtr = segPtr->body.toggle.tagPtr;
+ if (tagPtr->elideString != NULL) {
+ infoPtr->tagPtrs[tagPtr->priority] = tagPtr;
+ infoPtr->tagCnts[tagPtr->priority]++;
+ }
+ }
+
+ index += segPtr->size;
+ segPtr = segPtr->nextPtr;
+ if (segPtr == NULL) {
+ /*
+ * Two logical lines merged into one display line through eliding
+ * of a newline.
+ */
+
+ linePtr = TkBTreeNextLine(NULL, linePtr);
+ segPtr = linePtr->segPtr;
+ }
+ }
+
+ /*
+ * Store the first segPtr we haven't examined completely so that our
+ * caller knows where to start.
+ */
+
+ infoPtr->segPtr = segPtr;
+ infoPtr->segOffset = index;
+
+ /*
+ * 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) {
+ infoPtr->tagPtrs[tagPtr->priority] = tagPtr;
+ infoPtr->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) {
+ infoPtr->tagPtrs[tagPtr->priority] = tagPtr;
+ infoPtr->tagCnts[tagPtr->priority] +=
+ summaryPtr->toggleCount;
+ }
+ }
+ }
+ }
+ }
+
+ /*
+ * Now traverse from highest priority to lowest, take elided value from
+ * first odd count (= on).
+ */
+
+ infoPtr->elidePriority = -1;
+ for (i = infoPtr->numTags-1; i >=0; i--) {
+ if (infoPtr->tagCnts[i] & 1) {
+ infoPtr->elide = infoPtr->tagPtrs[i]->elide;
+
+ /*
+ * Note: i == infoPtr->tagPtrs[i]->priority
+ */
+
+ infoPtr->elidePriority = i;
+ break;
+ }
+ }
+
+ elide = infoPtr->elide;
+
+ if (elideInfo == NULL) {
+ if (LOTSA_TAGS < infoPtr->numTags) {
+ ckfree(infoPtr->tagCnts);
+ ckfree(infoPtr->tagPtrs);
+ }
+
+ ckfree(infoPtr);
+ }
+
+ return elide;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkTextFreeElideInfo --
+ *
+ * This is a utility function used to free up any memory allocated by the
+ * TkTextIsElided function above.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Memory may be freed.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TkTextFreeElideInfo(
+ TkTextElideInfo *elideInfo) /* Free any allocated memory in this
+ * structure. */
+{
+ if (LOTSA_TAGS < elideInfo->numTags) {
+ ckfree(elideInfo->tagCnts);
+ ckfree(elideInfo->tagPtrs);
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * IncCount --
+ *
+ * This is a utility function used by TkBTreeGetTags. It increments the
+ * count for a particular tag, adding a new entry for that tag if there
+ * wasn't one previously.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The information at *tagInfoPtr may be modified, and the arrays may be
+ * reallocated to make them larger.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+IncCount(
+ TkTextTag *tagPtr, /* Handle for tag. */
+ int inc, /* Amount by which to increment tag count. */
+ TagInfo *tagInfoPtr) /* Holds cumulative information about tags;
+ * increment count here. */
+{
+ register TkTextTag **tagPtrPtr;
+ int count;
+
+ for (tagPtrPtr = tagInfoPtr->tagPtrs, count = tagInfoPtr->numTags;
+ count > 0; tagPtrPtr++, count--) {
+ if (*tagPtrPtr == tagPtr) {
+ tagInfoPtr->counts[tagInfoPtr->numTags-count] += inc;
+ return;
+ }
+ }
+
+ /*
+ * There isn't currently an entry for this tag, so we have to make a new
+ * one. If the arrays are full, then enlarge the arrays first.
+ */
+
+ if (tagInfoPtr->numTags == tagInfoPtr->arraySize) {
+ TkTextTag **newTags;
+ int *newCounts, newSize;
+
+ newSize = 2 * tagInfoPtr->arraySize;
+ newTags = ckalloc(newSize * sizeof(TkTextTag *));
+ memcpy(newTags, tagInfoPtr->tagPtrs,
+ tagInfoPtr->arraySize * sizeof(TkTextTag *));
+ ckfree(tagInfoPtr->tagPtrs);
+ tagInfoPtr->tagPtrs = newTags;
+ newCounts = ckalloc(newSize * sizeof(int));
+ memcpy(newCounts, tagInfoPtr->counts,
+ tagInfoPtr->arraySize * sizeof(int));
+ ckfree(tagInfoPtr->counts);
+ tagInfoPtr->counts = newCounts;
+ tagInfoPtr->arraySize = newSize;
+ }
+
+ tagInfoPtr->tagPtrs[tagInfoPtr->numTags] = tagPtr;
+ tagInfoPtr->counts[tagInfoPtr->numTags] = inc;
+ tagInfoPtr->numTags++;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkBTreeCheck --
+ *
+ * This function runs a set of consistency checks over a B-tree and
+ * panics if any inconsistencies are found.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * If a structural defect is found, the function panics with an error
+ * message.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TkBTreeCheck(
+ TkTextBTree tree) /* Tree to check. */
+{
+ BTree *treePtr = (BTree *) tree;
+ register Summary *summaryPtr;
+ register Node *nodePtr;
+ register TkTextLine *linePtr;
+ register TkTextSegment *segPtr;
+ register TkTextTag *tagPtr;
+ Tcl_HashEntry *entryPtr;
+ Tcl_HashSearch search;
+ int count;
+
+ /*
+ * Make sure that the tag toggle counts and the tag root pointers are OK.
+ */
+
+ for (entryPtr=Tcl_FirstHashEntry(&treePtr->sharedTextPtr->tagTable,&search);
+ entryPtr != NULL ; entryPtr = Tcl_NextHashEntry(&search)) {
+ tagPtr = Tcl_GetHashValue(entryPtr);
+ nodePtr = tagPtr->tagRootPtr;
+ if (nodePtr == NULL) {
+ if (tagPtr->toggleCount != 0) {
+ Tcl_Panic("TkBTreeCheck found \"%s\" with toggles (%d) but no root",
+ tagPtr->name, tagPtr->toggleCount);
+ }
+ continue; /* No ranges for the tag. */
+ } else if (tagPtr->toggleCount == 0) {
+ Tcl_Panic("TkBTreeCheck found root for \"%s\" with no toggles",
+ tagPtr->name);
+ } else if (tagPtr->toggleCount & 1) {
+ Tcl_Panic("TkBTreeCheck found odd toggle count for \"%s\" (%d)",
+ tagPtr->name, tagPtr->toggleCount);
+ }
+ for (summaryPtr = nodePtr->summaryPtr; summaryPtr != NULL;
+ summaryPtr = summaryPtr->nextPtr) {
+ if (summaryPtr->tagPtr == tagPtr) {
+ Tcl_Panic("TkBTreeCheck found root node with summary info");
+ }
+ }
+ count = 0;
+ if (nodePtr->level > 0) {
+ for (nodePtr = nodePtr->children.nodePtr ; nodePtr != NULL ;
+ nodePtr = nodePtr->nextPtr) {
+ for (summaryPtr = nodePtr->summaryPtr; summaryPtr != NULL;
+ summaryPtr = summaryPtr->nextPtr) {
+ if (summaryPtr->tagPtr == tagPtr) {
+ count += summaryPtr->toggleCount;
+ }
+ }
+ }
+ } else {
+ for (linePtr = nodePtr->children.linePtr ; linePtr != NULL ;
+ linePtr = linePtr->nextPtr) {
+ for (segPtr = linePtr->segPtr; segPtr != NULL;
+ segPtr = segPtr->nextPtr) {
+ if ((segPtr->typePtr == &tkTextToggleOnType ||
+ segPtr->typePtr == &tkTextToggleOffType) &&
+ segPtr->body.toggle.tagPtr == tagPtr) {
+ count++;
+ }
+ }
+ }
+ }
+ if (count != tagPtr->toggleCount) {
+ Tcl_Panic("TkBTreeCheck toggleCount (%d) wrong for \"%s\" should be (%d)",
+ tagPtr->toggleCount, tagPtr->name, count);
+ }
+ }
+
+ /*
+ * Call a recursive function to do the main body of checks.
+ */
+
+ nodePtr = treePtr->rootPtr;
+ CheckNodeConsistency(treePtr->rootPtr, treePtr->pixelReferences);
+
+ /*
+ * Make sure that there are at least two lines in the text and that the
+ * last line has no characters except a newline.
+ */
+
+ if (nodePtr->numLines < 2) {
+ Tcl_Panic("TkBTreeCheck: less than 2 lines in tree");
+ }
+ while (nodePtr->level > 0) {
+ nodePtr = nodePtr->children.nodePtr;
+ while (nodePtr->nextPtr != NULL) {
+ nodePtr = nodePtr->nextPtr;
+ }
+ }
+ linePtr = nodePtr->children.linePtr;
+ while (linePtr->nextPtr != NULL) {
+ linePtr = linePtr->nextPtr;
+ }
+ segPtr = linePtr->segPtr;
+ while ((segPtr->typePtr == &tkTextToggleOffType)
+ || (segPtr->typePtr == &tkTextRightMarkType)
+ || (segPtr->typePtr == &tkTextLeftMarkType)) {
+ /*
+ * It's OK to toggle a tag off in the last line, but not to start a
+ * new range. It's also OK to have marks in the last line.
+ */
+
+ segPtr = segPtr->nextPtr;
+ }
+ if (segPtr->typePtr != &tkTextCharType) {
+ Tcl_Panic("TkBTreeCheck: last line has bogus segment type");
+ }
+ if (segPtr->nextPtr != NULL) {
+ Tcl_Panic("TkBTreeCheck: last line has too many segments");
+ }
+ if (segPtr->size != 1) {
+ Tcl_Panic("TkBTreeCheck: last line has wrong # characters: %d",
+ segPtr->size);
+ }
+ if ((segPtr->body.chars[0] != '\n') || (segPtr->body.chars[1] != 0)) {
+ Tcl_Panic("TkBTreeCheck: last line had bad value: %s",
+ segPtr->body.chars);
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * CheckNodeConsistency --
+ *
+ * This function is called as part of consistency checking for B-trees:
+ * it checks several aspects of a node and also runs checks recursively
+ * on the node's children.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * If anything suspicious is found in the tree structure, the function
+ * panics.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+CheckNodeConsistency(
+ register Node *nodePtr, /* Node whose subtree should be checked. */
+ int references) /* Number of referring widgets which have
+ * pixel counts. */
+{
+ register Node *childNodePtr;
+ register Summary *summaryPtr, *summaryPtr2;
+ register TkTextLine *linePtr;
+ register TkTextSegment *segPtr;
+ int numChildren, numLines, toggleCount, minChildren, i;
+ int *numPixels;
+ int pixels[PIXEL_CLIENTS];
+
+ if (nodePtr->parentPtr != NULL) {
+ minChildren = MIN_CHILDREN;
+ } else if (nodePtr->level > 0) {
+ minChildren = 2;
+ } else {
+ minChildren = 1;
+ }
+ if ((nodePtr->numChildren < minChildren)
+ || (nodePtr->numChildren > MAX_CHILDREN)) {
+ Tcl_Panic("CheckNodeConsistency: bad child count (%d)",
+ nodePtr->numChildren);
+ }
+
+ numChildren = 0;
+ numLines = 0;
+ if (references > PIXEL_CLIENTS) {
+ numPixels = ckalloc(sizeof(int) * references);
+ } else {
+ numPixels = pixels;
+ }
+ for (i = 0; i<references; i++) {
+ numPixels[i] = 0;
+ }
+
+ if (nodePtr->level == 0) {
+ for (linePtr = nodePtr->children.linePtr; linePtr != NULL;
+ linePtr = linePtr->nextPtr) {
+ if (linePtr->parentPtr != nodePtr) {
+ Tcl_Panic("CheckNodeConsistency: line doesn't point to parent");
+ }
+ if (linePtr->segPtr == NULL) {
+ Tcl_Panic("CheckNodeConsistency: line has no segments");
+ }
+ for (segPtr = linePtr->segPtr; segPtr != NULL;
+ segPtr = segPtr->nextPtr) {
+ if (segPtr->typePtr->checkProc != NULL) {
+ segPtr->typePtr->checkProc(segPtr, linePtr);
+ }
+ if ((segPtr->size == 0) && (!segPtr->typePtr->leftGravity)
+ && (segPtr->nextPtr != NULL)
+ && (segPtr->nextPtr->size == 0)
+ && (segPtr->nextPtr->typePtr->leftGravity)) {
+ Tcl_Panic("CheckNodeConsistency: wrong segment order for gravity");
+ }
+ if ((segPtr->nextPtr == NULL)
+ && (segPtr->typePtr != &tkTextCharType)) {
+ Tcl_Panic("CheckNodeConsistency: line ended with wrong type");
+ }
+ }
+ numChildren++;
+ numLines++;
+ for (i = 0; i<references; i++) {
+ numPixels[i] += linePtr->pixels[2 * i];
+ }
+ }
+ } else {
+ for (childNodePtr = nodePtr->children.nodePtr; childNodePtr != NULL;
+ childNodePtr = childNodePtr->nextPtr) {
+ if (childNodePtr->parentPtr != nodePtr) {
+ Tcl_Panic("CheckNodeConsistency: node doesn't point to parent");
+ }
+ if (childNodePtr->level != (nodePtr->level-1)) {
+ Tcl_Panic("CheckNodeConsistency: level mismatch (%d %d)",
+ nodePtr->level, childNodePtr->level);
+ }
+ CheckNodeConsistency(childNodePtr, references);
+ for (summaryPtr = childNodePtr->summaryPtr; summaryPtr != NULL;
+ summaryPtr = summaryPtr->nextPtr) {
+ for (summaryPtr2 = nodePtr->summaryPtr; ;
+ summaryPtr2 = summaryPtr2->nextPtr) {
+ if (summaryPtr2 == NULL) {
+ if (summaryPtr->tagPtr->tagRootPtr == nodePtr) {
+ break;
+ }
+ Tcl_Panic("CheckNodeConsistency: node tag \"%s\" not %s",
+ summaryPtr->tagPtr->name,
+ "present in parent summaries");
+ }
+ if (summaryPtr->tagPtr == summaryPtr2->tagPtr) {
+ break;
+ }
+ }
+ }
+ numChildren++;
+ numLines += childNodePtr->numLines;
+ for (i = 0; i<references; i++) {
+ numPixels[i] += childNodePtr->numPixels[i];
+ }
+ }
+ }
+ if (numChildren != nodePtr->numChildren) {
+ Tcl_Panic("CheckNodeConsistency: mismatch in numChildren (%d %d)",
+ numChildren, nodePtr->numChildren);
+ }
+ if (numLines != nodePtr->numLines) {
+ Tcl_Panic("CheckNodeConsistency: mismatch in numLines (%d %d)",
+ numLines, nodePtr->numLines);
+ }
+ for (i = 0; i<references; i++) {
+ if (numPixels[i] != nodePtr->numPixels[i]) {
+ Tcl_Panic("CheckNodeConsistency: mismatch in numPixels (%d %d) for widget (%d)",
+ numPixels[i], nodePtr->numPixels[i], i);
+ }
+ }
+ if (references > PIXEL_CLIENTS) {
+ ckfree(numPixels);
+ }
+
+ for (summaryPtr = nodePtr->summaryPtr; summaryPtr != NULL;
+ summaryPtr = summaryPtr->nextPtr) {
+ if (summaryPtr->tagPtr->toggleCount == summaryPtr->toggleCount) {
+ Tcl_Panic("CheckNodeConsistency: found unpruned root for \"%s\"",
+ summaryPtr->tagPtr->name);
+ }
+ toggleCount = 0;
+ if (nodePtr->level == 0) {
+ for (linePtr = nodePtr->children.linePtr; linePtr != NULL;
+ linePtr = linePtr->nextPtr) {
+ for (segPtr = linePtr->segPtr; segPtr != NULL;
+ segPtr = segPtr->nextPtr) {
+ if ((segPtr->typePtr != &tkTextToggleOnType)
+ && (segPtr->typePtr != &tkTextToggleOffType)) {
+ continue;
+ }
+ if (segPtr->body.toggle.tagPtr == summaryPtr->tagPtr) {
+ toggleCount++;
+ }
+ }
+ }
+ } else {
+ for (childNodePtr = nodePtr->children.nodePtr;
+ childNodePtr != NULL;
+ childNodePtr = childNodePtr->nextPtr) {
+ for (summaryPtr2 = childNodePtr->summaryPtr;
+ summaryPtr2 != NULL;
+ summaryPtr2 = summaryPtr2->nextPtr) {
+ if (summaryPtr2->tagPtr == summaryPtr->tagPtr) {
+ toggleCount += summaryPtr2->toggleCount;
+ }
+ }
+ }
+ }
+ if (toggleCount != summaryPtr->toggleCount) {
+ Tcl_Panic("CheckNodeConsistency: mismatch in toggleCount (%d %d)",
+ toggleCount, summaryPtr->toggleCount);
+ }
+ for (summaryPtr2 = summaryPtr->nextPtr; summaryPtr2 != NULL;
+ summaryPtr2 = summaryPtr2->nextPtr) {
+ if (summaryPtr2->tagPtr == summaryPtr->tagPtr) {
+ Tcl_Panic("CheckNodeConsistency: duplicated node tag: %s",
+ summaryPtr->tagPtr->name);
+ }
+ }
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Rebalance --
+ *
+ * This function is called when a node of a B-tree appears to be out of
+ * balance (too many children, or too few). It rebalances that node and
+ * all of its ancestors in the tree.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The internal structure of treePtr may change.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+Rebalance(
+ BTree *treePtr, /* Tree that is being rebalanced. */
+ register Node *nodePtr) /* Node that may be out of balance. */
+{
+ /*
+ * Loop over the entire ancestral chain of the node, working up through
+ * the tree one node at a time until the root node has been processed.
+ */
+
+ for ( ; nodePtr != NULL; nodePtr = nodePtr->parentPtr) {
+ register Node *newPtr, *childPtr;
+ register TkTextLine *linePtr;
+ int i;
+
+ /*
+ * Check to see if the node has too many children. If it does, then
+ * split off all but the first MIN_CHILDREN into a separate node
+ * following the original one. Then repeat until the node has a decent
+ * size.
+ */
+
+ if (nodePtr->numChildren > MAX_CHILDREN) {
+ while (1) {
+ /*
+ * If the node being split is the root node, then make a new
+ * root node above it first.
+ */
+
+ if (nodePtr->parentPtr == NULL) {
+ newPtr = ckalloc(sizeof(Node));
+ newPtr->parentPtr = NULL;
+ newPtr->nextPtr = NULL;
+ newPtr->summaryPtr = NULL;
+ newPtr->level = nodePtr->level + 1;
+ newPtr->children.nodePtr = nodePtr;
+ newPtr->numChildren = 1;
+ newPtr->numLines = nodePtr->numLines;
+ newPtr->numPixels =
+ ckalloc(sizeof(int) * treePtr->pixelReferences);
+ for (i=0; i<treePtr->pixelReferences; i++) {
+ newPtr->numPixels[i] = nodePtr->numPixels[i];
+ }
+ RecomputeNodeCounts(treePtr, newPtr);
+ treePtr->rootPtr = newPtr;
+ }
+ newPtr = ckalloc(sizeof(Node));
+ newPtr->numPixels =
+ ckalloc(sizeof(int) * treePtr->pixelReferences);
+ for (i=0; i<treePtr->pixelReferences; i++) {
+ newPtr->numPixels[i] = 0;
+ }
+ newPtr->parentPtr = nodePtr->parentPtr;
+ newPtr->nextPtr = nodePtr->nextPtr;
+ nodePtr->nextPtr = newPtr;
+ newPtr->summaryPtr = NULL;
+ newPtr->level = nodePtr->level;
+ newPtr->numChildren = nodePtr->numChildren - MIN_CHILDREN;
+ if (nodePtr->level == 0) {
+ for (i = MIN_CHILDREN-1,
+ linePtr = nodePtr->children.linePtr;
+ i > 0; i--, linePtr = linePtr->nextPtr) {
+ /* Empty loop body. */
+ }
+ newPtr->children.linePtr = linePtr->nextPtr;
+ linePtr->nextPtr = NULL;
+ } else {
+ for (i = MIN_CHILDREN-1,
+ childPtr = nodePtr->children.nodePtr;
+ i > 0; i--, childPtr = childPtr->nextPtr) {
+ /* Empty loop body. */
+ }
+ newPtr->children.nodePtr = childPtr->nextPtr;
+ childPtr->nextPtr = NULL;
+ }
+ RecomputeNodeCounts(treePtr, nodePtr);
+ nodePtr->parentPtr->numChildren++;
+ nodePtr = newPtr;
+ if (nodePtr->numChildren <= MAX_CHILDREN) {
+ RecomputeNodeCounts(treePtr, nodePtr);
+ break;
+ }
+ }
+ }
+
+ while (nodePtr->numChildren < MIN_CHILDREN) {
+ register Node *otherPtr;
+ Node *halfwayNodePtr = NULL; /* Initialization needed only */
+ TkTextLine *halfwayLinePtr = NULL; /* to prevent cc warnings. */
+ int totalChildren, firstChildren, i;
+
+ /*
+ * Too few children for this node. If this is the root then, it's
+ * OK for it to have less than MIN_CHILDREN children as long as
+ * it's got at least two. If it has only one (and isn't at level
+ * 0), then chop the root node out of the tree and use its child
+ * as the new root.
+ */
+
+ if (nodePtr->parentPtr == NULL) {
+ if ((nodePtr->numChildren == 1) && (nodePtr->level > 0)) {
+ treePtr->rootPtr = nodePtr->children.nodePtr;
+ treePtr->rootPtr->parentPtr = NULL;
+ DeleteSummaries(nodePtr->summaryPtr);
+ ckfree(nodePtr);
+ }
+ return;
+ }
+
+ /*
+ * Not the root. Make sure that there are siblings to balance
+ * with.
+ */
+
+ if (nodePtr->parentPtr->numChildren < 2) {
+ Rebalance(treePtr, nodePtr->parentPtr);
+ continue;
+ }
+
+ /*
+ * Find a sibling neighbor to borrow from, and arrange for nodePtr
+ * to be the earlier of the pair.
+ */
+
+ if (nodePtr->nextPtr == NULL) {
+ for (otherPtr = nodePtr->parentPtr->children.nodePtr;
+ otherPtr->nextPtr != nodePtr;
+ otherPtr = otherPtr->nextPtr) {
+ /* Empty loop body. */
+ }
+ nodePtr = otherPtr;
+ }
+ otherPtr = nodePtr->nextPtr;
+
+ /*
+ * We're going to either merge the two siblings together into one
+ * node or redivide the children among them to balance their
+ * loads. As preparation, join their two child lists into a single
+ * list and remember the half-way point in the list.
+ */
+
+ totalChildren = nodePtr->numChildren + otherPtr->numChildren;
+ firstChildren = totalChildren/2;
+ if (nodePtr->children.nodePtr == NULL) {
+ nodePtr->children = otherPtr->children;
+ otherPtr->children.nodePtr = NULL;
+ otherPtr->children.linePtr = NULL;
+ }
+ if (nodePtr->level == 0) {
+ register TkTextLine *linePtr;
+
+ for (linePtr = nodePtr->children.linePtr, i = 1;
+ linePtr->nextPtr != NULL;
+ linePtr = linePtr->nextPtr, i++) {
+ if (i == firstChildren) {
+ halfwayLinePtr = linePtr;
+ }
+ }
+ linePtr->nextPtr = otherPtr->children.linePtr;
+ while (i <= firstChildren) {
+ halfwayLinePtr = linePtr;
+ linePtr = linePtr->nextPtr;
+ i++;
+ }
+ } else {
+ register Node *childPtr;
+
+ for (childPtr = nodePtr->children.nodePtr, i = 1;
+ childPtr->nextPtr != NULL;
+ childPtr = childPtr->nextPtr, i++) {
+ if (i <= firstChildren) {
+ if (i == firstChildren) {
+ halfwayNodePtr = childPtr;
+ }
+ }
+ }
+ childPtr->nextPtr = otherPtr->children.nodePtr;
+ while (i <= firstChildren) {
+ halfwayNodePtr = childPtr;
+ childPtr = childPtr->nextPtr;
+ i++;
+ }
+ }
+
+ /*
+ * If the two siblings can simply be merged together, do it.
+ */
+
+ if (totalChildren <= MAX_CHILDREN) {
+ RecomputeNodeCounts(treePtr, nodePtr);
+ nodePtr->nextPtr = otherPtr->nextPtr;
+ nodePtr->parentPtr->numChildren--;
+ DeleteSummaries(otherPtr->summaryPtr);
+ ckfree(otherPtr);
+ continue;
+ }
+
+ /*
+ * The siblings can't be merged, so just divide their children
+ * evenly between them.
+ */
+
+ if (nodePtr->level == 0) {
+ CLANG_ASSERT(halfwayLinePtr);
+ otherPtr->children.linePtr = halfwayLinePtr->nextPtr;
+ halfwayLinePtr->nextPtr = NULL;
+ } else {
+ CLANG_ASSERT(halfwayNodePtr);
+ otherPtr->children.nodePtr = halfwayNodePtr->nextPtr;
+ halfwayNodePtr->nextPtr = NULL;
+ }
+ RecomputeNodeCounts(treePtr, nodePtr);
+ RecomputeNodeCounts(treePtr, otherPtr);
+ }
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * RecomputeNodeCounts --
+ *
+ * This function is called to recompute all the counts in a node (tags,
+ * child information, etc.) by scanning the information in its
+ * descendants. This function is called during rebalancing when a node's
+ * child structure has changed.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The tag counts for nodePtr are modified to reflect its current child
+ * structure, as are its numChildren and numLines fields. Also, all of
+ * the childrens' parentPtr fields are made to point to nodePtr.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+RecomputeNodeCounts(
+ register BTree *treePtr, /* The whole B-tree. */
+ register Node *nodePtr) /* Node whose tag summary information must be
+ * recomputed. */
+{
+ register Summary *summaryPtr, *summaryPtr2;
+ register Node *childPtr;
+ register TkTextLine *linePtr;
+ register TkTextSegment *segPtr;
+ TkTextTag *tagPtr;
+ int ref;
+
+ /*
+ * Zero out all the existing counts for the node, but don't delete the
+ * existing Summary records (most of them will probably be reused).
+ */
+
+ for (summaryPtr = nodePtr->summaryPtr; summaryPtr != NULL;
+ summaryPtr = summaryPtr->nextPtr) {
+ summaryPtr->toggleCount = 0;
+ }
+ nodePtr->numChildren = 0;
+ nodePtr->numLines = 0;
+ for (ref = 0; ref<treePtr->pixelReferences; ref++) {
+ nodePtr->numPixels[ref] = 0;
+ }
+
+ /*
+ * Scan through the children, adding the childrens' tag counts into the
+ * node's tag counts and adding new Summary structures if necessary.
+ */
+
+ if (nodePtr->level == 0) {
+ for (linePtr = nodePtr->children.linePtr; linePtr != NULL;
+ linePtr = linePtr->nextPtr) {
+ nodePtr->numChildren++;
+ nodePtr->numLines++;
+ for (ref = 0; ref<treePtr->pixelReferences; ref++) {
+ nodePtr->numPixels[ref] += linePtr->pixels[2 * ref];
+ }
+ linePtr->parentPtr = nodePtr;
+ for (segPtr = linePtr->segPtr; segPtr != NULL;
+ segPtr = segPtr->nextPtr) {
+ if (((segPtr->typePtr != &tkTextToggleOnType)
+ && (segPtr->typePtr != &tkTextToggleOffType))
+ || !(segPtr->body.toggle.inNodeCounts)) {
+ continue;
+ }
+ tagPtr = segPtr->body.toggle.tagPtr;
+ for (summaryPtr = nodePtr->summaryPtr; ;
+ summaryPtr = summaryPtr->nextPtr) {
+ if (summaryPtr == NULL) {
+ summaryPtr = ckalloc(sizeof(Summary));
+ summaryPtr->tagPtr = tagPtr;
+ summaryPtr->toggleCount = 1;
+ summaryPtr->nextPtr = nodePtr->summaryPtr;
+ nodePtr->summaryPtr = summaryPtr;
+ break;
+ }
+ if (summaryPtr->tagPtr == tagPtr) {
+ summaryPtr->toggleCount++;
+ break;
+ }
+ }
+ }
+ }
+ } else {
+ for (childPtr = nodePtr->children.nodePtr; childPtr != NULL;
+ childPtr = childPtr->nextPtr) {
+ nodePtr->numChildren++;
+ nodePtr->numLines += childPtr->numLines;
+ for (ref = 0; ref<treePtr->pixelReferences; ref++) {
+ nodePtr->numPixels[ref] += childPtr->numPixels[ref];
+ }
+ childPtr->parentPtr = nodePtr;
+ for (summaryPtr2 = childPtr->summaryPtr; summaryPtr2 != NULL;
+ summaryPtr2 = summaryPtr2->nextPtr) {
+ for (summaryPtr = nodePtr->summaryPtr; ;
+ summaryPtr = summaryPtr->nextPtr) {
+ if (summaryPtr == NULL) {
+ summaryPtr = ckalloc(sizeof(Summary));
+ summaryPtr->tagPtr = summaryPtr2->tagPtr;
+ summaryPtr->toggleCount = summaryPtr2->toggleCount;
+ summaryPtr->nextPtr = nodePtr->summaryPtr;
+ nodePtr->summaryPtr = summaryPtr;
+ break;
+ }
+ if (summaryPtr->tagPtr == summaryPtr2->tagPtr) {
+ summaryPtr->toggleCount += summaryPtr2->toggleCount;
+ break;
+ }
+ }
+ }
+ }
+ }
+
+ /*
+ * Scan through the node's tag records again and delete any Summary
+ * records that still have a zero count, or that have all the toggles.
+ * The node with the children that account for all the tags toggles have
+ * no summary information, and they become the tagRootPtr for the tag.
+ */
+
+ summaryPtr2 = NULL;
+ for (summaryPtr = nodePtr->summaryPtr; summaryPtr != NULL; ) {
+ if (summaryPtr->toggleCount > 0 &&
+ summaryPtr->toggleCount < summaryPtr->tagPtr->toggleCount) {
+ if (nodePtr->level == summaryPtr->tagPtr->tagRootPtr->level) {
+ /*
+ * The tag's root node split and some toggles left. The tag
+ * root must move up a level.
+ */
+
+ summaryPtr->tagPtr->tagRootPtr = nodePtr->parentPtr;
+ }
+ summaryPtr2 = summaryPtr;
+ summaryPtr = summaryPtr->nextPtr;
+ continue;
+ }
+ if (summaryPtr->toggleCount == summaryPtr->tagPtr->toggleCount) {
+ /*
+ * A node merge has collected all the toggles under one node. Push
+ * the root down to this level.
+ */
+
+ summaryPtr->tagPtr->tagRootPtr = nodePtr;
+ }
+ if (summaryPtr2 != NULL) {
+ summaryPtr2->nextPtr = summaryPtr->nextPtr;
+ ckfree(summaryPtr);
+ summaryPtr = summaryPtr2->nextPtr;
+ } else {
+ nodePtr->summaryPtr = summaryPtr->nextPtr;
+ ckfree(summaryPtr);
+ summaryPtr = nodePtr->summaryPtr;
+ }
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkBTreeNumLines --
+ *
+ * This function returns a count of the number of logical lines of text
+ * present in a given B-tree.
+ *
+ * Results:
+ * The return value is a count of the number of usable lines in tree
+ * (i.e. it doesn't include the dummy line that is just used to mark the
+ * end of the tree).
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TkBTreeNumLines(
+ TkTextBTree tree, /* Information about tree. */
+ const TkText *textPtr) /* Relative to this client of the B-tree. */
+{
+ BTree *treePtr = (BTree *) tree;
+ int count;
+
+ if (textPtr != NULL && textPtr->end != NULL) {
+ count = TkBTreeLinesTo(NULL, textPtr->end);
+ } else {
+ count = treePtr->rootPtr->numLines - 1;
+ }
+ if (textPtr != NULL && textPtr->start != NULL) {
+ count -= TkBTreeLinesTo(NULL, textPtr->start);
+ }
+
+ return count;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkBTreeNumPixels --
+ *
+ * This function returns a count of the number of pixels of text present
+ * in a given widget's B-tree representation.
+ *
+ * Results:
+ * The return value is a count of the number of usable pixels in tree
+ * (since the dummy line used to mark the end of the B-tree is maintained
+ * with zero height, as are any lines that are before or after the
+ * '-start -end' range of the text widget in question, the number stored
+ * at the root is the number we want).
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TkBTreeNumPixels(
+ TkTextBTree tree, /* The B-tree. */
+ const TkText *textPtr) /* Relative to this client of the B-tree. */
+{
+ BTree *treePtr = (BTree *) tree;
+ return treePtr->rootPtr->numPixels[textPtr->pixelReference];
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * CharSplitProc --
+ *
+ * This function implements splitting for character segments.
+ *
+ * Results:
+ * The return value is a pointer to a chain of two segments that have the
+ * same characters as segPtr except split among the two segments.
+ *
+ * Side effects:
+ * Storage for segPtr is freed.
+ *
+ *--------------------------------------------------------------
+ */
+
+static TkTextSegment *
+CharSplitProc(
+ TkTextSegment *segPtr, /* Pointer to segment to split. */
+ int index) /* Position within segment at which to
+ * split. */
+{
+ TkTextSegment *newPtr1, *newPtr2;
+
+ newPtr1 = ckalloc(CSEG_SIZE(index));
+ newPtr2 = ckalloc(CSEG_SIZE(segPtr->size - index));
+ newPtr1->typePtr = &tkTextCharType;
+ newPtr1->nextPtr = newPtr2;
+ newPtr1->size = index;
+ memcpy(newPtr1->body.chars, segPtr->body.chars, (size_t) index);
+ newPtr1->body.chars[index] = 0;
+ newPtr2->typePtr = &tkTextCharType;
+ newPtr2->nextPtr = segPtr->nextPtr;
+ newPtr2->size = segPtr->size - index;
+ memcpy(newPtr2->body.chars, segPtr->body.chars + index, newPtr2->size);
+ newPtr2->body.chars[newPtr2->size] = 0;
+ ckfree(segPtr);
+ return newPtr1;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * CharCleanupProc --
+ *
+ * This function merges adjacent character segments into a single
+ * character segment, if possible.
+ *
+ * Results:
+ * The return value is a pointer to the first segment in the (new) list
+ * of segments that used to start with segPtr.
+ *
+ * Side effects:
+ * Storage for the segments may be allocated and freed.
+ *
+ *--------------------------------------------------------------
+ */
+
+ /* ARGSUSED */
+static TkTextSegment *
+CharCleanupProc(
+ TkTextSegment *segPtr, /* Pointer to first of two adjacent segments
+ * to join. */
+ TkTextLine *linePtr) /* Line containing segments (not used). */
+{
+ TkTextSegment *segPtr2, *newPtr;
+
+ segPtr2 = segPtr->nextPtr;
+ if ((segPtr2 == NULL) || (segPtr2->typePtr != &tkTextCharType)) {
+ return segPtr;
+ }
+ newPtr = ckalloc(CSEG_SIZE(segPtr->size + segPtr2->size));
+ newPtr->typePtr = &tkTextCharType;
+ newPtr->nextPtr = segPtr2->nextPtr;
+ newPtr->size = segPtr->size + segPtr2->size;
+ memcpy(newPtr->body.chars, segPtr->body.chars, segPtr->size);
+ memcpy(newPtr->body.chars + segPtr->size, segPtr2->body.chars, segPtr2->size);
+ newPtr->body.chars[newPtr->size] = 0;
+ ckfree(segPtr);
+ ckfree(segPtr2);
+ return newPtr;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * CharDeleteProc --
+ *
+ * This function is invoked to delete a character segment.
+ *
+ * Results:
+ * Always returns 0 to indicate that the segment was deleted.
+ *
+ * Side effects:
+ * Storage for the segment is freed.
+ *
+ *--------------------------------------------------------------
+ */
+
+ /* ARGSUSED */
+static int
+CharDeleteProc(
+ TkTextSegment *segPtr, /* Segment to delete. */
+ TkTextLine *linePtr, /* Line containing segment. */
+ int treeGone) /* Non-zero means the entire tree is being
+ * deleted, so everything must get cleaned
+ * up. */
+{
+ ckfree(segPtr);
+ return 0;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * CharCheckProc --
+ *
+ * This function is invoked to perform consistency checks on character
+ * segments.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * If the segment isn't inconsistent then the function panics.
+ *
+ *--------------------------------------------------------------
+ */
+
+ /* ARGSUSED */
+static void
+CharCheckProc(
+ TkTextSegment *segPtr, /* Segment to check. */
+ TkTextLine *linePtr) /* Line containing segment. */
+{
+ /*
+ * Make sure that the segment contains the number of characters indicated
+ * by its header, and that the last segment in a line ends in a newline.
+ * Also make sure that there aren't ever two character segments adjacent
+ * to each other: they should be merged together.
+ */
+
+ if (segPtr->size <= 0) {
+ Tcl_Panic("CharCheckProc: segment has size <= 0");
+ }
+ if (strlen(segPtr->body.chars) != (size_t) segPtr->size) {
+ Tcl_Panic("CharCheckProc: segment has wrong size");
+ }
+ if (segPtr->nextPtr == NULL) {
+ if (segPtr->body.chars[segPtr->size-1] != '\n') {
+ Tcl_Panic("CharCheckProc: line doesn't end with newline");
+ }
+ } else if (segPtr->nextPtr->typePtr == &tkTextCharType) {
+ Tcl_Panic("CharCheckProc: adjacent character segments weren't merged");
+ }
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * ToggleDeleteProc --
+ *
+ * This function is invoked to delete toggle segments.
+ *
+ * Results:
+ * Returns 1 to indicate that the segment may not be deleted, unless the
+ * entire B-tree is going away.
+ *
+ * Side effects:
+ * If the tree is going away then the toggle's memory is freed; otherwise
+ * the toggle counts in nodes above the segment get updated.
+ *
+ *--------------------------------------------------------------
+ */
+
+static int
+ToggleDeleteProc(
+ TkTextSegment *segPtr, /* Segment to check. */
+ TkTextLine *linePtr, /* Line containing segment. */
+ int treeGone) /* Non-zero means the entire tree is being
+ * deleted, so everything must get cleaned
+ * up. */
+{
+ if (treeGone) {
+ ckfree(segPtr);
+ return 0;
+ }
+
+ /*
+ * This toggle is in the middle of a range of characters that's being
+ * deleted. Refuse to die. We'll be moved to the end of the deleted range
+ * and our cleanup function will be called later. Decrement node toggle
+ * counts here, and set a flag so we'll re-increment them in the cleanup
+ * function.
+ */
+
+ if (segPtr->body.toggle.inNodeCounts) {
+ ChangeNodeToggleCount(linePtr->parentPtr,
+ segPtr->body.toggle.tagPtr, -1);
+ segPtr->body.toggle.inNodeCounts = 0;
+ }
+ return 1;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * ToggleCleanupProc --
+ *
+ * This function is called when a toggle is part of a line that's been
+ * modified in some way. It's invoked after the modifications are
+ * complete.
+ *
+ * Results:
+ * The return value is the head segment in a new list that is to replace
+ * the tail of the line that used to start at segPtr. This allows the
+ * function to delete or modify segPtr.
+ *
+ * Side effects:
+ * Toggle counts in the nodes above the new line will be updated if
+ * they're not already. Toggles may be collapsed if there are duplicate
+ * toggles at the same position.
+ *
+ *--------------------------------------------------------------
+ */
+
+static TkTextSegment *
+ToggleCleanupProc(
+ TkTextSegment *segPtr, /* Segment to check. */
+ TkTextLine *linePtr) /* Line that now contains segment. */
+{
+ TkTextSegment *segPtr2, *prevPtr;
+ int counts;
+
+ /*
+ * If this is a toggle-off segment, look ahead through the next segments
+ * to see if there's a toggle-on segment for the same tag before any
+ * segments with non-zero size. If so then the two toggles cancel each
+ * other; remove them both.
+ */
+
+ if (segPtr->typePtr == &tkTextToggleOffType) {
+ for (prevPtr = segPtr, segPtr2 = prevPtr->nextPtr;
+ (segPtr2 != NULL) && (segPtr2->size == 0);
+ prevPtr = segPtr2, segPtr2 = prevPtr->nextPtr) {
+ if (segPtr2->typePtr != &tkTextToggleOnType) {
+ continue;
+ }
+ if (segPtr2->body.toggle.tagPtr != segPtr->body.toggle.tagPtr) {
+ continue;
+ }
+ counts = segPtr->body.toggle.inNodeCounts
+ + segPtr2->body.toggle.inNodeCounts;
+ if (counts != 0) {
+ ChangeNodeToggleCount(linePtr->parentPtr,
+ segPtr->body.toggle.tagPtr, -counts);
+ }
+ prevPtr->nextPtr = segPtr2->nextPtr;
+ ckfree(segPtr2);
+ segPtr2 = segPtr->nextPtr;
+ ckfree(segPtr);
+ return segPtr2;
+ }
+ }
+
+ if (!segPtr->body.toggle.inNodeCounts) {
+ ChangeNodeToggleCount(linePtr->parentPtr,
+ segPtr->body.toggle.tagPtr, 1);
+ segPtr->body.toggle.inNodeCounts = 1;
+ }
+ return segPtr;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * ToggleLineChangeProc --
+ *
+ * This function is invoked when a toggle segment is about to move from
+ * one line to another.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Toggle counts are decremented in the nodes above the line.
+ *
+ *--------------------------------------------------------------
+ */
+
+static void
+ToggleLineChangeProc(
+ TkTextSegment *segPtr, /* Segment to check. */
+ TkTextLine *linePtr) /* Line that used to contain segment. */
+{
+ if (segPtr->body.toggle.inNodeCounts) {
+ ChangeNodeToggleCount(linePtr->parentPtr,
+ segPtr->body.toggle.tagPtr, -1);
+ segPtr->body.toggle.inNodeCounts = 0;
+ }
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * ToggleCheckProc --
+ *
+ * This function is invoked to perform consistency checks on toggle
+ * segments.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * If a consistency problem is found the function panics.
+ *
+ *--------------------------------------------------------------
+ */
+
+static void
+ToggleCheckProc(
+ TkTextSegment *segPtr, /* Segment to check. */
+ TkTextLine *linePtr) /* Line containing segment. */
+{
+ register Summary *summaryPtr;
+ int needSummary;
+
+ if (segPtr->size != 0) {
+ Tcl_Panic("ToggleCheckProc: segment had non-zero size");
+ }
+ if (!segPtr->body.toggle.inNodeCounts) {
+ Tcl_Panic("ToggleCheckProc: toggle counts not updated in nodes");
+ }
+ needSummary = (segPtr->body.toggle.tagPtr->tagRootPtr!=linePtr->parentPtr);
+ for (summaryPtr = linePtr->parentPtr->summaryPtr; ;
+ summaryPtr = summaryPtr->nextPtr) {
+ if (summaryPtr == NULL) {
+ if (needSummary) {
+ Tcl_Panic("ToggleCheckProc: tag not present in node");
+ } else {
+ break;
+ }
+ }
+ if (summaryPtr->tagPtr == segPtr->body.toggle.tagPtr) {
+ if (!needSummary) {
+ Tcl_Panic("ToggleCheckProc: tag present in root node summary");
+ }
+ break;
+ }
+ }
+}
+
+/*
+ * Local Variables:
+ * mode: c
+ * c-basic-offset: 4
+ * fill-column: 78
+ * End:
+ */
diff --git a/tk8.6/generic/tkTextDisp.c b/tk8.6/generic/tkTextDisp.c
new file mode 100644
index 0000000..a135084
--- /dev/null
+++ b/tk8.6/generic/tkTextDisp.c
@@ -0,0 +1,8990 @@
+/*
+ * tkTextDisp.c --
+ *
+ * This module provides facilities to display text widgets. It is the
+ * only place where information is kept about the screen layout of text
+ * widgets. (Well, strictly, each TkTextLine and B-tree node caches its
+ * last observed pixel height, but that information originates here).
+ *
+ * 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.
+ */
+
+#include "tkInt.h"
+#include "tkText.h"
+
+#ifdef _WIN32
+#include "tkWinInt.h"
+#elif defined(__CYGWIN__)
+#include "tkUnixInt.h"
+#endif
+
+#ifdef MAC_OSX_TK
+#include "tkMacOSXInt.h"
+#endif
+
+/*
+ * "Calculations of line pixel heights and the size of the vertical
+ * scrollbar."
+ *
+ * Given that tag, font and elide changes can happen to large numbers of
+ * diverse chunks in a text widget containing megabytes of text, it is not
+ * possible to recalculate all affected height information immediately any
+ * such change takes place and maintain a responsive user-experience. Yet, for
+ * an accurate vertical scrollbar to be drawn, we must know the total number
+ * of vertical pixels shown on display versus the number available to be
+ * displayed.
+ *
+ * The way the text widget solves this problem is by maintaining cached line
+ * pixel heights (in the BTree for each logical line), and having asynchronous
+ * timer callbacks (i) to iterate through the logical lines recalculating
+ * their heights, and (ii) to recalculate the vertical scrollbar's position
+ * and size.
+ *
+ * Typically this works well but there are some situations where the overall
+ * functional design of this file causes some problems. These problems can
+ * only arise because the calculations used to display lines on screen are not
+ * connected to those in the iterating-line- recalculation-process.
+ *
+ * The reason for this disconnect is that the display calculations operate in
+ * display lines, and the iteration and cache operates in logical lines.
+ * Given that the display calculations both need not contain complete logical
+ * lines (at top or bottom of display), and that they do not actually keep
+ * track of logical lines (for simplicity of code and historical design), this
+ * means a line may be known and drawn with a different pixel height to that
+ * which is cached in the BTree, and this might cause some temporary
+ * undesirable mismatch between display and the vertical scrollbar.
+ *
+ * All such mismatches should be temporary, however, since the asynchronous
+ * height calculations will always catch up eventually.
+ *
+ * For further details see the comments before and within the following
+ * functions below: LayoutDLine, AsyncUpdateLineMetrics, GetYView,
+ * GetYPixelCount, TkTextUpdateOneLine, TkTextUpdateLineMetrics.
+ *
+ * For details of the way in which the BTree keeps track of pixel heights, see
+ * tkTextBTree.c. Basically the BTree maintains two pieces of information: the
+ * logical line indices and the pixel height cache.
+ */
+
+/*
+ * TK_LAYOUT_WITH_BASE_CHUNKS:
+ *
+ * With this macro set, collect all char chunks that have no holes
+ * between them, that are on the same line and use the same font and font
+ * size. Allocate the chars of all these chunks, the so-called "stretch",
+ * in a DString in the first chunk, the so-called "base chunk". Use the
+ * base chunk string for measuring and drawing, so that these actions are
+ * always performed with maximum context.
+ *
+ * This is necessary for text rendering engines that provide ligatures
+ * and sub-pixel layout, like ATSU on Mac. If we don't do this, the
+ * measuring will change all the time, leading to an ugly "tremble and
+ * shiver" effect. This is because of the continuous splitting and
+ * re-merging of chunks that goes on in a text widget, when the cursor or
+ * the selection move.
+ *
+ * Side effects:
+ *
+ * Memory management changes. Instead of attaching the character data to
+ * the clientData structures of the char chunks, an additional DString is
+ * used. The collection process will even lead to resizing this DString
+ * for large stretches (> TCL_DSTRING_STATIC_SIZE == 200). We could
+ * reduce the overall memory footprint by copying the result to a plain
+ * char array after the line breaking process, but that would complicate
+ * the code and make performance even worse speedwise. See also TODOs.
+ *
+ * TODOs:
+ *
+ * - Move the character collection process from the LayoutProc into
+ * LayoutDLine(), so that the collection can be done before actual
+ * layout. In this way measuring can look at the following text, too,
+ * right from the beginning. Memory handling can also be improved with
+ * this. Problem: We don't easily know which chunks are adjacent until
+ * all the other chunks have calculated their width. Apparently marks
+ * would return width==0. A separate char collection loop would have to
+ * know these things.
+ *
+ * - Use a new context parameter to pass the context from LayoutDLine() to
+ * the LayoutProc instead of using a global variable like now. Not
+ * pressing until the previous point gets implemented.
+ */
+
+/*
+ * The following structure describes how to display a range of characters.
+ * The information is generated by scanning all of the tags associated with
+ * the characters and combining that with default information for the overall
+ * widget. These structures form the hash keys for dInfoPtr->styleTable.
+ */
+
+typedef struct StyleValues {
+ Tk_3DBorder border; /* Used for drawing background under text.
+ * NULL means use widget background. */
+ int borderWidth; /* Width of 3-D border for background. */
+ int relief; /* 3-D relief for background. */
+ Pixmap bgStipple; /* Stipple bitmap for background. None means
+ * draw solid. */
+ XColor *fgColor; /* Foreground color for text. */
+ Tk_Font tkfont; /* Font for displaying text. */
+ Pixmap fgStipple; /* Stipple bitmap for text and other
+ * foreground stuff. None means draw solid.*/
+ int justify; /* Justification style for text. */
+ int lMargin1; /* Left margin, in pixels, for first display
+ * line of each text line. */
+ int lMargin2; /* Left margin, in pixels, for second and
+ * later display lines of each text line. */
+ Tk_3DBorder lMarginColor; /* Color of left margins (1 and 2). */
+ int offset; /* Offset in pixels of baseline, relative to
+ * baseline of line. */
+ int overstrike; /* Non-zero means draw overstrike through
+ * text. */
+ XColor *overstrikeColor; /* Foreground color for overstrike through
+ * text. */
+ int rMargin; /* Right margin, in pixels. */
+ Tk_3DBorder rMarginColor; /* Color of right margin. */
+ int spacing1; /* Spacing above first dline in text line. */
+ int spacing2; /* Spacing between lines of dline. */
+ int spacing3; /* Spacing below last dline in text line. */
+ TkTextTabArray *tabArrayPtr;/* Locations and types of tab stops (may be
+ * NULL). */
+ int tabStyle; /* One of TABULAR or WORDPROCESSOR. */
+ int underline; /* Non-zero means draw underline underneath
+ * text. */
+ XColor *underlineColor; /* Foreground color for underline underneath
+ * text. */
+ int elide; /* Zero means draw text, otherwise not. */
+ TkWrapMode wrapMode; /* How to handle wrap-around for this tag.
+ * One of TEXT_WRAPMODE_CHAR,
+ * TEXT_WRAPMODE_NONE or TEXT_WRAPMODE_WORD.*/
+} StyleValues;
+
+/*
+ * The following structure extends the StyleValues structure above with
+ * graphics contexts used to actually draw the characters. The entries in
+ * dInfoPtr->styleTable point to structures of this type.
+ */
+
+typedef struct TextStyle {
+ int refCount; /* Number of times this structure is
+ * referenced in Chunks. */
+ GC bgGC; /* Graphics context for background. None means
+ * use widget background. */
+ GC fgGC; /* Graphics context for foreground. */
+ GC ulGC; /* Graphics context for underline. */
+ GC ovGC; /* Graphics context for overstrike. */
+ StyleValues *sValuePtr; /* Raw information from which GCs were
+ * derived. */
+ Tcl_HashEntry *hPtr; /* Pointer to entry in styleTable. Used to
+ * delete entry. */
+} TextStyle;
+
+/*
+ * The following macro determines whether two styles have the same background
+ * so that, for example, no beveled border should be drawn between them.
+ */
+
+#define SAME_BACKGROUND(s1, s2) \
+ (((s1)->sValuePtr->border == (s2)->sValuePtr->border) \
+ && ((s1)->sValuePtr->borderWidth == (s2)->sValuePtr->borderWidth) \
+ && ((s1)->sValuePtr->relief == (s2)->sValuePtr->relief) \
+ && ((s1)->sValuePtr->bgStipple == (s2)->sValuePtr->bgStipple))
+
+/*
+ * The following macro is used to compare two floating-point numbers to within
+ * a certain degree of scale. Direct comparison fails on processors where the
+ * processor and memory representations of FP numbers of a particular
+ * precision is different (e.g. Intel)
+ */
+
+#define FP_EQUAL_SCALE(double1, double2, scaleFactor) \
+ (fabs((double1)-(double2))*((scaleFactor)+1.0) < 0.3)
+
+/*
+ * Macro to make debugging/testing logging a little easier.
+ */
+
+#define LOG(toVar,what) \
+ Tcl_SetVar2(textPtr->interp, toVar, NULL, (what), \
+ TCL_GLOBAL_ONLY|TCL_APPEND_VALUE|TCL_LIST_ELEMENT)
+
+/*
+ * The following structure describes one line of the display, which may be
+ * either part or all of one line of the text.
+ */
+
+typedef struct DLine {
+ TkTextIndex index; /* Identifies first character in text that is
+ * displayed on this line. */
+ int byteCount; /* Number of bytes accounted for by this
+ * display line, including a trailing space or
+ * newline that isn't actually displayed. */
+ int logicalLinesMerged; /* Number of extra logical lines merged into
+ * this one due to elided newlines. */
+ int y; /* Y-position at which line is supposed to be
+ * drawn (topmost pixel of rectangular area
+ * occupied by line). */
+ int oldY; /* Y-position at which line currently appears
+ * on display. This is used to move lines by
+ * scrolling rather than re-drawing. If
+ * 'flags' have the OLD_Y_INVALID bit set,
+ * then we will never examine this field
+ * (which means line isn't currently visible
+ * on display and must be redrawn). */
+ int height; /* Height of line, in pixels. */
+ int baseline; /* Offset of text baseline from y, in
+ * pixels. */
+ int spaceAbove; /* How much extra space was added to the top
+ * of the line because of spacing options.
+ * This is included in height and baseline. */
+ int spaceBelow; /* How much extra space was added to the
+ * bottom of the line because of spacing
+ * options. This is included in height. */
+ Tk_3DBorder lMarginColor; /* Background color of the area corresponding
+ * to the left margin of the display line. */
+ int lMarginWidth; /* Pixel width of the area corresponding to
+ * the left margin. */
+ Tk_3DBorder rMarginColor; /* Background color of the area corresponding
+ * to the right margin of the display line. */
+ int rMarginWidth; /* Pixel width of the area corresponding to
+ * the right margin. */
+ int length; /* Total length of line, in pixels. */
+ TkTextDispChunk *chunkPtr; /* Pointer to first chunk in list of all of
+ * those that are displayed on this line of
+ * the screen. */
+ struct DLine *nextPtr; /* Next in list of all display lines for this
+ * window. The list is sorted in order from
+ * top to bottom. Note: the next DLine doesn't
+ * always correspond to the next line of text:
+ * (a) can have multiple DLines for one text
+ * line (wrapping), (b) can have elided newlines,
+ * and (c) can have gaps where DLine's
+ * have been deleted because they're out of
+ * date. */
+ int flags; /* Various flag bits: see below for values. */
+} DLine;
+
+/*
+ * Flag bits for DLine structures:
+ *
+ * HAS_3D_BORDER - Non-zero means that at least one of the chunks
+ * in this line has a 3D border, so it
+ * potentially interacts with 3D borders in
+ * neighboring lines (see DisplayLineBackground).
+ * NEW_LAYOUT - Non-zero means that the line has been
+ * re-layed out since the last time the display
+ * was updated.
+ * TOP_LINE - Non-zero means that this was the top line in
+ * in the window the last time that the window
+ * was laid out. This is important because a line
+ * may be displayed differently if its at the top
+ * or bottom than if it's in the middle
+ * (e.g. beveled edges aren't displayed for
+ * middle lines if the adjacent line has a
+ * similar background).
+ * BOTTOM_LINE - Non-zero means that this was the bottom line
+ * in the window the last time that the window
+ * was laid out.
+ * OLD_Y_INVALID - The value of oldY in the structure is not
+ * valid or useful and should not be examined.
+ * 'oldY' is only useful when the DLine is
+ * currently displayed at a different position
+ * and we wish to re-display it via scrolling, so
+ * this means the DLine needs redrawing.
+ */
+
+#define HAS_3D_BORDER 1
+#define NEW_LAYOUT 2
+#define TOP_LINE 4
+#define BOTTOM_LINE 8
+#define OLD_Y_INVALID 16
+
+/*
+ * Overall display information for a text widget:
+ */
+
+typedef struct TextDInfo {
+ Tcl_HashTable styleTable; /* Hash table that maps from StyleValues to
+ * TextStyles for this widget. */
+ DLine *dLinePtr; /* First in list of all display lines for this
+ * widget, in order from top to bottom. */
+ int topPixelOffset; /* Identifies first pixel in top display line
+ * to display in window. */
+ int newTopPixelOffset; /* Desired first pixel in top display line to
+ * display in window. */
+ GC copyGC; /* Graphics context for copying from off-
+ * screen pixmaps onto screen. */
+ GC scrollGC; /* Graphics context for copying from one place
+ * in the window to another (scrolling):
+ * differs from copyGC in that we need to get
+ * GraphicsExpose events. */
+ int x; /* First x-coordinate that may be used for
+ * actually displaying line information.
+ * Leaves space for border, etc. */
+ int y; /* First y-coordinate that may be used for
+ * actually displaying line information.
+ * Leaves space for border, etc. */
+ int maxX; /* First x-coordinate to right of available
+ * space for displaying lines. */
+ int maxY; /* First y-coordinate below available space
+ * for displaying lines. */
+ int topOfEof; /* Top-most pixel (lowest y-value) that has
+ * been drawn in the appropriate fashion for
+ * the portion of the window after the last
+ * line of the text. This field is used to
+ * figure out when to redraw part or all of
+ * the eof field. */
+
+ /*
+ * Information used for scrolling:
+ */
+
+ int newXPixelOffset; /* Desired x scroll position, measured as the
+ * number of pixels off-screen to the left for
+ * a line with no left margin. */
+ int curXPixelOffset; /* Actual x scroll position, measured as the
+ * number of pixels off-screen to the left. */
+ int maxLength; /* Length in pixels of longest line that's
+ * visible in window (length may exceed window
+ * size). If there's no wrapping, this will be
+ * zero. */
+ double xScrollFirst, xScrollLast;
+ /* Most recent values reported to horizontal
+ * scrollbar; used to eliminate unnecessary
+ * reports. */
+ double yScrollFirst, yScrollLast;
+ /* Most recent values reported to vertical
+ * scrollbar; used to eliminate unnecessary
+ * reports. */
+
+ /*
+ * The following information is used to implement scanning:
+ */
+
+ int scanMarkXPixel; /* Pixel index of left edge of the window when
+ * the scan started. */
+ int scanMarkX; /* X-position of mouse at time scan started. */
+ int scanTotalYScroll; /* Total scrolling (in screen pixels) that has
+ * occurred since scanMarkY was set. */
+ int scanMarkY; /* Y-position of mouse at time scan started. */
+
+ /*
+ * Miscellaneous information:
+ */
+
+ int dLinesInvalidated; /* This value is set to 1 whenever something
+ * happens that invalidates information in
+ * DLine structures; if a redisplay is in
+ * progress, it will see this and abort the
+ * redisplay. This is needed because, for
+ * example, an embedded window could change
+ * its size when it is first displayed,
+ * invalidating the DLine that is currently
+ * being displayed. If redisplay continues, it
+ * will use freed memory and could dump
+ * core. */
+ int flags; /* Various flag values: see below for
+ * definitions. */
+ /*
+ * Information used to handle the asynchronous updating of the y-scrollbar
+ * and the vertical height calculations:
+ */
+
+ int lineMetricUpdateEpoch; /* Stores a number which is incremented each
+ * time the text widget changes in a
+ * significant way (e.g. resizing or
+ * geometry-influencing tag changes). */
+ int currentMetricUpdateLine;/* Stores a counter which is used to iterate
+ * over the logical lines contained in the
+ * widget and update their geometry
+ * calculations, if they are out of date. */
+ TkTextIndex metricIndex; /* If the current metric update line wraps
+ * into very many display lines, then this is
+ * used to keep track of what index we've got
+ * to so far... */
+ int metricPixelHeight; /* ...and this is for the height calculation
+ * so far...*/
+ int metricEpoch; /* ...and this for the epoch of the partial
+ * calculation so it can be cancelled if
+ * things change once more. This field will be
+ * -1 if there is no long-line calculation in
+ * progress, and take a non-negative value if
+ * there is such a calculation in progress. */
+ int lastMetricUpdateLine; /* When the current update line reaches this
+ * line, we are done and should stop the
+ * asychronous callback mechanism. */
+ Tcl_TimerToken lineUpdateTimer;
+ /* A token pointing to the current line metric
+ * update callback. */
+ Tcl_TimerToken scrollbarTimer;
+ /* A token pointing to the current scrollbar
+ * update callback. */
+} TextDInfo;
+
+/*
+ * In TkTextDispChunk structures for character segments, the clientData field
+ * points to one of the following structures:
+ */
+
+#if !TK_LAYOUT_WITH_BASE_CHUNKS
+
+typedef struct CharInfo {
+ int numBytes; /* Number of bytes to display. */
+ char chars[1]; /* UTF characters to display. Actual size will
+ * be numBytes, not 1. THIS MUST BE THE LAST
+ * FIELD IN THE STRUCTURE. */
+} CharInfo;
+
+#else /* TK_LAYOUT_WITH_BASE_CHUNKS */
+
+typedef struct CharInfo {
+ TkTextDispChunk *baseChunkPtr;
+ int baseOffset; /* Starting offset in base chunk
+ * baseChars. */
+ int numBytes; /* Number of bytes that belong to this
+ * chunk. */
+ const char *chars; /* UTF characters to display. Actually points
+ * into the baseChars of the base chunk. Only
+ * valid after FinalizeBaseChunk(). */
+} CharInfo;
+
+/*
+ * The BaseCharInfo is a CharInfo with some additional data added.
+ */
+
+typedef struct BaseCharInfo {
+ CharInfo ci;
+ Tcl_DString baseChars; /* Actual characters for the stretch of text
+ * represented by this base chunk. */
+ int width; /* Width in pixels of the whole string, if
+ * known, else -1. Valid during
+ * LayoutDLine(). */
+} BaseCharInfo;
+
+/* TODO: Thread safety */
+static TkTextDispChunk *baseCharChunkPtr = NULL;
+
+#endif /* TK_LAYOUT_WITH_BASE_CHUNKS */
+
+/*
+ * Flag values for TextDInfo structures:
+ *
+ * DINFO_OUT_OF_DATE: Non-zero means that the DLine structures for
+ * this window are partially or completely out of
+ * date and need to be recomputed.
+ * REDRAW_PENDING: Means that a when-idle handler has been
+ * scheduled to update the display.
+ * REDRAW_BORDERS: Means window border or pad area has
+ * potentially been damaged and must be redrawn.
+ * REPICK_NEEDED: 1 means that the widget has been modified in a
+ * way that could change the current character (a
+ * different character might be under the mouse
+ * cursor now). Need to recompute the current
+ * character before the next redisplay.
+ */
+
+#define DINFO_OUT_OF_DATE 1
+#define REDRAW_PENDING 2
+#define REDRAW_BORDERS 4
+#define REPICK_NEEDED 8
+
+/*
+ * Action values for FreeDLines:
+ *
+ * DLINE_FREE: Free the lines, but no need to unlink them from the
+ * current list of actual display lines.
+ * DLINE_UNLINK: Free and unlink from current display.
+ * DLINE_FREE_TEMP: Free, but don't unlink, and also don't set
+ * 'dLinesInvalidated'.
+ */
+
+#define DLINE_FREE 0
+#define DLINE_UNLINK 1
+#define DLINE_FREE_TEMP 2
+
+/*
+ * The following counters keep statistics about redisplay that can be checked
+ * to see how clever this code is at reducing redisplays.
+ */
+
+static int numRedisplays; /* Number of calls to DisplayText. */
+static int linesRedrawn; /* Number of calls to DisplayDLine. */
+static int numCopies; /* Number of calls to XCopyArea to copy part
+ * of the screen. */
+static int lineHeightsRecalculated;
+ /* Number of line layouts purely for height
+ * calculation purposes.*/
+/*
+ * Forward declarations for functions defined later in this file:
+ */
+
+static void AdjustForTab(TkText *textPtr,
+ TkTextTabArray *tabArrayPtr, int index,
+ TkTextDispChunk *chunkPtr);
+static void CharBboxProc(TkText *textPtr,
+ TkTextDispChunk *chunkPtr, int index, int y,
+ int lineHeight, int baseline, int *xPtr,
+ int *yPtr, int *widthPtr, int *heightPtr);
+static int CharChunkMeasureChars(TkTextDispChunk *chunkPtr,
+ const char *chars, int charsLen,
+ int start, int end, int startX, int maxX,
+ int flags, int *nextX);
+static void CharDisplayProc(TkText *textPtr,
+ TkTextDispChunk *chunkPtr, int x, int y,
+ int height, int baseline, Display *display,
+ Drawable dst, int screenY);
+static int CharMeasureProc(TkTextDispChunk *chunkPtr, int x);
+static void CharUndisplayProc(TkText *textPtr,
+ TkTextDispChunk *chunkPtr);
+#if TK_LAYOUT_WITH_BASE_CHUNKS
+static void FinalizeBaseChunk(TkTextDispChunk *additionalChunkPtr);
+static void FreeBaseChunk(TkTextDispChunk *baseChunkPtr);
+static int IsSameFGStyle(TextStyle *style1, TextStyle *style2);
+static void RemoveFromBaseChunk(TkTextDispChunk *chunkPtr);
+#endif
+/*
+ * Definitions of elided procs. Compiler can't inline these since we use
+ * pointers to these functions. ElideDisplayProc and ElideUndisplayProc are
+ * special-cased for speed, as potentially many elided DLine chunks if large,
+ * tag toggle-filled elided region.
+ */
+static void ElideBboxProc(TkText *textPtr,
+ TkTextDispChunk *chunkPtr, int index, int y,
+ int lineHeight, int baseline, int *xPtr,
+ int *yPtr, int *widthPtr, int *heightPtr);
+static int ElideMeasureProc(TkTextDispChunk *chunkPtr, int x);
+static void DisplayDLine(TkText *textPtr, DLine *dlPtr,
+ DLine *prevPtr, Pixmap pixmap);
+static void DisplayLineBackground(TkText *textPtr, DLine *dlPtr,
+ DLine *prevPtr, Pixmap pixmap);
+static void DisplayText(ClientData clientData);
+static DLine * FindDLine(TkText *textPtr, DLine *dlPtr,
+ const TkTextIndex *indexPtr);
+static void FreeDLines(TkText *textPtr, DLine *firstPtr,
+ DLine *lastPtr, int action);
+static void FreeStyle(TkText *textPtr, TextStyle *stylePtr);
+static TextStyle * GetStyle(TkText *textPtr, const TkTextIndex *indexPtr);
+static void GetXView(Tcl_Interp *interp, TkText *textPtr,
+ int report);
+static void GetYView(Tcl_Interp *interp, TkText *textPtr,
+ int report);
+static int GetYPixelCount(TkText *textPtr, DLine *dlPtr);
+static DLine * LayoutDLine(TkText *textPtr,
+ const TkTextIndex *indexPtr);
+static int MeasureChars(Tk_Font tkfont, const char *source,
+ int maxBytes, int rangeStart, int rangeLength,
+ int startX, int maxX, int flags, int *nextXPtr);
+static void MeasureUp(TkText *textPtr,
+ const TkTextIndex *srcPtr, int distance,
+ TkTextIndex *dstPtr, int *overlap);
+static int NextTabStop(Tk_Font tkfont, int x, int tabOrigin);
+static void UpdateDisplayInfo(TkText *textPtr);
+static void YScrollByLines(TkText *textPtr, int offset);
+static void YScrollByPixels(TkText *textPtr, int offset);
+static int SizeOfTab(TkText *textPtr, int tabStyle,
+ TkTextTabArray *tabArrayPtr, int *indexPtr, int x,
+ int maxX);
+static void TextChanged(TkText *textPtr,
+ const TkTextIndex *index1Ptr,
+ const TkTextIndex *index2Ptr);
+static void TextInvalidateRegion(TkText *textPtr, TkRegion region);
+static void TextRedrawTag(TkText *textPtr,
+ TkTextIndex *index1Ptr, TkTextIndex *index2Ptr,
+ TkTextTag *tagPtr, int withTag);
+static void TextInvalidateLineMetrics(TkText *textPtr,
+ TkTextLine *linePtr, int lineCount, int action);
+static int CalculateDisplayLineHeight(TkText *textPtr,
+ const TkTextIndex *indexPtr, int *byteCountPtr,
+ int *mergedLinePtr);
+static void DlineIndexOfX(TkText *textPtr,
+ DLine *dlPtr, int x, TkTextIndex *indexPtr);
+static int DlineXOfIndex(TkText *textPtr,
+ DLine *dlPtr, int byteIndex);
+static int TextGetScrollInfoObj(Tcl_Interp *interp,
+ TkText *textPtr, int objc,
+ Tcl_Obj *const objv[], double *dblPtr,
+ int *intPtr);
+static void AsyncUpdateLineMetrics(ClientData clientData);
+static void GenerateWidgetViewSyncEvent(TkText *textPtr, Bool InSync);
+static void AsyncUpdateYScrollbar(ClientData clientData);
+static int IsStartOfNotMergedLine(TkText *textPtr,
+ CONST TkTextIndex *indexPtr);
+
+/*
+ * Result values returned by TextGetScrollInfoObj:
+ */
+
+#define TKTEXT_SCROLL_MOVETO 1
+#define TKTEXT_SCROLL_PAGES 2
+#define TKTEXT_SCROLL_UNITS 3
+#define TKTEXT_SCROLL_ERROR 4
+#define TKTEXT_SCROLL_PIXELS 5
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkTextCreateDInfo --
+ *
+ * This function is called when a new text widget is created. Its job is
+ * to set up display-related information for the widget.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * A TextDInfo data structure is allocated and initialized and attached
+ * to textPtr.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TkTextCreateDInfo(
+ TkText *textPtr) /* Overall information for text widget. */
+{
+ register TextDInfo *dInfoPtr;
+ XGCValues gcValues;
+
+ dInfoPtr = ckalloc(sizeof(TextDInfo));
+ Tcl_InitHashTable(&dInfoPtr->styleTable, sizeof(StyleValues)/sizeof(int));
+ dInfoPtr->dLinePtr = NULL;
+ dInfoPtr->copyGC = None;
+ gcValues.graphics_exposures = True;
+ dInfoPtr->scrollGC = Tk_GetGC(textPtr->tkwin, GCGraphicsExposures,
+ &gcValues);
+ dInfoPtr->topOfEof = 0;
+ dInfoPtr->newXPixelOffset = 0;
+ dInfoPtr->curXPixelOffset = 0;
+ dInfoPtr->maxLength = 0;
+ dInfoPtr->xScrollFirst = -1;
+ dInfoPtr->xScrollLast = -1;
+ dInfoPtr->yScrollFirst = -1;
+ dInfoPtr->yScrollLast = -1;
+ dInfoPtr->scanMarkXPixel = 0;
+ dInfoPtr->scanMarkX = 0;
+ dInfoPtr->scanTotalYScroll = 0;
+ dInfoPtr->scanMarkY = 0;
+ dInfoPtr->dLinesInvalidated = 0;
+ dInfoPtr->flags = DINFO_OUT_OF_DATE;
+ dInfoPtr->topPixelOffset = 0;
+ dInfoPtr->newTopPixelOffset = 0;
+ dInfoPtr->currentMetricUpdateLine = -1;
+ dInfoPtr->lastMetricUpdateLine = -1;
+ dInfoPtr->lineMetricUpdateEpoch = 1;
+ dInfoPtr->metricEpoch = -1;
+ dInfoPtr->metricIndex.textPtr = NULL;
+ dInfoPtr->metricIndex.linePtr = NULL;
+ dInfoPtr->lineUpdateTimer = NULL;
+ dInfoPtr->scrollbarTimer = NULL;
+
+ textPtr->dInfoPtr = dInfoPtr;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkTextFreeDInfo --
+ *
+ * This function is called to free up all of the private display
+ * information kept by this file for a text widget.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Lots of resources get freed.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TkTextFreeDInfo(
+ TkText *textPtr) /* Overall information for text widget. */
+{
+ register TextDInfo *dInfoPtr = textPtr->dInfoPtr;
+
+ /*
+ * Be careful to free up styleTable *after* freeing up all the DLines, so
+ * that the hash table is still intact to free up the style-related
+ * information from the lines. Once the lines are all free then styleTable
+ * will be empty.
+ */
+
+ FreeDLines(textPtr, dInfoPtr->dLinePtr, NULL, DLINE_UNLINK);
+ Tcl_DeleteHashTable(&dInfoPtr->styleTable);
+ if (dInfoPtr->copyGC != None) {
+ Tk_FreeGC(textPtr->display, dInfoPtr->copyGC);
+ }
+ Tk_FreeGC(textPtr->display, dInfoPtr->scrollGC);
+ if (dInfoPtr->flags & REDRAW_PENDING) {
+ Tcl_CancelIdleCall(DisplayText, textPtr);
+ }
+ if (dInfoPtr->lineUpdateTimer != NULL) {
+ Tcl_DeleteTimerHandler(dInfoPtr->lineUpdateTimer);
+ textPtr->refCount--;
+ dInfoPtr->lineUpdateTimer = NULL;
+ }
+ if (dInfoPtr->scrollbarTimer != NULL) {
+ Tcl_DeleteTimerHandler(dInfoPtr->scrollbarTimer);
+ textPtr->refCount--;
+ dInfoPtr->scrollbarTimer = NULL;
+ }
+ ckfree(dInfoPtr);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * GetStyle --
+ *
+ * This function creates all the information needed to display text at a
+ * particular location.
+ *
+ * Results:
+ * The return value is a pointer to a TextStyle structure that
+ * corresponds to *sValuePtr.
+ *
+ * Side effects:
+ * A new entry may be created in the style table for the widget.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static TextStyle *
+GetStyle(
+ TkText *textPtr, /* Overall information about text widget. */
+ const TkTextIndex *indexPtr)/* The character in the text for which display
+ * information is wanted. */
+{
+ TkTextTag **tagPtrs;
+ register TkTextTag *tagPtr;
+ StyleValues styleValues;
+ TextStyle *stylePtr;
+ Tcl_HashEntry *hPtr;
+ int numTags, isNew, i;
+ int isSelected;
+ XGCValues gcValues;
+ unsigned long mask;
+ /*
+ * The variables below keep track of the highest-priority specification
+ * that has occurred for each of the various fields of the StyleValues.
+ */
+ int borderPrio, borderWidthPrio, reliefPrio, bgStipplePrio;
+ int fgPrio, fontPrio, fgStipplePrio;
+ int underlinePrio, elidePrio, justifyPrio, offsetPrio;
+ int lMargin1Prio, lMargin2Prio, rMarginPrio;
+ int lMarginColorPrio, rMarginColorPrio;
+ int spacing1Prio, spacing2Prio, spacing3Prio;
+ int overstrikePrio, tabPrio, tabStylePrio, wrapPrio;
+
+ /*
+ * Find out what tags are present for the character, then compute a
+ * StyleValues structure corresponding to those tags (scan through all of
+ * the tags, saving information for the highest-priority tag).
+ */
+
+ tagPtrs = TkBTreeGetTags(indexPtr, textPtr, &numTags);
+ borderPrio = borderWidthPrio = reliefPrio = bgStipplePrio = -1;
+ fgPrio = fontPrio = fgStipplePrio = -1;
+ underlinePrio = elidePrio = justifyPrio = offsetPrio = -1;
+ lMargin1Prio = lMargin2Prio = rMarginPrio = -1;
+ lMarginColorPrio = rMarginColorPrio = -1;
+ spacing1Prio = spacing2Prio = spacing3Prio = -1;
+ overstrikePrio = tabPrio = tabStylePrio = wrapPrio = -1;
+ memset(&styleValues, 0, sizeof(StyleValues));
+ styleValues.relief = TK_RELIEF_FLAT;
+ styleValues.fgColor = textPtr->fgColor;
+ styleValues.underlineColor = textPtr->fgColor;
+ styleValues.overstrikeColor = textPtr->fgColor;
+ styleValues.tkfont = textPtr->tkfont;
+ styleValues.justify = TK_JUSTIFY_LEFT;
+ styleValues.spacing1 = textPtr->spacing1;
+ styleValues.spacing2 = textPtr->spacing2;
+ styleValues.spacing3 = textPtr->spacing3;
+ styleValues.tabArrayPtr = textPtr->tabArrayPtr;
+ styleValues.tabStyle = textPtr->tabStyle;
+ styleValues.wrapMode = textPtr->wrapMode;
+ styleValues.elide = 0;
+ isSelected = 0;
+
+ for (i = 0 ; i < numTags; i++) {
+ if (textPtr->selTagPtr == tagPtrs[i]) {
+ isSelected = 1;
+ break;
+ }
+ }
+
+ for (i = 0 ; i < numTags; i++) {
+ Tk_3DBorder border;
+ XColor *fgColor;
+
+ tagPtr = tagPtrs[i];
+ border = tagPtr->border;
+ fgColor = tagPtr->fgColor;
+
+ /*
+ * If this is the selection tag, and inactiveSelBorder is NULL (the
+ * default on Windows), then we need to skip it if we don't have the
+ * focus.
+ */
+
+ if ((tagPtr == textPtr->selTagPtr) && !(textPtr->flags & GOT_FOCUS)) {
+ if (textPtr->inactiveSelBorder == NULL
+#ifdef MAC_OSX_TK
+ /* Don't show inactive selection in disabled widgets. */
+ || textPtr->state == TK_TEXT_STATE_DISABLED
+#endif
+ ) {
+ continue;
+ }
+ border = textPtr->inactiveSelBorder;
+ }
+
+ if ((tagPtr->selBorder != NULL) && (isSelected)) {
+ border = tagPtr->selBorder;
+ }
+
+ if ((tagPtr->selFgColor != None) && (isSelected)) {
+ fgColor = tagPtr->selFgColor;
+ }
+
+ if ((border != NULL) && (tagPtr->priority > borderPrio)) {
+ styleValues.border = border;
+ borderPrio = tagPtr->priority;
+ }
+ if ((tagPtr->borderWidthPtr != NULL)
+ && (Tcl_GetString(tagPtr->borderWidthPtr)[0] != '\0')
+ && (tagPtr->priority > borderWidthPrio)) {
+ styleValues.borderWidth = tagPtr->borderWidth;
+ borderWidthPrio = tagPtr->priority;
+ }
+ if ((tagPtr->reliefString != NULL)
+ && (tagPtr->priority > reliefPrio)) {
+ if (styleValues.border == NULL) {
+ styleValues.border = textPtr->border;
+ }
+ styleValues.relief = tagPtr->relief;
+ reliefPrio = tagPtr->priority;
+ }
+ if ((tagPtr->bgStipple != None)
+ && (tagPtr->priority > bgStipplePrio)) {
+ styleValues.bgStipple = tagPtr->bgStipple;
+ bgStipplePrio = tagPtr->priority;
+ }
+ if ((fgColor != None) && (tagPtr->priority > fgPrio)) {
+ styleValues.fgColor = fgColor;
+ fgPrio = tagPtr->priority;
+ }
+ if ((tagPtr->tkfont != None) && (tagPtr->priority > fontPrio)) {
+ styleValues.tkfont = tagPtr->tkfont;
+ fontPrio = tagPtr->priority;
+ }
+ if ((tagPtr->fgStipple != None)
+ && (tagPtr->priority > fgStipplePrio)) {
+ styleValues.fgStipple = tagPtr->fgStipple;
+ fgStipplePrio = tagPtr->priority;
+ }
+ if ((tagPtr->justifyString != NULL)
+ && (tagPtr->priority > justifyPrio)) {
+ styleValues.justify = tagPtr->justify;
+ justifyPrio = tagPtr->priority;
+ }
+ if ((tagPtr->lMargin1String != NULL)
+ && (tagPtr->priority > lMargin1Prio)) {
+ styleValues.lMargin1 = tagPtr->lMargin1;
+ lMargin1Prio = tagPtr->priority;
+ }
+ if ((tagPtr->lMargin2String != NULL)
+ && (tagPtr->priority > lMargin2Prio)) {
+ styleValues.lMargin2 = tagPtr->lMargin2;
+ lMargin2Prio = tagPtr->priority;
+ }
+ if ((tagPtr->lMarginColor != NULL)
+ && (tagPtr->priority > lMarginColorPrio)) {
+ styleValues.lMarginColor = tagPtr->lMarginColor;
+ lMarginColorPrio = tagPtr->priority;
+ }
+ if ((tagPtr->offsetString != NULL)
+ && (tagPtr->priority > offsetPrio)) {
+ styleValues.offset = tagPtr->offset;
+ offsetPrio = tagPtr->priority;
+ }
+ if ((tagPtr->overstrikeString != NULL)
+ && (tagPtr->priority > overstrikePrio)) {
+ styleValues.overstrike = tagPtr->overstrike;
+ overstrikePrio = tagPtr->priority;
+ if (tagPtr->overstrikeColor != None) {
+ styleValues.overstrikeColor = tagPtr->overstrikeColor;
+ } else if (fgColor != None) {
+ styleValues.overstrikeColor = fgColor;
+ }
+ }
+ if ((tagPtr->rMarginString != NULL)
+ && (tagPtr->priority > rMarginPrio)) {
+ styleValues.rMargin = tagPtr->rMargin;
+ rMarginPrio = tagPtr->priority;
+ }
+ if ((tagPtr->rMarginColor != NULL)
+ && (tagPtr->priority > rMarginColorPrio)) {
+ styleValues.rMarginColor = tagPtr->rMarginColor;
+ rMarginColorPrio = tagPtr->priority;
+ }
+ if ((tagPtr->spacing1String != NULL)
+ && (tagPtr->priority > spacing1Prio)) {
+ styleValues.spacing1 = tagPtr->spacing1;
+ spacing1Prio = tagPtr->priority;
+ }
+ if ((tagPtr->spacing2String != NULL)
+ && (tagPtr->priority > spacing2Prio)) {
+ styleValues.spacing2 = tagPtr->spacing2;
+ spacing2Prio = tagPtr->priority;
+ }
+ if ((tagPtr->spacing3String != NULL)
+ && (tagPtr->priority > spacing3Prio)) {
+ styleValues.spacing3 = tagPtr->spacing3;
+ spacing3Prio = tagPtr->priority;
+ }
+ if ((tagPtr->tabStringPtr != NULL)
+ && (tagPtr->priority > tabPrio)) {
+ styleValues.tabArrayPtr = tagPtr->tabArrayPtr;
+ tabPrio = tagPtr->priority;
+ }
+ if ((tagPtr->tabStyle != TK_TEXT_TABSTYLE_NONE)
+ && (tagPtr->priority > tabStylePrio)) {
+ styleValues.tabStyle = tagPtr->tabStyle;
+ tabStylePrio = tagPtr->priority;
+ }
+ if ((tagPtr->underlineString != NULL)
+ && (tagPtr->priority > underlinePrio)) {
+ styleValues.underline = tagPtr->underline;
+ underlinePrio = tagPtr->priority;
+ if (tagPtr->underlineColor != None) {
+ styleValues.underlineColor = tagPtr->underlineColor;
+ } else if (fgColor != None) {
+ styleValues.underlineColor = fgColor;
+ }
+ }
+ if ((tagPtr->elideString != NULL)
+ && (tagPtr->priority > elidePrio)) {
+ styleValues.elide = tagPtr->elide;
+ elidePrio = tagPtr->priority;
+ }
+ if ((tagPtr->wrapMode != TEXT_WRAPMODE_NULL)
+ && (tagPtr->priority > wrapPrio)) {
+ styleValues.wrapMode = tagPtr->wrapMode;
+ wrapPrio = tagPtr->priority;
+ }
+ }
+ if (tagPtrs != NULL) {
+ ckfree(tagPtrs);
+ }
+
+ /*
+ * Use an existing style if there's one around that matches.
+ */
+
+ hPtr = Tcl_CreateHashEntry(&textPtr->dInfoPtr->styleTable,
+ (char *) &styleValues, &isNew);
+ if (!isNew) {
+ stylePtr = Tcl_GetHashValue(hPtr);
+ stylePtr->refCount++;
+ return stylePtr;
+ }
+
+ /*
+ * No existing style matched. Make a new one.
+ */
+
+ stylePtr = ckalloc(sizeof(TextStyle));
+ stylePtr->refCount = 1;
+ if (styleValues.border != NULL) {
+ gcValues.foreground = Tk_3DBorderColor(styleValues.border)->pixel;
+ mask = GCForeground;
+ if (styleValues.bgStipple != None) {
+ gcValues.stipple = styleValues.bgStipple;
+ gcValues.fill_style = FillStippled;
+ mask |= GCStipple|GCFillStyle;
+ }
+ stylePtr->bgGC = Tk_GetGC(textPtr->tkwin, mask, &gcValues);
+ } else {
+ stylePtr->bgGC = None;
+ }
+ mask = GCFont;
+ gcValues.font = Tk_FontId(styleValues.tkfont);
+ mask |= GCForeground;
+ gcValues.foreground = styleValues.fgColor->pixel;
+ if (styleValues.fgStipple != None) {
+ gcValues.stipple = styleValues.fgStipple;
+ gcValues.fill_style = FillStippled;
+ mask |= GCStipple|GCFillStyle;
+ }
+ stylePtr->fgGC = Tk_GetGC(textPtr->tkwin, mask, &gcValues);
+ mask = GCForeground;
+ gcValues.foreground = styleValues.underlineColor->pixel;
+ stylePtr->ulGC = Tk_GetGC(textPtr->tkwin, mask, &gcValues);
+ gcValues.foreground = styleValues.overstrikeColor->pixel;
+ stylePtr->ovGC = Tk_GetGC(textPtr->tkwin, mask, &gcValues);
+ stylePtr->sValuePtr = (StyleValues *)
+ Tcl_GetHashKey(&textPtr->dInfoPtr->styleTable, hPtr);
+ stylePtr->hPtr = hPtr;
+ Tcl_SetHashValue(hPtr, stylePtr);
+ return stylePtr;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * FreeStyle --
+ *
+ * This function is called when a TextStyle structure is no longer
+ * needed. It decrements the reference count and frees up the space for
+ * the style structure if the reference count is 0.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The storage and other resources associated with the style are freed up
+ * if no-one's still using it.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+FreeStyle(
+ TkText *textPtr, /* Information about overall widget. */
+ register TextStyle *stylePtr)
+ /* Information about style to free. */
+{
+ stylePtr->refCount--;
+ if (stylePtr->refCount == 0) {
+ if (stylePtr->bgGC != None) {
+ Tk_FreeGC(textPtr->display, stylePtr->bgGC);
+ }
+ if (stylePtr->fgGC != None) {
+ Tk_FreeGC(textPtr->display, stylePtr->fgGC);
+ }
+ if (stylePtr->ulGC != None) {
+ Tk_FreeGC(textPtr->display, stylePtr->ulGC);
+ }
+ if (stylePtr->ovGC != None) {
+ Tk_FreeGC(textPtr->display, stylePtr->ovGC);
+ }
+ Tcl_DeleteHashEntry(stylePtr->hPtr);
+ ckfree(stylePtr);
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * LayoutDLine --
+ *
+ * This function generates a single DLine structure for a display line
+ * whose leftmost character is given by indexPtr.
+ *
+ * Results:
+ * The return value is a pointer to a DLine structure describing the
+ * display line. All fields are filled in and correct except for y and
+ * nextPtr.
+ *
+ * Side effects:
+ * Storage is allocated for the new DLine.
+ *
+ * See the comments in 'GetYView' for some thoughts on what the side-
+ * effects of this call (or its callers) should be; the synchronisation
+ * of TkTextLine->pixelHeight with the sum of the results of this
+ * function operating on all display lines within each logical line.
+ * Ideally the code should be refactored to ensure the cached pixel
+ * height is never behind what is known when this function is called
+ * elsewhere.
+ *
+ * Unfortunately, this function is currently called from many different
+ * places, not just to layout a display line for actual display, but also
+ * simply to calculate some metric or other of one or more display lines
+ * (typically the height). It would be a good idea to do some profiling
+ * of typical text widget usage and the way in which this is called and
+ * see if some optimization could or should be done.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static DLine *
+LayoutDLine(
+ TkText *textPtr, /* Overall information about text widget. */
+ const TkTextIndex *indexPtr)/* Beginning of display line. May not
+ * necessarily point to a character
+ * segment. */
+{
+ register DLine *dlPtr; /* New display line. */
+ TkTextSegment *segPtr; /* Current segment in text. */
+ TkTextDispChunk *lastChunkPtr;
+ /* Last chunk allocated so far for line. */
+ TkTextDispChunk *chunkPtr; /* Current chunk. */
+ TkTextIndex curIndex;
+ TkTextDispChunk *breakChunkPtr;
+ /* Chunk containing best word break point, if
+ * any. */
+ TkTextIndex breakIndex; /* Index of first character in
+ * breakChunkPtr. */
+ int breakByteOffset; /* Byte offset of character within
+ * breakChunkPtr just to right of best break
+ * point. */
+ int noCharsYet; /* Non-zero means that no characters have been
+ * placed on the line yet. */
+ int paragraphStart; /* Non-zero means that we are on the first
+ * line of a paragraph (used to choose between
+ * lmargin1, lmargin2). */
+ int justify; /* How to justify line: taken from style for
+ * the first character in line. */
+ int jIndent; /* Additional indentation (beyond margins) due
+ * to justification. */
+ int rMargin; /* Right margin width for line. */
+ TkWrapMode wrapMode; /* Wrap mode to use for this line. */
+ int x = 0, maxX = 0; /* Initializations needed only to stop
+ * compiler warnings. */
+ int wholeLine; /* Non-zero means this display line runs to
+ * the end of the text line. */
+ int tabIndex; /* Index of the current tab stop. */
+ int gotTab; /* Non-zero means the current chunk contains a
+ * tab. */
+ TkTextDispChunk *tabChunkPtr;
+ /* Pointer to the chunk containing the
+ * previous tab stop. */
+ int maxBytes; /* Maximum number of bytes to include in this
+ * chunk. */
+ TkTextTabArray *tabArrayPtr;/* Tab stops for line; taken from style for
+ * the first character on line. */
+ int tabStyle; /* One of TABULAR or WORDPROCESSOR. */
+ int tabSize; /* Number of pixels consumed by current tab
+ * stop. */
+ TkTextDispChunk *lastCharChunkPtr;
+ /* Pointer to last chunk in display lines with
+ * numBytes > 0. Used to drop 0-sized chunks
+ * from the end of the line. */
+ int byteOffset, ascent, descent, code, elide, elidesize;
+ StyleValues *sValuePtr;
+ TkTextElideInfo info; /* Keep track of elide state. */
+
+ /*
+ * Create and initialize a new DLine structure.
+ */
+
+ dlPtr = ckalloc(sizeof(DLine));
+ dlPtr->index = *indexPtr;
+ dlPtr->byteCount = 0;
+ dlPtr->y = 0;
+ dlPtr->oldY = 0; /* Only set to avoid compiler warnings. */
+ dlPtr->height = 0;
+ dlPtr->baseline = 0;
+ dlPtr->chunkPtr = NULL;
+ dlPtr->nextPtr = NULL;
+ dlPtr->flags = NEW_LAYOUT | OLD_Y_INVALID;
+ dlPtr->logicalLinesMerged = 0;
+ dlPtr->lMarginColor = NULL;
+ dlPtr->lMarginWidth = 0;
+ dlPtr->rMarginColor = NULL;
+ dlPtr->rMarginWidth = 0;
+
+ /*
+ * This is not necessarily totally correct, where we have merged logical
+ * lines. Fixing this would require a quite significant overhaul, though,
+ * so currently we make do with this.
+ */
+
+ paragraphStart = (indexPtr->byteIndex == 0);
+
+ /*
+ * Special case entirely elide line as there may be 1000s or more.
+ */
+
+ elide = TkTextIsElided(textPtr, indexPtr, &info);
+ if (elide && indexPtr->byteIndex == 0) {
+ maxBytes = 0;
+ for (segPtr = info.segPtr; segPtr != NULL; segPtr = segPtr->nextPtr) {
+ if (segPtr->size > 0) {
+ if (elide == 0) {
+ /*
+ * We toggled a tag and the elide state changed to
+ * visible, and we have something of non-zero size.
+ * Therefore we must bail out.
+ */
+
+ break;
+ }
+ maxBytes += segPtr->size;
+
+ /*
+ * Reset tag elide priority, since we're on a new character.
+ */
+
+ } else if ((segPtr->typePtr == &tkTextToggleOffType)
+ || (segPtr->typePtr == &tkTextToggleOnType)) {
+ TkTextTag *tagPtr = segPtr->body.toggle.tagPtr;
+
+ /*
+ * The elide state only changes if this tag is either the
+ * current highest priority tag (and is therefore being
+ * toggled off), or it's a new tag with higher priority.
+ */
+
+ if (tagPtr->elideString != NULL) {
+ info.tagCnts[tagPtr->priority]++;
+ if (info.tagCnts[tagPtr->priority] & 1) {
+ info.tagPtrs[tagPtr->priority] = tagPtr;
+ }
+ if (tagPtr->priority >= info.elidePriority) {
+ if (segPtr->typePtr == &tkTextToggleOffType) {
+ /*
+ * If it is being toggled off, and it has an elide
+ * string, it must actually be the current highest
+ * priority tag, so this check is redundant:
+ */
+
+ if (tagPtr->priority != info.elidePriority) {
+ Tcl_Panic("Bad tag priority being toggled off");
+ }
+
+ /*
+ * Find previous elide tag, if any (if not then
+ * elide will be zero, of course).
+ */
+
+ elide = 0;
+ while (--info.elidePriority > 0) {
+ if (info.tagCnts[info.elidePriority] & 1) {
+ elide = info.tagPtrs[info.elidePriority]
+ ->elide;
+ break;
+ }
+ }
+ } else {
+ elide = tagPtr->elide;
+ info.elidePriority = tagPtr->priority;
+ }
+ }
+ }
+ }
+ }
+
+ if (elide) {
+ dlPtr->byteCount = maxBytes;
+ dlPtr->spaceAbove = dlPtr->spaceBelow = dlPtr->length = 0;
+ if (dlPtr->index.byteIndex == 0) {
+ /*
+ * Elided state goes from beginning to end of an entire
+ * logical line. This means we can update the line's pixel
+ * height, and bring its pixel calculation up to date.
+ */
+
+ TkBTreeLinePixelEpoch(textPtr, dlPtr->index.linePtr)
+ = textPtr->dInfoPtr->lineMetricUpdateEpoch;
+
+ if (TkBTreeLinePixelCount(textPtr,dlPtr->index.linePtr) != 0) {
+ TkBTreeAdjustPixelHeight(textPtr,
+ dlPtr->index.linePtr, 0, 0);
+ }
+ }
+ TkTextFreeElideInfo(&info);
+ return dlPtr;
+ }
+ }
+ TkTextFreeElideInfo(&info);
+
+ /*
+ * Each iteration of the loop below creates one TkTextDispChunk for the
+ * new display line. The line will always have at least one chunk (for the
+ * newline character at the end, if there's nothing else available).
+ */
+
+ curIndex = *indexPtr;
+ lastChunkPtr = NULL;
+ chunkPtr = NULL;
+ noCharsYet = 1;
+ elide = 0;
+ breakChunkPtr = NULL;
+ breakByteOffset = 0;
+ justify = TK_JUSTIFY_LEFT;
+ tabIndex = -1;
+ tabChunkPtr = NULL;
+ tabArrayPtr = NULL;
+ tabStyle = TK_TEXT_TABSTYLE_TABULAR;
+ rMargin = 0;
+ wrapMode = TEXT_WRAPMODE_CHAR;
+ tabSize = 0;
+ lastCharChunkPtr = NULL;
+
+ /*
+ * Find the first segment to consider for the line. Can't call
+ * TkTextIndexToSeg for this because it won't return a segment with zero
+ * size (such as the insertion cursor's mark).
+ */
+
+ connectNextLogicalLine:
+ byteOffset = curIndex.byteIndex;
+ segPtr = curIndex.linePtr->segPtr;
+ while ((byteOffset > 0) && (byteOffset >= segPtr->size)) {
+ byteOffset -= segPtr->size;
+ segPtr = segPtr->nextPtr;
+
+ if (segPtr == NULL) {
+ /*
+ * Two logical lines merged into one display line through eliding
+ * of a newline.
+ */
+
+ TkTextLine *linePtr = TkBTreeNextLine(NULL, curIndex.linePtr);
+ if (linePtr == NULL) {
+ break;
+ }
+
+ dlPtr->logicalLinesMerged++;
+ curIndex.byteIndex = 0;
+ curIndex.linePtr = linePtr;
+ segPtr = curIndex.linePtr->segPtr;
+ }
+ }
+
+ while (segPtr != NULL) {
+ /*
+ * Every logical 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.
+ *
+ * This also means that each logical line which is entirely elided
+ * still gets laid out into a DLine, but with zero height. This isn't
+ * particularly a problem, but it does seem somewhat unnecessary. We
+ * may wish to redesign the code to remove these zero height DLines in
+ * the future.
+ */
+
+ if (elide && (lastChunkPtr != NULL)
+ && (lastChunkPtr->displayProc == NULL /*ElideDisplayProc*/)) {
+ elidesize = segPtr->size - byteOffset;
+ if (elidesize > 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) {
+ /*
+ * Two logical lines merged into one display line through
+ * eliding of a newline.
+ */
+
+ TkTextLine *linePtr = TkBTreeNextLine(NULL, curIndex.linePtr);
+
+ if (linePtr != NULL) {
+ dlPtr->logicalLinesMerged++;
+ curIndex.byteIndex = 0;
+ curIndex.linePtr = linePtr;
+ goto connectNextLogicalLine;
+ }
+ }
+
+ /*
+ * Code no longer needed, now that we allow logical lines to merge
+ * into a single display line.
+ *
+ if (segPtr == NULL && chunkPtr != NULL) {
+ ckfree(chunkPtr);
+ chunkPtr = NULL;
+ }
+ */
+
+ continue;
+ }
+
+ if (segPtr->typePtr->layoutProc == NULL) {
+ segPtr = segPtr->nextPtr;
+ byteOffset = 0;
+ continue;
+ }
+ if (chunkPtr == NULL) {
+ chunkPtr = ckalloc(sizeof(TkTextDispChunk));
+ chunkPtr->nextPtr = NULL;
+ chunkPtr->clientData = NULL;
+ }
+ chunkPtr->stylePtr = GetStyle(textPtr, &curIndex);
+ elide = chunkPtr->stylePtr->sValuePtr->elide;
+
+ /*
+ * Save style information such as justification and indentation, up
+ * until the first character is encountered, then retain that
+ * information for the rest of the line.
+ */
+
+ if (!elide && noCharsYet) {
+ tabArrayPtr = chunkPtr->stylePtr->sValuePtr->tabArrayPtr;
+ tabStyle = chunkPtr->stylePtr->sValuePtr->tabStyle;
+ justify = chunkPtr->stylePtr->sValuePtr->justify;
+ rMargin = chunkPtr->stylePtr->sValuePtr->rMargin;
+ wrapMode = chunkPtr->stylePtr->sValuePtr->wrapMode;
+
+ /*
+ * See above - this test may not be entirely correct where we have
+ * partially elided lines (and therefore merged logical lines).
+ * In such a case a byteIndex of zero doesn't necessarily mean the
+ * beginning of a logical line.
+ */
+
+ if (paragraphStart) {
+ /*
+ * Beginning of logical line.
+ */
+
+ x = chunkPtr->stylePtr->sValuePtr->lMargin1;
+ } else {
+ /*
+ * Beginning of display line.
+ */
+
+ x = chunkPtr->stylePtr->sValuePtr->lMargin2;
+ }
+ dlPtr->lMarginWidth = x;
+ if (wrapMode == TEXT_WRAPMODE_NONE) {
+ maxX = -1;
+ } else {
+ maxX = textPtr->dInfoPtr->maxX - textPtr->dInfoPtr->x
+ - rMargin;
+ if (maxX < x) {
+ maxX = x;
+ }
+ }
+ }
+
+ gotTab = 0;
+ maxBytes = segPtr->size - byteOffset;
+ if (segPtr->typePtr == &tkTextCharType) {
+
+ /*
+ * See if there is a tab in the current chunk; if so, only layout
+ * characters up to (and including) the tab.
+ */
+
+ if (!elide && justify == TK_JUSTIFY_LEFT) {
+ char *p;
+
+ for (p = segPtr->body.chars + byteOffset; *p != 0; p++) {
+ if (*p == '\t') {
+ maxBytes = (p + 1 - segPtr->body.chars) - byteOffset;
+ gotTab = 1;
+ break;
+ }
+ }
+ }
+
+#if TK_LAYOUT_WITH_BASE_CHUNKS
+ if (baseCharChunkPtr != NULL) {
+ int expectedX =
+ ((BaseCharInfo *) baseCharChunkPtr->clientData)->width
+ + baseCharChunkPtr->x;
+
+ if ((expectedX != x) || !IsSameFGStyle(
+ baseCharChunkPtr->stylePtr, chunkPtr->stylePtr)) {
+ FinalizeBaseChunk(NULL);
+ }
+ }
+#endif /* TK_LAYOUT_WITH_BASE_CHUNKS */
+ }
+ 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 = NULL;
+ chunkPtr->undisplayProc = NULL;
+ chunkPtr->measureProc = ElideMeasureProc;
+ chunkPtr->bboxProc = ElideBboxProc;
+
+ code = 1;
+ } else {
+ code = segPtr->typePtr->layoutProc(textPtr, &curIndex, segPtr,
+ byteOffset, maxX-tabSize, maxBytes, noCharsYet, wrapMode,
+ chunkPtr);
+ }
+ if (code <= 0) {
+ FreeStyle(textPtr, chunkPtr->stylePtr);
+ if (code < 0) {
+ /*
+ * This segment doesn't wish to display itself (e.g. most
+ * marks).
+ */
+
+ segPtr = segPtr->nextPtr;
+ byteOffset = 0;
+ continue;
+ }
+
+ /*
+ * No characters from this segment fit in the window: this means
+ * we're at the end of the display line.
+ */
+
+ if (chunkPtr != NULL) {
+ ckfree(chunkPtr);
+ }
+ break;
+ }
+
+ /*
+ * We currently say we have some characters (and therefore something
+ * from which to examine tag values for the first character of the
+ * line) even if those characters are actually elided. This behaviour
+ * is not well documented, and it might be more consistent to
+ * completely ignore such elided characters and their tags. To do so
+ * change this to:
+ *
+ * if (!elide && chunkPtr->numBytes > 0).
+ */
+
+ if (!elide && chunkPtr->numBytes > 0) {
+ noCharsYet = 0;
+ lastCharChunkPtr = chunkPtr;
+ }
+ if (lastChunkPtr == NULL) {
+ dlPtr->chunkPtr = chunkPtr;
+ } else {
+ lastChunkPtr->nextPtr = chunkPtr;
+ }
+ lastChunkPtr = chunkPtr;
+ x += chunkPtr->width;
+ if (chunkPtr->breakIndex > 0) {
+ breakByteOffset = chunkPtr->breakIndex;
+ breakIndex = curIndex;
+ breakChunkPtr = chunkPtr;
+ }
+ if (chunkPtr->numBytes != maxBytes) {
+ break;
+ }
+
+ /*
+ * If we're at a new tab, adjust the layout for all the chunks
+ * pertaining to the previous tab. Also adjust the amount of space
+ * left in the line to account for space that will be eaten up by the
+ * tab.
+ */
+
+ if (gotTab) {
+ if (tabIndex >= 0) {
+ AdjustForTab(textPtr, tabArrayPtr, tabIndex, tabChunkPtr);
+ x = chunkPtr->x + chunkPtr->width;
+ }
+ tabChunkPtr = chunkPtr;
+ tabSize = SizeOfTab(textPtr, tabStyle, tabArrayPtr, &tabIndex, x,
+ maxX);
+ if ((maxX >= 0) && (tabSize >= maxX - x)) {
+ break;
+ }
+ }
+ curIndex.byteIndex += chunkPtr->numBytes;
+ byteOffset += chunkPtr->numBytes;
+ if (byteOffset >= segPtr->size) {
+ byteOffset = 0;
+ segPtr = segPtr->nextPtr;
+ if (elide && segPtr == NULL) {
+ /*
+ * An elided section started on this line, and carries on
+ * until the newline. Hence the newline is actually elided,
+ * and we want to merge the display of the next logical line
+ * with this one.
+ */
+
+ TkTextLine *linePtr = TkBTreeNextLine(NULL, curIndex.linePtr);
+
+ if (linePtr != NULL) {
+ dlPtr->logicalLinesMerged++;
+ curIndex.byteIndex = 0;
+ curIndex.linePtr = linePtr;
+ chunkPtr = NULL;
+ goto connectNextLogicalLine;
+ }
+ }
+ }
+
+ chunkPtr = NULL;
+ }
+#if TK_LAYOUT_WITH_BASE_CHUNKS
+ FinalizeBaseChunk(NULL);
+#endif /* TK_LAYOUT_WITH_BASE_CHUNKS */
+ if (noCharsYet) {
+ dlPtr->spaceAbove = 0;
+ dlPtr->spaceBelow = 0;
+ dlPtr->length = 0;
+
+ /*
+ * We used to Tcl_Panic here, saying that LayoutDLine couldn't place
+ * any characters on a line, but I believe a more appropriate response
+ * is to return a DLine with zero height. With elided lines, tag
+ * transitions and asynchronous line height calculations, it is hard
+ * to avoid this situation ever arising with the current code design.
+ */
+
+ return dlPtr;
+ }
+ wholeLine = (segPtr == NULL);
+
+ /*
+ * We're at the end of the display line. Throw away everything after the
+ * most recent word break, if there is one; this may potentially require
+ * the last chunk to be layed out again.
+ */
+
+ if (breakChunkPtr == NULL) {
+ /*
+ * This code makes sure that we don't accidentally display chunks with
+ * no characters at the end of the line (such as the insertion
+ * cursor). These chunks belong on the next line. So, throw away
+ * everything after the last chunk that has characters in it.
+ */
+
+ breakChunkPtr = lastCharChunkPtr;
+ breakByteOffset = breakChunkPtr->numBytes;
+ }
+ if ((breakChunkPtr != NULL) && ((lastChunkPtr != breakChunkPtr)
+ || (breakByteOffset != lastChunkPtr->numBytes))) {
+ while (1) {
+ chunkPtr = breakChunkPtr->nextPtr;
+ if (chunkPtr == NULL) {
+ break;
+ }
+ FreeStyle(textPtr, chunkPtr->stylePtr);
+ breakChunkPtr->nextPtr = chunkPtr->nextPtr;
+ if (chunkPtr->undisplayProc != NULL) {
+ chunkPtr->undisplayProc(textPtr, chunkPtr);
+ }
+ ckfree(chunkPtr);
+ }
+ if (breakByteOffset != breakChunkPtr->numBytes) {
+ if (breakChunkPtr->undisplayProc != NULL) {
+ breakChunkPtr->undisplayProc(textPtr, breakChunkPtr);
+ }
+ segPtr = TkTextIndexToSeg(&breakIndex, &byteOffset);
+ segPtr->typePtr->layoutProc(textPtr, &breakIndex, segPtr,
+ byteOffset, maxX, breakByteOffset, 0, wrapMode,
+ breakChunkPtr);
+#if TK_LAYOUT_WITH_BASE_CHUNKS
+ FinalizeBaseChunk(NULL);
+#endif /* TK_LAYOUT_WITH_BASE_CHUNKS */
+ }
+ lastChunkPtr = breakChunkPtr;
+ wholeLine = 0;
+ }
+
+ /*
+ * Make tab adjustments for the last tab stop, if there is one.
+ */
+
+ if ((tabIndex >= 0) && (tabChunkPtr != NULL)) {
+ AdjustForTab(textPtr, tabArrayPtr, tabIndex, tabChunkPtr);
+ }
+
+ /*
+ * Make one more pass over the line to recompute various things like its
+ * height, length, and total number of bytes. Also modify the x-locations
+ * of chunks to reflect justification. If we're not wrapping, I'm not sure
+ * what is the best way to handle right and center justification: should
+ * the total length, for purposes of justification, be (a) the window
+ * width, (b) the length of the longest line in the window, or (c) the
+ * length of the longest line in the text? (c) isn't available, (b) seems
+ * weird, since it can change with vertical scrolling, so (a) is what is
+ * implemented below.
+ */
+
+ if (wrapMode == TEXT_WRAPMODE_NONE) {
+ maxX = textPtr->dInfoPtr->maxX - textPtr->dInfoPtr->x - rMargin;
+ }
+ dlPtr->length = lastChunkPtr->x + lastChunkPtr->width;
+ if (justify == TK_JUSTIFY_LEFT) {
+ jIndent = 0;
+ } else if (justify == TK_JUSTIFY_RIGHT) {
+ jIndent = maxX - dlPtr->length;
+ } else {
+ jIndent = (maxX - dlPtr->length)/2;
+ }
+ ascent = descent = 0;
+ for (chunkPtr = dlPtr->chunkPtr; chunkPtr != NULL;
+ chunkPtr = chunkPtr->nextPtr) {
+ chunkPtr->x += jIndent;
+ dlPtr->byteCount += chunkPtr->numBytes;
+ if (chunkPtr->minAscent > ascent) {
+ ascent = chunkPtr->minAscent;
+ }
+ if (chunkPtr->minDescent > descent) {
+ descent = chunkPtr->minDescent;
+ }
+ if (chunkPtr->minHeight > dlPtr->height) {
+ dlPtr->height = chunkPtr->minHeight;
+ }
+ sValuePtr = chunkPtr->stylePtr->sValuePtr;
+ if ((sValuePtr->borderWidth > 0)
+ && (sValuePtr->relief != TK_RELIEF_FLAT)) {
+ dlPtr->flags |= HAS_3D_BORDER;
+ }
+ }
+ if (dlPtr->height < (ascent + descent)) {
+ dlPtr->height = ascent + descent;
+ dlPtr->baseline = ascent;
+ } else {
+ dlPtr->baseline = ascent + (dlPtr->height - ascent - descent)/2;
+ }
+ sValuePtr = dlPtr->chunkPtr->stylePtr->sValuePtr;
+ if (dlPtr->index.byteIndex == 0) {
+ dlPtr->spaceAbove = sValuePtr->spacing1;
+ } else {
+ dlPtr->spaceAbove = sValuePtr->spacing2 - sValuePtr->spacing2/2;
+ }
+ if (wholeLine) {
+ dlPtr->spaceBelow = sValuePtr->spacing3;
+ } else {
+ dlPtr->spaceBelow = sValuePtr->spacing2/2;
+ }
+ dlPtr->height += dlPtr->spaceAbove + dlPtr->spaceBelow;
+ dlPtr->baseline += dlPtr->spaceAbove;
+ dlPtr->lMarginColor = sValuePtr->lMarginColor;
+ dlPtr->rMarginColor = sValuePtr->rMarginColor;
+ if (wrapMode != TEXT_WRAPMODE_NONE) {
+ dlPtr->rMarginWidth = rMargin;
+ }
+
+ /*
+ * Recompute line length: may have changed because of justification.
+ */
+
+ dlPtr->length = lastChunkPtr->x + lastChunkPtr->width;
+
+ return dlPtr;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * UpdateDisplayInfo --
+ *
+ * This function is invoked to recompute some or all of the DLine
+ * structures for a text widget. At the time it is called the DLine
+ * structures still left in the widget are guaranteed to be correct
+ * except that (a) the y-coordinates aren't necessarily correct, (b)
+ * there may be missing structures (the DLine structures get removed as
+ * soon as they are potentially out-of-date), and (c) DLine structures
+ * that don't start at the beginning of a line may be incorrect if
+ * previous information in the same line changed size in a way that moved
+ * a line boundary (DLines for any info that changed will have been
+ * deleted, but not DLines for unchanged info in the same text line).
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Upon return, the DLine information for textPtr correctly reflects the
+ * positions where characters will be displayed. However, this function
+ * doesn't actually bring the display up-to-date.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+UpdateDisplayInfo(
+ TkText *textPtr) /* Text widget to update. */
+{
+ register TextDInfo *dInfoPtr = textPtr->dInfoPtr;
+ register DLine *dlPtr, *prevPtr;
+ TkTextIndex index;
+ TkTextLine *lastLinePtr;
+ int y, maxY, xPixelOffset, maxOffset, lineHeight;
+
+ if (!(dInfoPtr->flags & DINFO_OUT_OF_DATE)) {
+ return;
+ }
+ dInfoPtr->flags &= ~DINFO_OUT_OF_DATE;
+
+ /*
+ * Delete any DLines that are now above the top of the window.
+ */
+
+ index = textPtr->topIndex;
+ dlPtr = FindDLine(textPtr, dInfoPtr->dLinePtr, &index);
+ if ((dlPtr != NULL) && (dlPtr != dInfoPtr->dLinePtr)) {
+ FreeDLines(textPtr, dInfoPtr->dLinePtr, dlPtr, DLINE_UNLINK);
+ }
+ if (index.byteIndex == 0) {
+ lineHeight = 0;
+ } else {
+ lineHeight = -1;
+ }
+
+ /*
+ * Scan through the contents of the window from top to bottom, recomputing
+ * information for lines that are missing.
+ */
+
+ lastLinePtr = TkBTreeFindLine(textPtr->sharedTextPtr->tree, textPtr,
+ TkBTreeNumLines(textPtr->sharedTextPtr->tree, textPtr));
+ dlPtr = dInfoPtr->dLinePtr;
+ prevPtr = NULL;
+ y = dInfoPtr->y - dInfoPtr->newTopPixelOffset;
+ maxY = dInfoPtr->maxY;
+ while (1) {
+ register DLine *newPtr;
+
+ if (index.linePtr == lastLinePtr) {
+ break;
+ }
+
+ /*
+ * There are three possibilities right now:
+ * (a) the next DLine (dlPtr) corresponds exactly to the next
+ * information we want to display: just use it as-is.
+ * (b) the next DLine corresponds to a different line, or to a segment
+ * that will be coming later in the same line: leave this DLine
+ * alone in the hopes that we'll be able to use it later, then
+ * create a new DLine in front of it.
+ * (c) the next DLine corresponds to a segment in the line we want,
+ * but it's a segment that has already been processed or will
+ * never be processed. Delete the DLine and try again.
+ *
+ * One other twist on all this. It's possible for 3D borders to
+ * interact between lines (see DisplayLineBackground) so if a line is
+ * relayed out and has styles with 3D borders, its neighbors have to
+ * be redrawn if they have 3D borders too, since the interactions
+ * could have changed (the neighbors don't have to be relayed out,
+ * just redrawn).
+ */
+
+ if ((dlPtr == NULL) || (dlPtr->index.linePtr != index.linePtr)) {
+ /*
+ * Case (b) -- must make new DLine.
+ */
+
+ makeNewDLine:
+ if (tkTextDebug) {
+ char string[TK_POS_CHARS];
+
+ /*
+ * Debugging is enabled, so keep a log of all the lines that
+ * were re-layed out. The test suite uses this information.
+ */
+
+ TkTextPrintIndex(textPtr, &index, string);
+ LOG("tk_textRelayout", string);
+ }
+ newPtr = LayoutDLine(textPtr, &index);
+ if (prevPtr == NULL) {
+ dInfoPtr->dLinePtr = newPtr;
+ } else {
+ prevPtr->nextPtr = newPtr;
+ if (prevPtr->flags & HAS_3D_BORDER) {
+ prevPtr->flags |= OLD_Y_INVALID;
+ }
+ }
+ newPtr->nextPtr = dlPtr;
+ dlPtr = newPtr;
+ } else {
+ /*
+ * DlPtr refers to the line we want. Next check the index within
+ * the line.
+ */
+
+ if (index.byteIndex == dlPtr->index.byteIndex) {
+ /*
+ * Case (a) - can use existing display line as-is.
+ */
+
+ if ((dlPtr->flags & HAS_3D_BORDER) && (prevPtr != NULL)
+ && (prevPtr->flags & (NEW_LAYOUT))) {
+ dlPtr->flags |= OLD_Y_INVALID;
+ }
+ goto lineOK;
+ }
+ if (index.byteIndex < dlPtr->index.byteIndex) {
+ goto makeNewDLine;
+ }
+
+ /*
+ * Case (c) - dlPtr is useless. Discard it and start again with
+ * the next display line.
+ */
+
+ newPtr = dlPtr->nextPtr;
+ FreeDLines(textPtr, dlPtr, newPtr, DLINE_FREE);
+ dlPtr = newPtr;
+ if (prevPtr != NULL) {
+ prevPtr->nextPtr = newPtr;
+ } else {
+ dInfoPtr->dLinePtr = newPtr;
+ }
+ continue;
+ }
+
+ /*
+ * Advance to the start of the next line.
+ */
+
+ lineOK:
+ dlPtr->y = y;
+ y += dlPtr->height;
+ if (lineHeight != -1) {
+ lineHeight += dlPtr->height;
+ }
+ TkTextIndexForwBytes(textPtr, &index, dlPtr->byteCount, &index);
+ prevPtr = dlPtr;
+ dlPtr = dlPtr->nextPtr;
+
+ /*
+ * If we switched text lines, delete any DLines left for the old text
+ * line.
+ */
+
+ if (index.linePtr != prevPtr->index.linePtr) {
+ register DLine *nextPtr;
+
+ nextPtr = dlPtr;
+ while ((nextPtr != NULL)
+ && (nextPtr->index.linePtr == prevPtr->index.linePtr)) {
+ nextPtr = nextPtr->nextPtr;
+ }
+ if (nextPtr != dlPtr) {
+ FreeDLines(textPtr, dlPtr, nextPtr, DLINE_FREE);
+ prevPtr->nextPtr = nextPtr;
+ dlPtr = nextPtr;
+ }
+
+ if ((lineHeight != -1) && (TkBTreeLinePixelCount(textPtr,
+ prevPtr->index.linePtr) != lineHeight)) {
+ /*
+ * The logical line height we just calculated is actually
+ * different to the currently cached height of the text line.
+ * That is fine (the text line heights are only calculated
+ * asynchronously), but we must update the cached height so
+ * that any counts made with DLine pointers are the same as
+ * counts made through the BTree. This helps to ensure that
+ * the scrollbar size corresponds accurately to that displayed
+ * contents, even as the window is re-sized.
+ */
+
+ TkBTreeAdjustPixelHeight(textPtr, prevPtr->index.linePtr,
+ lineHeight, 0);
+
+ /*
+ * I believe we can be 100% sure that we started at the
+ * beginning of the logical line, so we can also adjust the
+ * 'pixelCalculationEpoch' to mark it as being up to date.
+ * There is a slight concern that we might not have got this
+ * right for the first line in the re-display.
+ */
+
+ TkBTreeLinePixelEpoch(textPtr, prevPtr->index.linePtr) =
+ dInfoPtr->lineMetricUpdateEpoch;
+ }
+ lineHeight = 0;
+ }
+
+ /*
+ * It's important to have the following check here rather than in the
+ * while statement for the loop, so that there's always at least one
+ * DLine generated, regardless of how small the window is. This keeps
+ * a lot of other code from breaking.
+ */
+
+ if (y >= maxY) {
+ break;
+ }
+ }
+
+ /*
+ * Delete any DLine structures that don't fit on the screen.
+ */
+
+ FreeDLines(textPtr, dlPtr, NULL, DLINE_UNLINK);
+
+ /*
+ * If there is extra space at the bottom of the window (because we've hit
+ * the end of the text), then bring in more lines at the top of the
+ * window, if there are any, to fill in the view.
+ *
+ * Since the top line may only be partially visible, we try first to
+ * simply show more pixels from that line (newTopPixelOffset). If that
+ * isn't enough, we have to layout more lines.
+ */
+
+ if (y < maxY) {
+ /*
+ * This counts how many vertical pixels we have left to fill by
+ * pulling in more display pixels either from the first currently
+ * displayed, or the lines above it.
+ */
+
+ int spaceLeft = maxY - y;
+
+ if (spaceLeft <= dInfoPtr->newTopPixelOffset) {
+ /*
+ * We can fill up all the needed space just by showing more of the
+ * current top line.
+ */
+
+ dInfoPtr->newTopPixelOffset -= spaceLeft;
+ y += spaceLeft;
+ spaceLeft = 0;
+ } else {
+ int lineNum, bytesToCount;
+ DLine *lowestPtr;
+
+ /*
+ * Add in all of the current top line, which won't be enough to
+ * bring y up to maxY (if it was we would be in the 'if' block
+ * above).
+ */
+
+ y += dInfoPtr->newTopPixelOffset;
+ dInfoPtr->newTopPixelOffset = 0;
+
+ /*
+ * Layout an entire text line (potentially > 1 display line), then
+ * link in as many display lines as fit without moving the bottom
+ * line out of the window. Repeat this until all the extra space
+ * has been used up or we've reached the beginning of the text.
+ */
+
+ spaceLeft = maxY - y;
+ if (dInfoPtr->dLinePtr == NULL) {
+ /*
+ * No lines have been laid out. This must be an empty peer
+ * widget.
+ */
+
+ lineNum = TkBTreeNumLines(textPtr->sharedTextPtr->tree,
+ textPtr) - 1;
+ bytesToCount = INT_MAX;
+ } else {
+ lineNum = TkBTreeLinesTo(textPtr,
+ dInfoPtr->dLinePtr->index.linePtr);
+ bytesToCount = dInfoPtr->dLinePtr->index.byteIndex;
+ if (bytesToCount == 0) {
+ bytesToCount = INT_MAX;
+ lineNum--;
+ }
+ }
+ for ( ; (lineNum >= 0) && (spaceLeft > 0); lineNum--) {
+ int pixelHeight = 0;
+
+ index.linePtr = TkBTreeFindLine(textPtr->sharedTextPtr->tree,
+ textPtr, lineNum);
+ index.byteIndex = 0;
+ lowestPtr = NULL;
+
+ do {
+ dlPtr = LayoutDLine(textPtr, &index);
+ pixelHeight += dlPtr->height;
+ dlPtr->nextPtr = lowestPtr;
+ lowestPtr = dlPtr;
+ if (dlPtr->length == 0 && dlPtr->height == 0) {
+ bytesToCount--;
+ break;
+ } /* elide */
+ TkTextIndexForwBytes(textPtr, &index, dlPtr->byteCount,
+ &index);
+ bytesToCount -= dlPtr->byteCount;
+ } while ((bytesToCount > 0)
+ && (index.linePtr == lowestPtr->index.linePtr));
+
+ /*
+ * We may not have examined the entire line (depending on the
+ * value of 'bytesToCount', so we only want to set this if it
+ * is genuinely bigger).
+ */
+
+ if (pixelHeight > TkBTreeLinePixelCount(textPtr,
+ lowestPtr->index.linePtr)) {
+ TkBTreeAdjustPixelHeight(textPtr,
+ lowestPtr->index.linePtr, pixelHeight, 0);
+ if (index.linePtr != lowestPtr->index.linePtr) {
+ /*
+ * We examined the entire line, so can update the
+ * epoch.
+ */
+
+ TkBTreeLinePixelEpoch(textPtr,
+ lowestPtr->index.linePtr) =
+ dInfoPtr->lineMetricUpdateEpoch;
+ }
+ }
+
+ /*
+ * Scan through the display lines from the bottom one up to
+ * the top one.
+ */
+
+ while (lowestPtr != NULL) {
+ dlPtr = lowestPtr;
+ spaceLeft -= dlPtr->height;
+ lowestPtr = dlPtr->nextPtr;
+ dlPtr->nextPtr = dInfoPtr->dLinePtr;
+ dInfoPtr->dLinePtr = dlPtr;
+ if (tkTextDebug) {
+ char string[TK_POS_CHARS];
+
+ TkTextPrintIndex(textPtr, &dlPtr->index, string);
+ LOG("tk_textRelayout", string);
+ }
+ if (spaceLeft <= 0) {
+ break;
+ }
+ }
+ FreeDLines(textPtr, lowestPtr, NULL, DLINE_FREE);
+ bytesToCount = INT_MAX;
+ }
+
+ /*
+ * We've either filled in the space we wanted to or we've run out
+ * of display lines at the top of the text. Note that we already
+ * set dInfoPtr->newTopPixelOffset to zero above.
+ */
+
+ if (spaceLeft < 0) {
+ /*
+ * We've laid out a few too many vertical pixels at or above
+ * the first line. Therefore we only want to show part of the
+ * first displayed line, so that the last displayed line just
+ * fits in the window.
+ */
+
+ dInfoPtr->newTopPixelOffset = -spaceLeft;
+ if (dInfoPtr->newTopPixelOffset>=dInfoPtr->dLinePtr->height) {
+ /*
+ * Somehow the entire first line we laid out is shorter
+ * than the new offset. This should not occur and would
+ * indicate a bad problem in the logic above.
+ */
+
+ Tcl_Panic("Error in pixel height consistency while filling in spacesLeft");
+ }
+ }
+ }
+
+ /*
+ * Now we're all done except that the y-coordinates in all the DLines
+ * are wrong and the top index for the text is wrong. Update them.
+ */
+
+ if (dInfoPtr->dLinePtr != NULL) {
+ textPtr->topIndex = dInfoPtr->dLinePtr->index;
+ y = dInfoPtr->y - dInfoPtr->newTopPixelOffset;
+ for (dlPtr = dInfoPtr->dLinePtr; dlPtr != NULL;
+ dlPtr = dlPtr->nextPtr) {
+ if (y > dInfoPtr->maxY) {
+ Tcl_Panic("Added too many new lines in UpdateDisplayInfo");
+ }
+ dlPtr->y = y;
+ y += dlPtr->height;
+ }
+ }
+ }
+
+ /*
+ * If the old top or bottom line has scrolled elsewhere on the screen, we
+ * may not be able to re-use its old contents by copying bits (e.g., a
+ * beveled edge that was drawn when it was at the top or bottom won't be
+ * drawn when the line is in the middle and its neighbor has a matching
+ * background). Similarly, if the new top or bottom line came from
+ * somewhere else on the screen, we may not be able to copy the old bits.
+ */
+
+ dlPtr = dInfoPtr->dLinePtr;
+ if (dlPtr != NULL) {
+ if ((dlPtr->flags & HAS_3D_BORDER) && !(dlPtr->flags & TOP_LINE)) {
+ dlPtr->flags |= OLD_Y_INVALID;
+ }
+ while (1) {
+ if ((dlPtr->flags & TOP_LINE) && (dlPtr != dInfoPtr->dLinePtr)
+ && (dlPtr->flags & HAS_3D_BORDER)) {
+ dlPtr->flags |= OLD_Y_INVALID;
+ }
+
+ /*
+ * If the old top-line was not completely showing (i.e. the
+ * pixelOffset is non-zero) and is no longer the top-line, then we
+ * must re-draw it.
+ */
+
+ if ((dlPtr->flags & TOP_LINE) &&
+ dInfoPtr->topPixelOffset!=0 && dlPtr!=dInfoPtr->dLinePtr) {
+ dlPtr->flags |= OLD_Y_INVALID;
+ }
+ if ((dlPtr->flags & BOTTOM_LINE) && (dlPtr->nextPtr != NULL)
+ && (dlPtr->flags & HAS_3D_BORDER)) {
+ dlPtr->flags |= OLD_Y_INVALID;
+ }
+ if (dlPtr->nextPtr == NULL) {
+ if ((dlPtr->flags & HAS_3D_BORDER)
+ && !(dlPtr->flags & BOTTOM_LINE)) {
+ dlPtr->flags |= OLD_Y_INVALID;
+ }
+ dlPtr->flags &= ~TOP_LINE;
+ dlPtr->flags |= BOTTOM_LINE;
+ break;
+ }
+ dlPtr->flags &= ~(TOP_LINE|BOTTOM_LINE);
+ dlPtr = dlPtr->nextPtr;
+ }
+ dInfoPtr->dLinePtr->flags |= TOP_LINE;
+ dInfoPtr->topPixelOffset = dInfoPtr->newTopPixelOffset;
+ }
+
+ /*
+ * Arrange for scrollbars to be updated.
+ */
+
+ textPtr->flags |= UPDATE_SCROLLBARS;
+
+ /*
+ * Deal with horizontal scrolling:
+ * 1. If there's empty space to the right of the longest line, shift the
+ * screen to the right to fill in the empty space.
+ * 2. If the desired horizontal scroll position has changed, force a full
+ * redisplay of all the lines in the widget.
+ * 3. If the wrap mode isn't "none" then re-scroll to the base position.
+ */
+
+ dInfoPtr->maxLength = 0;
+ for (dlPtr = dInfoPtr->dLinePtr; dlPtr != NULL;
+ dlPtr = dlPtr->nextPtr) {
+ if (dlPtr->length > dInfoPtr->maxLength) {
+ dInfoPtr->maxLength = dlPtr->length;
+ }
+ }
+ maxOffset = dInfoPtr->maxLength - (dInfoPtr->maxX - dInfoPtr->x);
+
+ xPixelOffset = dInfoPtr->newXPixelOffset;
+ if (xPixelOffset > maxOffset) {
+ xPixelOffset = maxOffset;
+ }
+ if (xPixelOffset < 0) {
+ xPixelOffset = 0;
+ }
+
+ /*
+ * Here's a problem: see the tests textDisp-29.2.1-4
+ *
+ * If the widget is being created, but has not yet been configured it will
+ * have a maxY of 1 above, and we won't have examined all the lines
+ * (just the first line, in fact), and so maxOffset will not be a true
+ * reflection of the widget's lines. Therefore we must not overwrite the
+ * original newXPixelOffset in this case.
+ */
+
+ if (!(((Tk_FakeWin *) (textPtr->tkwin))->flags & TK_NEED_CONFIG_NOTIFY)) {
+ dInfoPtr->newXPixelOffset = xPixelOffset;
+ }
+
+ if (xPixelOffset != dInfoPtr->curXPixelOffset) {
+ dInfoPtr->curXPixelOffset = xPixelOffset;
+ for (dlPtr = dInfoPtr->dLinePtr; dlPtr != NULL;
+ dlPtr = dlPtr->nextPtr) {
+ dlPtr->flags |= OLD_Y_INVALID;
+ }
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * FreeDLines --
+ *
+ * This function is called to free up all of the resources associated
+ * with one or more DLine structures.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Memory gets freed and various other resources are released.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+FreeDLines(
+ TkText *textPtr, /* Information about overall text widget. */
+ register DLine *firstPtr, /* Pointer to first DLine to free up. */
+ DLine *lastPtr, /* Pointer to DLine just after last one to
+ * free (NULL means everything starting with
+ * firstPtr). */
+ int action) /* DLINE_UNLINK means DLines are currently
+ * linked into the list rooted at
+ * textPtr->dInfoPtr->dLinePtr and they have
+ * to be unlinked. DLINE_FREE means just free
+ * without unlinking. DLINE_FREE_TEMP means
+ * the DLine given is just a temporary one and
+ * we shouldn't invalidate anything for the
+ * overall widget. */
+{
+ register TkTextDispChunk *chunkPtr, *nextChunkPtr;
+ register DLine *nextDLinePtr;
+
+ if (action == DLINE_FREE_TEMP) {
+ lineHeightsRecalculated++;
+ if (tkTextDebug) {
+ char string[TK_POS_CHARS];
+
+ /*
+ * Debugging is enabled, so keep a log of all the lines whose
+ * height was recalculated. The test suite uses this information.
+ */
+
+ TkTextPrintIndex(textPtr, &firstPtr->index, string);
+ LOG("tk_textHeightCalc", string);
+ }
+ } else if (action == DLINE_UNLINK) {
+ if (textPtr->dInfoPtr->dLinePtr == firstPtr) {
+ textPtr->dInfoPtr->dLinePtr = lastPtr;
+ } else {
+ register DLine *prevPtr;
+
+ for (prevPtr = textPtr->dInfoPtr->dLinePtr;
+ prevPtr->nextPtr != firstPtr; prevPtr = prevPtr->nextPtr) {
+ /* Empty loop body. */
+ }
+ prevPtr->nextPtr = lastPtr;
+ }
+ }
+ while (firstPtr != lastPtr) {
+ nextDLinePtr = firstPtr->nextPtr;
+ for (chunkPtr = firstPtr->chunkPtr; chunkPtr != NULL;
+ chunkPtr = nextChunkPtr) {
+ if (chunkPtr->undisplayProc != NULL) {
+ chunkPtr->undisplayProc(textPtr, chunkPtr);
+ }
+ FreeStyle(textPtr, chunkPtr->stylePtr);
+ nextChunkPtr = chunkPtr->nextPtr;
+ ckfree(chunkPtr);
+ }
+ ckfree(firstPtr);
+ firstPtr = nextDLinePtr;
+ }
+ if (action != DLINE_FREE_TEMP) {
+ textPtr->dInfoPtr->dLinesInvalidated = 1;
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * DisplayDLine --
+ *
+ * This function is invoked to draw a single line on the screen.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The line given by dlPtr is drawn at its correct position in textPtr's
+ * window. Note that this is one *display* line, not one *text* line.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+DisplayDLine(
+ TkText *textPtr, /* Text widget in which to draw line. */
+ register DLine *dlPtr, /* Information about line to draw. */
+ DLine *prevPtr, /* Line just before one to draw, or NULL if
+ * dlPtr is the top line. */
+ Pixmap pixmap) /* Pixmap to use for double-buffering. Caller
+ * must make sure it's large enough to hold
+ * line. */
+{
+ register TkTextDispChunk *chunkPtr;
+ TextDInfo *dInfoPtr = textPtr->dInfoPtr;
+ Display *display;
+ int height, y_off;
+#ifndef TK_NO_DOUBLE_BUFFERING
+ const int y = 0;
+#else
+ const int y = dlPtr->y;
+#endif /* TK_NO_DOUBLE_BUFFERING */
+
+ if (dlPtr->chunkPtr == NULL) return;
+
+ display = Tk_Display(textPtr->tkwin);
+
+ height = dlPtr->height;
+ if ((height + dlPtr->y) > dInfoPtr->maxY) {
+ height = dInfoPtr->maxY - dlPtr->y;
+ }
+ if (dlPtr->y < dInfoPtr->y) {
+ y_off = dInfoPtr->y - dlPtr->y;
+ height -= y_off;
+ } else {
+ y_off = 0;
+ }
+
+#ifdef TK_NO_DOUBLE_BUFFERING
+ TkpClipDrawableToRect(display, pixmap, dInfoPtr->x, y + y_off,
+ dInfoPtr->maxX - dInfoPtr->x, height);
+#endif /* TK_NO_DOUBLE_BUFFERING */
+
+ /*
+ * First, clear the area of the line to the background color for the text
+ * widget.
+ */
+
+ Tk_Fill3DRectangle(textPtr->tkwin, pixmap, textPtr->border, 0, y,
+ Tk_Width(textPtr->tkwin), dlPtr->height, 0, TK_RELIEF_FLAT);
+
+ /*
+ * Second, draw background information for the whole line.
+ */
+
+ DisplayLineBackground(textPtr, dlPtr, prevPtr, pixmap);
+
+ /*
+ * Third, draw the background color of the left and right margins.
+ */
+ if (dlPtr->lMarginColor != NULL) {
+ Tk_Fill3DRectangle(textPtr->tkwin, pixmap, dlPtr->lMarginColor, 0, y,
+ dlPtr->lMarginWidth + dInfoPtr->x - dInfoPtr->curXPixelOffset,
+ dlPtr->height, 0, TK_RELIEF_FLAT);
+ }
+ if (dlPtr->rMarginColor != NULL) {
+ Tk_Fill3DRectangle(textPtr->tkwin, pixmap, dlPtr->rMarginColor,
+ dInfoPtr->maxX - dlPtr->rMarginWidth + dInfoPtr->curXPixelOffset,
+ y, dlPtr->rMarginWidth, dlPtr->height, 0, TK_RELIEF_FLAT);
+ }
+
+ /*
+ * Make another pass through all of the chunks to redraw the insertion
+ * cursor, if it is visible on this line. Must do it here rather than in
+ * the foreground pass below because otherwise a wide insertion cursor
+ * will obscure the character to its left.
+ */
+
+ if (textPtr->state == TK_TEXT_STATE_NORMAL) {
+ for (chunkPtr = dlPtr->chunkPtr; (chunkPtr != NULL);
+ chunkPtr = chunkPtr->nextPtr) {
+ if (chunkPtr->displayProc == TkTextInsertDisplayProc) {
+ int x = chunkPtr->x + dInfoPtr->x - dInfoPtr->curXPixelOffset;
+
+ chunkPtr->displayProc(textPtr, chunkPtr, x,
+ y + dlPtr->spaceAbove,
+ dlPtr->height - dlPtr->spaceAbove - dlPtr->spaceBelow,
+ dlPtr->baseline - dlPtr->spaceAbove, display, pixmap,
+ dlPtr->y + dlPtr->spaceAbove);
+ }
+ }
+ }
+
+ /*
+ * Make yet another pass through all of the chunks to redraw all of
+ * foreground information. Note: we have to call the displayProc even for
+ * chunks that are off-screen. This is needed, for example, so that
+ * embedded windows can be unmapped in this case.
+ */
+
+ for (chunkPtr = dlPtr->chunkPtr; (chunkPtr != NULL);
+ chunkPtr = chunkPtr->nextPtr) {
+ if (chunkPtr->displayProc == TkTextInsertDisplayProc) {
+ /*
+ * Already displayed the insertion cursor above. Don't do it again
+ * here.
+ */
+
+ continue;
+ }
+
+ /*
+ * Don't call if elide. This tax OK since not very many visible DLines
+ * in an area, but potentially many elide ones.
+ */
+
+ if (chunkPtr->displayProc != NULL) {
+ int x = chunkPtr->x + dInfoPtr->x - dInfoPtr->curXPixelOffset;
+
+ if ((x + chunkPtr->width <= 0) || (x >= dInfoPtr->maxX)) {
+ /*
+ * Note: we have to call the displayProc even for chunks that
+ * are off-screen. This is needed, for example, so that
+ * embedded windows can be unmapped in this case. Display the
+ * chunk at a coordinate that can be clearly identified by the
+ * displayProc as being off-screen to the left (the
+ * displayProc may not be able to tell if something is off to
+ * the right).
+ */
+
+ x = -chunkPtr->width;
+ }
+ chunkPtr->displayProc(textPtr, chunkPtr, x,
+ y + dlPtr->spaceAbove, dlPtr->height - dlPtr->spaceAbove -
+ dlPtr->spaceBelow, dlPtr->baseline - dlPtr->spaceAbove,
+ display, pixmap, dlPtr->y + dlPtr->spaceAbove);
+ }
+
+ if (dInfoPtr->dLinesInvalidated) {
+ return;
+ }
+ }
+
+#ifndef TK_NO_DOUBLE_BUFFERING
+ /*
+ * Copy the pixmap onto the screen. If this is the first or last line on
+ * the screen then copy a piece of the line, so that it doesn't overflow
+ * into the border area. Another special trick: copy the padding area to
+ * the left of the line; this is because the insertion cursor sometimes
+ * overflows onto that area and we want to get as much of the cursor as
+ * possible.
+ */
+
+ XCopyArea(display, pixmap, Tk_WindowId(textPtr->tkwin), dInfoPtr->copyGC,
+ dInfoPtr->x, y + y_off, (unsigned) (dInfoPtr->maxX - dInfoPtr->x),
+ (unsigned) height, dInfoPtr->x, dlPtr->y + y_off);
+#else
+ TkpClipDrawableToRect(display, pixmap, 0, 0, -1, -1);
+#endif /* TK_NO_DOUBLE_BUFFERING */
+ linesRedrawn++;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * DisplayLineBackground --
+ *
+ * This function is called to fill in the background for a display line.
+ * It draws 3D borders cleverly so that adjacent chunks with the same
+ * style (whether on the same line or different lines) have a single 3D
+ * border around the whole region.
+ *
+ * Results:
+ * There is no return value. Pixmap is filled in with background
+ * information for dlPtr.
+ *
+ * Side effects:
+ * None.
+ *
+ *--------------------------------------------------------------
+ */
+
+static void
+DisplayLineBackground(
+ TkText *textPtr, /* Text widget containing line. */
+ register DLine *dlPtr, /* Information about line to draw. */
+ DLine *prevPtr, /* Line just above dlPtr, or NULL if dlPtr is
+ * the top-most line in the window. */
+ Pixmap pixmap) /* Pixmap to use for double-buffering. Caller
+ * must make sure it's large enough to hold
+ * line. Caller must also have filled it with
+ * the background color for the widget. */
+{
+ TextDInfo *dInfoPtr = textPtr->dInfoPtr;
+ TkTextDispChunk *chunkPtr; /* Pointer to chunk in the current line. */
+ TkTextDispChunk *chunkPtr2; /* Pointer to chunk in the line above or below
+ * the current one. NULL if we're to the left
+ * of or to the right of the chunks in the
+ * line. */
+ TkTextDispChunk *nextPtr2; /* Next chunk after chunkPtr2 (it's not the
+ * same as chunkPtr2->nextPtr in the case
+ * where chunkPtr2 is NULL because the line is
+ * indented). */
+ int leftX; /* The left edge of the region we're currently
+ * working on. */
+ int leftXIn; /* 1 means beveled edge at leftX slopes right
+ * as it goes down, 0 means it slopes left as
+ * it goes down. */
+ int rightX; /* Right edge of chunkPtr. */
+ int rightX2; /* Right edge of chunkPtr2. */
+ int matchLeft; /* Does the style of this line match that of
+ * its neighbor just to the left of the
+ * current x coordinate? */
+ int matchRight; /* Does line's style match its neighbor just
+ * to the right of the current x-coord? */
+ int minX, maxX, xOffset, bw;
+ StyleValues *sValuePtr;
+ Display *display;
+#ifndef TK_NO_DOUBLE_BUFFERING
+ const int y = 0;
+#else
+ const int y = dlPtr->y;
+#endif /* TK_NO_DOUBLE_BUFFERING */
+
+ /*
+ * Pass 1: scan through dlPtr from left to right. For each range of chunks
+ * with the same style, draw the main background for the style plus the
+ * vertical parts of the 3D borders (the left and right edges).
+ */
+
+ display = Tk_Display(textPtr->tkwin);
+ minX = dInfoPtr->curXPixelOffset;
+ xOffset = dInfoPtr->x - minX;
+ maxX = minX + dInfoPtr->maxX - dInfoPtr->x;
+ chunkPtr = dlPtr->chunkPtr;
+
+ /*
+ * Note A: in the following statement, and a few others later in this file
+ * marked with "See Note A above", the right side of the assignment was
+ * replaced with 0 on 6/18/97. This has the effect of highlighting the
+ * empty space to the left of a line whenever the leftmost character of
+ * the line is highlighted. This way, multi-line highlights always line up
+ * along their left edges. However, this may look funny in the case where
+ * a single word is highlighted. To undo the change, replace "leftX = 0"
+ * with "leftX = chunkPtr->x" and "rightX2 = 0" with "rightX2 =
+ * nextPtr2->x" here and at all the marked points below. This restores the
+ * old behavior where empty space to the left of a line is not
+ * highlighted, leaving a ragged left edge for multi-line highlights.
+ */
+
+ leftX = 0;
+ for (; leftX < maxX; chunkPtr = chunkPtr->nextPtr) {
+ if ((chunkPtr->nextPtr != NULL)
+ && SAME_BACKGROUND(chunkPtr->nextPtr->stylePtr,
+ chunkPtr->stylePtr)) {
+ continue;
+ }
+ sValuePtr = chunkPtr->stylePtr->sValuePtr;
+ rightX = chunkPtr->x + chunkPtr->width;
+ if ((chunkPtr->nextPtr == NULL) && (rightX < maxX)) {
+ rightX = maxX;
+ }
+ if (chunkPtr->stylePtr->bgGC != None) {
+ /*
+ * Not visible - bail out now.
+ */
+
+ if (rightX + xOffset <= 0) {
+ leftX = rightX;
+ continue;
+ }
+
+ /*
+ * Trim the start position for drawing to be no further away than
+ * -borderWidth. The reason is that on many X servers drawing from
+ * -32768 (or less) to +something simply does not display
+ * correctly. [Patch #541999]
+ */
+
+ if ((leftX + xOffset) < -(sValuePtr->borderWidth)) {
+ leftX = -sValuePtr->borderWidth - xOffset;
+ }
+ if ((rightX - leftX) > 32767) {
+ rightX = leftX + 32767;
+ }
+
+ /*
+ * Prevent the borders from leaking on adjacent characters,
+ * which would happen for too large border width.
+ */
+
+ bw = sValuePtr->borderWidth;
+ if (leftX + sValuePtr->borderWidth > rightX) {
+ bw = rightX - leftX;
+ }
+
+ XFillRectangle(display, pixmap, chunkPtr->stylePtr->bgGC,
+ leftX + xOffset, y, (unsigned int) (rightX - leftX),
+ (unsigned int) dlPtr->height);
+ if (sValuePtr->relief != TK_RELIEF_FLAT) {
+ Tk_3DVerticalBevel(textPtr->tkwin, pixmap, sValuePtr->border,
+ leftX + xOffset, y, bw, dlPtr->height, 1,
+ sValuePtr->relief);
+ Tk_3DVerticalBevel(textPtr->tkwin, pixmap, sValuePtr->border,
+ rightX - bw + xOffset, y, bw, dlPtr->height, 0,
+ sValuePtr->relief);
+ }
+ }
+ leftX = rightX;
+ }
+
+ /*
+ * Pass 2: draw the horizontal bevels along the top of the line. To do
+ * this, scan through dlPtr from left to right while simultaneously
+ * scanning through the line just above dlPtr. ChunkPtr2 and nextPtr2
+ * refer to two adjacent chunks in the line above.
+ */
+
+ chunkPtr = dlPtr->chunkPtr;
+ leftX = 0; /* See Note A above. */
+ leftXIn = 1;
+ rightX = chunkPtr->x + chunkPtr->width;
+ if ((chunkPtr->nextPtr == NULL) && (rightX < maxX)) {
+ rightX = maxX;
+ }
+ chunkPtr2 = NULL;
+ if (prevPtr != NULL && prevPtr->chunkPtr != NULL) {
+ /*
+ * Find the chunk in the previous line that covers leftX.
+ */
+
+ nextPtr2 = prevPtr->chunkPtr;
+ rightX2 = 0; /* See Note A above. */
+ while (rightX2 <= leftX) {
+ chunkPtr2 = nextPtr2;
+ if (chunkPtr2 == NULL) {
+ break;
+ }
+ nextPtr2 = chunkPtr2->nextPtr;
+ rightX2 = chunkPtr2->x + chunkPtr2->width;
+ if (nextPtr2 == NULL) {
+ rightX2 = INT_MAX;
+ }
+ }
+ } else {
+ nextPtr2 = NULL;
+ rightX2 = INT_MAX;
+ }
+
+ while (leftX < maxX) {
+ matchLeft = (chunkPtr2 != NULL)
+ && SAME_BACKGROUND(chunkPtr2->stylePtr, chunkPtr->stylePtr);
+ sValuePtr = chunkPtr->stylePtr->sValuePtr;
+ if (rightX <= rightX2) {
+ /*
+ * The chunk in our line is about to end. If its style changes
+ * then draw the bevel for the current style.
+ */
+
+ if ((chunkPtr->nextPtr == NULL)
+ || !SAME_BACKGROUND(chunkPtr->stylePtr,
+ chunkPtr->nextPtr->stylePtr)) {
+ if (!matchLeft && (sValuePtr->relief != TK_RELIEF_FLAT)) {
+ Tk_3DHorizontalBevel(textPtr->tkwin, pixmap,
+ sValuePtr->border, leftX + xOffset, y,
+ rightX - leftX, sValuePtr->borderWidth, leftXIn,
+ 1, 1, sValuePtr->relief);
+ }
+ leftX = rightX;
+ leftXIn = 1;
+
+ /*
+ * If the chunk in the line above is also ending at the same
+ * point then advance to the next chunk in that line.
+ */
+
+ if ((rightX == rightX2) && (chunkPtr2 != NULL)) {
+ goto nextChunk2;
+ }
+ }
+ chunkPtr = chunkPtr->nextPtr;
+ if (chunkPtr == NULL) {
+ break;
+ }
+ rightX = chunkPtr->x + chunkPtr->width;
+ if ((chunkPtr->nextPtr == NULL) && (rightX < maxX)) {
+ rightX = maxX;
+ }
+ continue;
+ }
+
+ /*
+ * The chunk in the line above is ending at an x-position where there
+ * is no change in the style of the current line. If the style above
+ * matches the current line on one side of the change but not on the
+ * other, we have to draw an L-shaped piece of bevel.
+ */
+
+ matchRight = (nextPtr2 != NULL)
+ && SAME_BACKGROUND(nextPtr2->stylePtr, chunkPtr->stylePtr);
+ if (matchLeft && !matchRight) {
+ bw = sValuePtr->borderWidth;
+ if (rightX2 - sValuePtr->borderWidth < leftX) {
+ bw = rightX2 - leftX;
+ }
+ if (sValuePtr->relief != TK_RELIEF_FLAT) {
+ Tk_3DVerticalBevel(textPtr->tkwin, pixmap, sValuePtr->border,
+ rightX2 - bw + xOffset, y, bw,
+ sValuePtr->borderWidth, 0, sValuePtr->relief);
+ }
+ leftX = rightX2 - bw;
+ leftXIn = 0;
+ } else if (!matchLeft && matchRight
+ && (sValuePtr->relief != TK_RELIEF_FLAT)) {
+ bw = sValuePtr->borderWidth;
+ if (rightX2 + sValuePtr->borderWidth > rightX) {
+ bw = rightX - rightX2;
+ }
+ Tk_3DVerticalBevel(textPtr->tkwin, pixmap, sValuePtr->border,
+ rightX2 + xOffset, y, bw, sValuePtr->borderWidth,
+ 1, sValuePtr->relief);
+ Tk_3DHorizontalBevel(textPtr->tkwin, pixmap, sValuePtr->border,
+ leftX + xOffset, y, rightX2 + bw - leftX,
+ sValuePtr->borderWidth, leftXIn, 0, 1,
+ sValuePtr->relief);
+ }
+
+ nextChunk2:
+ chunkPtr2 = nextPtr2;
+ if (chunkPtr2 == NULL) {
+ rightX2 = INT_MAX;
+ } else {
+ nextPtr2 = chunkPtr2->nextPtr;
+ rightX2 = chunkPtr2->x + chunkPtr2->width;
+ if (nextPtr2 == NULL) {
+ rightX2 = INT_MAX;
+ }
+ }
+ }
+
+ /*
+ * Pass 3: draw the horizontal bevels along the bottom of the line. This
+ * uses the same approach as pass 2.
+ */
+
+ chunkPtr = dlPtr->chunkPtr;
+ leftX = 0; /* See Note A above. */
+ leftXIn = 0;
+ rightX = chunkPtr->x + chunkPtr->width;
+ if ((chunkPtr->nextPtr == NULL) && (rightX < maxX)) {
+ rightX = maxX;
+ }
+ chunkPtr2 = NULL;
+ if (dlPtr->nextPtr != NULL && dlPtr->nextPtr->chunkPtr != NULL) {
+ /*
+ * Find the chunk in the next line that covers leftX.
+ */
+
+ nextPtr2 = dlPtr->nextPtr->chunkPtr;
+ rightX2 = 0; /* See Note A above. */
+ while (rightX2 <= leftX) {
+ chunkPtr2 = nextPtr2;
+ if (chunkPtr2 == NULL) {
+ break;
+ }
+ nextPtr2 = chunkPtr2->nextPtr;
+ rightX2 = chunkPtr2->x + chunkPtr2->width;
+ if (nextPtr2 == NULL) {
+ rightX2 = INT_MAX;
+ }
+ }
+ } else {
+ nextPtr2 = NULL;
+ rightX2 = INT_MAX;
+ }
+
+ while (leftX < maxX) {
+ matchLeft = (chunkPtr2 != NULL)
+ && SAME_BACKGROUND(chunkPtr2->stylePtr, chunkPtr->stylePtr);
+ sValuePtr = chunkPtr->stylePtr->sValuePtr;
+ if (rightX <= rightX2) {
+ if ((chunkPtr->nextPtr == NULL)
+ || !SAME_BACKGROUND(chunkPtr->stylePtr,
+ chunkPtr->nextPtr->stylePtr)) {
+ if (!matchLeft && (sValuePtr->relief != TK_RELIEF_FLAT)) {
+ Tk_3DHorizontalBevel(textPtr->tkwin, pixmap,
+ sValuePtr->border, leftX + xOffset,
+ y + dlPtr->height - sValuePtr->borderWidth,
+ rightX - leftX, sValuePtr->borderWidth, leftXIn,
+ 0, 0, sValuePtr->relief);
+ }
+ leftX = rightX;
+ leftXIn = 0;
+ if ((rightX == rightX2) && (chunkPtr2 != NULL)) {
+ goto nextChunk2b;
+ }
+ }
+ chunkPtr = chunkPtr->nextPtr;
+ if (chunkPtr == NULL) {
+ break;
+ }
+ rightX = chunkPtr->x + chunkPtr->width;
+ if ((chunkPtr->nextPtr == NULL) && (rightX < maxX)) {
+ rightX = maxX;
+ }
+ continue;
+ }
+
+ matchRight = (nextPtr2 != NULL)
+ && SAME_BACKGROUND(nextPtr2->stylePtr, chunkPtr->stylePtr);
+ if (matchLeft && !matchRight) {
+ bw = sValuePtr->borderWidth;
+ if (rightX2 - sValuePtr->borderWidth < leftX) {
+ bw = rightX2 - leftX;
+ }
+ if (sValuePtr->relief != TK_RELIEF_FLAT) {
+ Tk_3DVerticalBevel(textPtr->tkwin, pixmap, sValuePtr->border,
+ rightX2 - bw + xOffset,
+ y + dlPtr->height - sValuePtr->borderWidth,
+ bw, sValuePtr->borderWidth, 0, sValuePtr->relief);
+ }
+ leftX = rightX2 - bw;
+ leftXIn = 1;
+ } else if (!matchLeft && matchRight
+ && (sValuePtr->relief != TK_RELIEF_FLAT)) {
+ bw = sValuePtr->borderWidth;
+ if (rightX2 + sValuePtr->borderWidth > rightX) {
+ bw = rightX - rightX2;
+ }
+ Tk_3DVerticalBevel(textPtr->tkwin, pixmap, sValuePtr->border,
+ rightX2 + xOffset,
+ y + dlPtr->height - sValuePtr->borderWidth, bw,
+ sValuePtr->borderWidth, 1, sValuePtr->relief);
+ Tk_3DHorizontalBevel(textPtr->tkwin, pixmap, sValuePtr->border,
+ leftX + xOffset,
+ y + dlPtr->height - sValuePtr->borderWidth,
+ rightX2 + bw - leftX, sValuePtr->borderWidth, leftXIn,
+ 1, 0, sValuePtr->relief);
+ }
+
+ nextChunk2b:
+ chunkPtr2 = nextPtr2;
+ if (chunkPtr2 == NULL) {
+ rightX2 = INT_MAX;
+ } else {
+ nextPtr2 = chunkPtr2->nextPtr;
+ rightX2 = chunkPtr2->x + chunkPtr2->width;
+ if (nextPtr2 == NULL) {
+ rightX2 = INT_MAX;
+ }
+ }
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * AsyncUpdateLineMetrics --
+ *
+ * This function is invoked as a background handler to update the pixel-
+ * height calculations of individual lines in an asychronous manner.
+ *
+ * Currently a timer-handler is used for this purpose, which continuously
+ * reschedules itself. It may well be better to use some other approach
+ * (e.g., a background thread). We can't use an idle-callback because of
+ * a known bug in Tcl/Tk in which idle callbacks are not allowed to
+ * re-schedule themselves. This just causes an effective infinite loop.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Line heights may be recalculated.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+AsyncUpdateLineMetrics(
+ ClientData clientData) /* Information about widget. */
+{
+ register TkText *textPtr = clientData;
+ TextDInfo *dInfoPtr = textPtr->dInfoPtr;
+ int lineNum;
+
+ dInfoPtr->lineUpdateTimer = NULL;
+
+ if ((textPtr->tkwin == NULL) || (textPtr->flags & DESTROYED)
+ || !Tk_IsMapped(textPtr->tkwin)) {
+ /*
+ * The widget has been deleted, or is not mapped. Don't do anything.
+ */
+
+ if (--textPtr->refCount == 0) {
+ ckfree(textPtr);
+ }
+ return;
+ }
+
+ if (dInfoPtr->flags & REDRAW_PENDING) {
+ dInfoPtr->lineUpdateTimer = Tcl_CreateTimerHandler(1,
+ AsyncUpdateLineMetrics, clientData);
+ return;
+ }
+
+ /*
+ * Reify where we end or all hell breaks loose with the calculations when
+ * we try to update. [Bug 2677890]
+ */
+
+ lineNum = dInfoPtr->currentMetricUpdateLine;
+ if (dInfoPtr->lastMetricUpdateLine == -1) {
+ dInfoPtr->lastMetricUpdateLine =
+ TkBTreeNumLines(textPtr->sharedTextPtr->tree, textPtr);
+ }
+
+ /*
+ * Update the lines in blocks of about 24 recalculations, or 250+ lines
+ * examined, so we pass in 256 for 'doThisMuch'.
+ */
+
+ lineNum = TkTextUpdateLineMetrics(textPtr, lineNum,
+ dInfoPtr->lastMetricUpdateLine, 256);
+
+ dInfoPtr->currentMetricUpdateLine = lineNum;
+
+ if (tkTextDebug) {
+ char buffer[2 * TCL_INTEGER_SPACE + 1];
+
+ sprintf(buffer, "%d %d", lineNum, dInfoPtr->lastMetricUpdateLine);
+ LOG("tk_textInvalidateLine", buffer);
+ }
+
+ /*
+ * If we're not in the middle of a long-line calculation (metricEpoch==-1)
+ * and we've reached the last line, then we're done.
+ */
+
+ if (dInfoPtr->metricEpoch == -1
+ && lineNum == dInfoPtr->lastMetricUpdateLine) {
+ /*
+ * We have looped over all lines, so we're done. We must release our
+ * refCount on the widget (the timer token was already set to NULL
+ * above). If there is a registered aftersync command, run that first.
+ */
+
+ if (textPtr->afterSyncCmd) {
+ int code;
+ Tcl_Preserve((ClientData) textPtr->interp);
+ code = Tcl_EvalObjEx(textPtr->interp, textPtr->afterSyncCmd,
+ TCL_EVAL_GLOBAL);
+ if (code == TCL_ERROR) {
+ Tcl_AddErrorInfo(textPtr->interp, "\n (text sync)");
+ Tcl_BackgroundError(textPtr->interp);
+ }
+ Tcl_Release((ClientData) textPtr->interp);
+ Tcl_DecrRefCount(textPtr->afterSyncCmd);
+ textPtr->afterSyncCmd = NULL;
+ }
+
+ /*
+ * Fire the <<WidgetViewSync>> event since the widget view is in sync
+ * with its internal data (actually it will be after the next trip
+ * through the event loop, because the widget redraws at idle-time).
+ */
+
+ GenerateWidgetViewSyncEvent(textPtr, 1);
+
+ textPtr->refCount--;
+ if (textPtr->refCount == 0) {
+ ckfree(textPtr);
+ }
+ return;
+ }
+
+ /*
+ * Re-arm the timer. We already have a refCount on the text widget so no
+ * need to adjust that.
+ */
+
+ dInfoPtr->lineUpdateTimer = Tcl_CreateTimerHandler(1,
+ AsyncUpdateLineMetrics, textPtr);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * GenerateWidgetViewSyncEvent --
+ *
+ * Send the <<WidgetViewSync>> event related to the text widget
+ * line metrics asynchronous update.
+ * This is equivalent to:
+ * event generate $textWidget <<WidgetViewSync>> -data $s
+ * where $s is the sync status: true (when the widget view is in
+ * sync with its internal data) or false (when it is not).
+ *
+ * Results:
+ * None
+ *
+ * Side effects:
+ * If corresponding bindings are present, they will trigger.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+GenerateWidgetViewSyncEvent(
+ TkText *textPtr, /* Information about text widget. */
+ Bool InSync) /* true if in sync, false otherwise */
+{
+ TkSendVirtualEvent(textPtr->tkwin, "WidgetViewSync",
+ Tcl_NewBooleanObj(InSync));
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkTextUpdateLineMetrics --
+ *
+ * This function updates the pixel height calculations of a range of
+ * lines in the widget. The range is from lineNum to endLine, but, if
+ * doThisMuch is positive, then the function may return earlier, once a
+ * certain number of lines has been examined. The line counts are from 0.
+ *
+ * If doThisMuch is -1, then all lines in the range will be updated. This
+ * will potentially take quite some time for a large text widget.
+ *
+ * Note: with bad input for lineNum and endLine, this function can loop
+ * indefinitely.
+ *
+ * Results:
+ * The index of the last line examined (or -1 if we are about to wrap
+ * around from end to beginning of the widget, and the next line will be
+ * the first line).
+ *
+ * Side effects:
+ * Line heights may be recalculated.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TkTextUpdateLineMetrics(
+ TkText *textPtr, /* Information about widget. */
+ int lineNum, /* Start at this line. */
+ int endLine, /* Go no further than this line. */
+ int doThisMuch) /* How many lines to check, or how many 10s of
+ * lines to recalculate. If '-1' then do
+ * everything in the range (which may take a
+ * while). */
+{
+ TkTextLine *linePtr = NULL;
+ int count = 0;
+ int totalLines = TkBTreeNumLines(textPtr->sharedTextPtr->tree, textPtr);
+
+ if (totalLines == 0) {
+ /*
+ * Empty peer widget.
+ */
+
+ return endLine;
+ }
+
+ while (1) {
+ /*
+ * Get a suitable line.
+ */
+
+ if (lineNum == -1 && linePtr == NULL) {
+ lineNum = 0;
+ linePtr = TkBTreeFindLine(textPtr->sharedTextPtr->tree, textPtr,
+ lineNum);
+ } else {
+ if (lineNum == -1 || linePtr == NULL) {
+ if (lineNum == -1) {
+ lineNum = 0;
+ }
+ linePtr = TkBTreeFindLine(textPtr->sharedTextPtr->tree,
+ textPtr, lineNum);
+ } else {
+ lineNum++;
+ linePtr = TkBTreeNextLine(textPtr, linePtr);
+ }
+
+ /*
+ * If we're in the middle of a partial-line height calculation,
+ * then we can't be done.
+ */
+
+ if (textPtr->dInfoPtr->metricEpoch == -1 && lineNum == endLine) {
+ /*
+ * We have looped over all lines, so we're done.
+ */
+
+ break;
+ }
+ }
+
+ if (lineNum < totalLines) {
+ if (tkTextDebug) {
+ char buffer[4 * TCL_INTEGER_SPACE + 3];
+
+ sprintf(buffer, "%d %d %d %d",
+ lineNum, endLine, totalLines, count);
+ LOG("tk_textInvalidateLine", buffer);
+ }
+
+ /*
+ * Now update the line's metrics if necessary.
+ */
+
+ if (TkBTreeLinePixelEpoch(textPtr, linePtr)
+ == textPtr->dInfoPtr->lineMetricUpdateEpoch) {
+ /*
+ * This line is already up to date. That means there's nothing
+ * to do here.
+ */
+ } else if (doThisMuch == -1) {
+ count += 8 * TkTextUpdateOneLine(textPtr, linePtr, 0,NULL,0);
+ } else {
+ TkTextIndex index;
+ TkTextIndex *indexPtr;
+ int pixelHeight;
+
+ /*
+ * If the metric epoch is the same as the widget's epoch, then
+ * we know that indexPtrs are still valid, and if the cached
+ * metricIndex (if any) is for the same line as we wish to
+ * examine, then we are looking at a long line wrapped many
+ * times, which we will examine in pieces.
+ */
+
+ if (textPtr->dInfoPtr->metricEpoch ==
+ textPtr->sharedTextPtr->stateEpoch &&
+ textPtr->dInfoPtr->metricIndex.linePtr==linePtr) {
+ indexPtr = &textPtr->dInfoPtr->metricIndex;
+ pixelHeight = textPtr->dInfoPtr->metricPixelHeight;
+ } else {
+ /*
+ * We must reset the partial line height calculation data
+ * here, so we don't use it when it is out of date.
+ */
+
+ textPtr->dInfoPtr->metricEpoch = -1;
+ index.tree = textPtr->sharedTextPtr->tree;
+ index.linePtr = linePtr;
+ index.byteIndex = 0;
+ index.textPtr = NULL;
+ indexPtr = &index;
+ pixelHeight = 0;
+ }
+
+ /*
+ * Update the line and update the counter, counting 8 for each
+ * display line we actually re-layout.
+ */
+
+ count += 8 * TkTextUpdateOneLine(textPtr, linePtr,
+ pixelHeight, indexPtr, 1);
+
+ if (indexPtr->linePtr == linePtr) {
+ /*
+ * We didn't complete the logical line, because it
+ * produced very many display lines, which must be because
+ * it must be a long line wrapped many times. So we must
+ * cache as far as we got for next time around.
+ */
+
+ if (pixelHeight == 0) {
+ /*
+ * These have already been stored, unless we just
+ * started the new line.
+ */
+
+ textPtr->dInfoPtr->metricIndex = index;
+ textPtr->dInfoPtr->metricEpoch =
+ textPtr->sharedTextPtr->stateEpoch;
+ }
+ textPtr->dInfoPtr->metricPixelHeight =
+ TkBTreeLinePixelCount(textPtr, linePtr);
+ break;
+ }
+
+ /*
+ * We're done with this long line.
+ */
+
+ textPtr->dInfoPtr->metricEpoch = -1;
+ }
+ } else {
+ /*
+ * We must never recalculate the height of the last artificial
+ * line. It must stay at zero, and if we recalculate it, it will
+ * change.
+ */
+
+ if (endLine >= totalLines) {
+ lineNum = endLine;
+ break;
+ }
+
+ /*
+ * Set things up for the next loop through.
+ */
+
+ lineNum = -1;
+ }
+ count++;
+
+ if (doThisMuch != -1 && count >= doThisMuch) {
+ break;
+ }
+ }
+ if (doThisMuch == -1) {
+ /*
+ * If we were requested to provide a full update, then also update the
+ * scrollbar.
+ */
+
+ GetYView(textPtr->interp, textPtr, 1);
+ }
+ return lineNum;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkTextInvalidateLineMetrics, TextInvalidateLineMetrics --
+ *
+ * Mark a number of text lines as having invalid line metric
+ * calculations. Never call this with linePtr as the last (artificial)
+ * line in the text. Depending on 'action' which indicates whether the
+ * given lines are simply invalid or have been inserted or deleted, the
+ * pre-existing asynchronous line update range may need to be adjusted.
+ *
+ * If linePtr is NULL then 'lineCount' and 'action' are ignored and all
+ * lines are invalidated.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * May schedule an asychronous callback.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TkTextInvalidateLineMetrics(
+ TkSharedText *sharedTextPtr,/* Shared widget section for all peers, or
+ * NULL. */
+ TkText *textPtr, /* Widget record for text widget. */
+ TkTextLine *linePtr, /* Invalidation starts from this line. */
+ int lineCount, /* And includes this many following lines. */
+ int action) /* Indicates what type of invalidation
+ * occurred (insert, delete, or simple). */
+{
+ if (sharedTextPtr == NULL) {
+ TextInvalidateLineMetrics(textPtr, linePtr, lineCount, action);
+ } else {
+ textPtr = sharedTextPtr->peers;
+ while (textPtr != NULL) {
+ TextInvalidateLineMetrics(textPtr, linePtr, lineCount, action);
+ textPtr = textPtr->next;
+ }
+ }
+}
+
+static void
+TextInvalidateLineMetrics(
+ TkText *textPtr, /* Widget record for text widget. */
+ TkTextLine *linePtr, /* Invalidation starts from this line. */
+ int lineCount, /* And includes this many following lines. */
+ int action) /* Indicates what type of invalidation
+ * occurred (insert, delete, or simple). */
+{
+ int fromLine;
+ TextDInfo *dInfoPtr = textPtr->dInfoPtr;
+
+ if (linePtr != NULL) {
+ int counter = lineCount;
+
+ fromLine = TkBTreeLinesTo(textPtr, linePtr);
+
+ /*
+ * Invalidate the height calculations of each line in the given range.
+ */
+
+ TkBTreeLinePixelEpoch(textPtr, linePtr) = 0;
+ while (counter > 0 && linePtr != NULL) {
+ linePtr = TkBTreeNextLine(textPtr, linePtr);
+ if (linePtr != NULL) {
+ TkBTreeLinePixelEpoch(textPtr, linePtr) = 0;
+ }
+ counter--;
+ }
+
+ /*
+ * Now schedule an examination of each line in the union of the old
+ * and new update ranges, including the (possibly empty) range in
+ * between. If that between range is not-empty, then we are examining
+ * more lines than is strictly necessary (but the examination of the
+ * extra lines should be quick, since their pixelCalculationEpoch will
+ * be up to date). However, to keep track of that would require more
+ * complex record-keeping than what we have.
+ */
+
+ if (dInfoPtr->lineUpdateTimer == NULL) {
+ dInfoPtr->currentMetricUpdateLine = fromLine;
+ if (action == TK_TEXT_INVALIDATE_DELETE) {
+ lineCount = 0;
+ }
+ dInfoPtr->lastMetricUpdateLine = fromLine + lineCount + 1;
+ } else {
+ int toLine = fromLine + lineCount + 1;
+
+ if (action == TK_TEXT_INVALIDATE_DELETE) {
+ if (toLine <= dInfoPtr->currentMetricUpdateLine) {
+ dInfoPtr->currentMetricUpdateLine = fromLine;
+ if (dInfoPtr->lastMetricUpdateLine != -1) {
+ dInfoPtr->lastMetricUpdateLine -= lineCount;
+ }
+ } else if (fromLine <= dInfoPtr->currentMetricUpdateLine) {
+ dInfoPtr->currentMetricUpdateLine = fromLine;
+ if (toLine <= dInfoPtr->lastMetricUpdateLine) {
+ dInfoPtr->lastMetricUpdateLine -= lineCount;
+ }
+ } else {
+ if (dInfoPtr->lastMetricUpdateLine != -1) {
+ dInfoPtr->lastMetricUpdateLine = toLine;
+ }
+ }
+ } else if (action == TK_TEXT_INVALIDATE_INSERT) {
+ if (toLine <= dInfoPtr->currentMetricUpdateLine) {
+ dInfoPtr->currentMetricUpdateLine = fromLine;
+ if (dInfoPtr->lastMetricUpdateLine != -1) {
+ dInfoPtr->lastMetricUpdateLine += lineCount;
+ }
+ } else if (fromLine <= dInfoPtr->currentMetricUpdateLine) {
+ dInfoPtr->currentMetricUpdateLine = fromLine;
+ if (toLine <= dInfoPtr->lastMetricUpdateLine) {
+ dInfoPtr->lastMetricUpdateLine += lineCount;
+ }
+ if (toLine > dInfoPtr->lastMetricUpdateLine) {
+ dInfoPtr->lastMetricUpdateLine = toLine;
+ }
+ } else {
+ if (dInfoPtr->lastMetricUpdateLine != -1) {
+ dInfoPtr->lastMetricUpdateLine = toLine;
+ }
+ }
+ } else {
+ if (fromLine < dInfoPtr->currentMetricUpdateLine) {
+ dInfoPtr->currentMetricUpdateLine = fromLine;
+ }
+ if (dInfoPtr->lastMetricUpdateLine != -1
+ && toLine > dInfoPtr->lastMetricUpdateLine) {
+ dInfoPtr->lastMetricUpdateLine = toLine;
+ }
+ }
+ }
+ } else {
+ /*
+ * This invalidates the height of all lines in the widget.
+ */
+
+ if ((++dInfoPtr->lineMetricUpdateEpoch) == 0) {
+ dInfoPtr->lineMetricUpdateEpoch++;
+ }
+
+ /*
+ * This has the effect of forcing an entire new loop of update checks
+ * on all lines in the widget.
+ */
+
+ if (dInfoPtr->lineUpdateTimer == NULL) {
+ dInfoPtr->currentMetricUpdateLine = -1;
+ }
+ dInfoPtr->lastMetricUpdateLine = dInfoPtr->currentMetricUpdateLine;
+ }
+
+ /*
+ * Now re-set the current update calculations.
+ */
+
+ if (dInfoPtr->lineUpdateTimer == NULL) {
+ textPtr->refCount++;
+ dInfoPtr->lineUpdateTimer = Tcl_CreateTimerHandler(1,
+ AsyncUpdateLineMetrics, textPtr);
+ GenerateWidgetViewSyncEvent(textPtr, 0);
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkTextFindDisplayLineEnd --
+ *
+ * This function is invoked to find the index of the beginning or end of
+ * the particular display line on which the given index sits, whether
+ * that line is displayed or not.
+ *
+ * If 'end' is zero, we look for the start, and if 'end' is one we look
+ * for the end.
+ *
+ * If the beginning of the current display line is elided, and we are
+ * looking for the start of the line, then the returned index will be the
+ * first elided index on the display line.
+ *
+ * Similarly if the end of the current display line is elided and we are
+ * looking for the end, then the returned index will be the last elided
+ * index on the display line.
+ *
+ * Results:
+ * Modifies indexPtr to point to the given end.
+ *
+ * If xOffset is non-NULL, it is set to the x-pixel offset of the given
+ * original index within the given display line.
+ *
+ * Side effects:
+ * The combination of 'LayoutDLine' and 'FreeDLines' seems like a rather
+ * time-consuming way of gathering the information we need, so this would
+ * be a good place to look to speed up the calculations. In particular
+ * these calls will map and unmap embedded windows respectively, which I
+ * would hope isn't exactly necessary!
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TkTextFindDisplayLineEnd(
+ TkText *textPtr, /* Widget record for text widget. */
+ TkTextIndex *indexPtr, /* Index we will adjust to the display line
+ * start or end. */
+ int end, /* 0 = start, 1 = end. */
+ int *xOffset) /* NULL, or used to store the x-pixel offset
+ * of the original index within its display
+ * line. */
+{
+ TkTextIndex index;
+
+ if (!end && IsStartOfNotMergedLine(textPtr, indexPtr)) {
+ /*
+ * Nothing to do.
+ */
+
+ if (xOffset != NULL) {
+ *xOffset = 0;
+ }
+ return;
+ }
+
+ index = *indexPtr;
+ index.byteIndex = 0;
+ index.textPtr = NULL;
+
+ while (1) {
+ TkTextIndex endOfLastLine;
+
+ if (TkTextIndexBackBytes(textPtr, &index, 1, &endOfLastLine)) {
+ /*
+ * Reached beginning of text.
+ */
+
+ break;
+ }
+
+ if (!TkTextIsElided(textPtr, &endOfLastLine, NULL)) {
+ /*
+ * The eol is not elided, so 'index' points to the start of a
+ * display line (as well as logical line).
+ */
+
+ break;
+ }
+
+ /*
+ * indexPtr's logical line is actually merged with the previous
+ * logical line whose eol is elided. Continue searching back to get a
+ * real line start.
+ */
+
+ index = endOfLastLine;
+ index.byteIndex = 0;
+ }
+
+ while (1) {
+ DLine *dlPtr;
+ int byteCount;
+ TkTextIndex nextLineStart;
+
+ dlPtr = LayoutDLine(textPtr, &index);
+ byteCount = dlPtr->byteCount;
+
+ TkTextIndexForwBytes(textPtr, &index, byteCount, &nextLineStart);
+
+ /*
+ * 'byteCount' goes up to the beginning of the next display line, so
+ * equality here says we need one more line. We try to perform a quick
+ * comparison which is valid for the case where the logical line is
+ * the same, but otherwise fall back on a full TkTextIndexCmp.
+ */
+
+ if (((index.linePtr == indexPtr->linePtr)
+ && (index.byteIndex + byteCount > indexPtr->byteIndex))
+ || (dlPtr->logicalLinesMerged > 0
+ && TkTextIndexCmp(&nextLineStart, indexPtr) > 0)) {
+ /*
+ * It's on this display line.
+ */
+
+ if (xOffset != NULL) {
+ /*
+ * This call takes a byte index relative to the start of the
+ * current _display_ line, not logical line. We are about to
+ * overwrite indexPtr->byteIndex, so we must do this now.
+ */
+
+ *xOffset = DlineXOfIndex(textPtr, dlPtr,
+ TkTextIndexCountBytes(textPtr, &dlPtr->index,
+ indexPtr));
+ }
+ if (end) {
+ /*
+ * The index we want is one less than the number of bytes in
+ * the display line.
+ */
+
+ TkTextIndexBackBytes(textPtr, &nextLineStart, 1, indexPtr);
+ } else {
+ *indexPtr = index;
+ }
+ FreeDLines(textPtr, dlPtr, NULL, DLINE_FREE_TEMP);
+ return;
+ }
+
+ FreeDLines(textPtr, dlPtr, NULL, DLINE_FREE_TEMP);
+ index = nextLineStart;
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * CalculateDisplayLineHeight --
+ *
+ * This function is invoked to recalculate the height of the particular
+ * display line which starts with the given index, whether that line is
+ * displayed or not.
+ *
+ * This function does not, in itself, update any cached information about
+ * line heights. That should be done, where necessary, by its callers.
+ *
+ * The behaviour of this function is _undefined_ if indexPtr is not
+ * currently at the beginning of a display line.
+ *
+ * Results:
+ * The number of vertical pixels used by the display line.
+ *
+ * If 'byteCountPtr' is non-NULL, then returns in that pointer the number
+ * of byte indices on the given display line (which can be used to update
+ * indexPtr in a loop).
+ *
+ * If 'mergedLinePtr' is non-NULL, then returns in that pointer the
+ * number of extra logical lines merged into the given display line.
+ *
+ * Side effects:
+ * The combination of 'LayoutDLine' and 'FreeDLines' seems like a rather
+ * time-consuming way of gathering the information we need, so this would
+ * be a good place to look to speed up the calculations. In particular
+ * these calls will map and unmap embedded windows respectively, which I
+ * would hope isn't exactly necessary!
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+CalculateDisplayLineHeight(
+ TkText *textPtr, /* Widget record for text widget. */
+ const TkTextIndex *indexPtr,/* The index at the beginning of the display
+ * line of interest. */
+ int *byteCountPtr, /* NULL or used to return the number of byte
+ * indices on the given display line. */
+ int *mergedLinePtr) /* NULL or used to return if the given display
+ * line merges with a following logical line
+ * (because the eol is elided). */
+{
+ DLine *dlPtr;
+ int pixelHeight;
+
+ if (tkTextDebug) {
+ int oldtkTextDebug = tkTextDebug;
+ /*
+ * Check that the indexPtr we are given really is at the start of a
+ * display line. The gymnastics with tkTextDebug is to prevent
+ * failure of a test suite test, that checks that lines are rendered
+ * exactly once. TkTextFindDisplayLineEnd is used here for checking
+ * indexPtr but it calls LayoutDLine/FreeDLine which makes the
+ * counting wrong. The debug mode shall therefore be switched off
+ * when calling TkTextFindDisplayLineEnd.
+ */
+
+ TkTextIndex indexPtr2 = *indexPtr;
+ tkTextDebug = 0;
+ TkTextFindDisplayLineEnd(textPtr, &indexPtr2, 0, NULL);
+ tkTextDebug = oldtkTextDebug;
+ if (TkTextIndexCmp(&indexPtr2,indexPtr) != 0) {
+ Tcl_Panic("CalculateDisplayLineHeight called with bad indexPtr");
+ }
+ }
+
+ /*
+ * Special case for artificial last line. May be better to move this
+ * inside LayoutDLine.
+ */
+
+ if (indexPtr->byteIndex == 0
+ && TkBTreeNextLine(textPtr, indexPtr->linePtr) == NULL) {
+ if (byteCountPtr != NULL) {
+ *byteCountPtr = 0;
+ }
+ if (mergedLinePtr != NULL) {
+ *mergedLinePtr = 0;
+ }
+ return 0;
+ }
+
+ /*
+ * Layout, find the information we need and then free the display-line we
+ * laid-out. We must use 'FreeDLines' because it will actually call the
+ * relevant code to unmap any embedded windows which were mapped in the
+ * LayoutDLine call!
+ */
+
+ dlPtr = LayoutDLine(textPtr, indexPtr);
+ pixelHeight = dlPtr->height;
+ if (byteCountPtr != NULL) {
+ *byteCountPtr = dlPtr->byteCount;
+ }
+ if (mergedLinePtr != NULL) {
+ *mergedLinePtr = dlPtr->logicalLinesMerged;
+ }
+ FreeDLines(textPtr, dlPtr, NULL, DLINE_FREE_TEMP);
+
+ return pixelHeight;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkTextIndexYPixels --
+ *
+ * This function is invoked to calculate the number of vertical pixels
+ * between the first index of the text widget and the given index. The
+ * range from first logical line to given logical line is determined
+ * using the cached values, and the range inside the given logical line
+ * is calculated on the fly.
+ *
+ * Results:
+ * The pixel distance between first pixel in the widget and the
+ * top of the index's current display line (could be zero).
+ *
+ * Side effects:
+ * Just those of 'CalculateDisplayLineHeight'.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TkTextIndexYPixels(
+ TkText *textPtr, /* Widget record for text widget. */
+ const TkTextIndex *indexPtr)/* The index of which we want the pixel
+ * distance from top of logical line to top of
+ * index. */
+{
+ int pixelHeight;
+ TkTextIndex index;
+ int alreadyStartOfLine = 1;
+
+ /*
+ * Find the index denoting the closest position being at the same time
+ * the start of a logical line above indexPtr and the start of a display
+ * line.
+ */
+
+ index = *indexPtr;
+ while (1) {
+ TkTextFindDisplayLineEnd(textPtr, &index, 0, NULL);
+ if (index.byteIndex == 0) {
+ break;
+ }
+ TkTextIndexBackBytes(textPtr, &index, 1, &index);
+ alreadyStartOfLine = 0;
+ }
+
+ pixelHeight = TkBTreePixelsTo(textPtr, index.linePtr);
+
+ /*
+ * Shortcut to avoid layout of a superfluous display line. We know there
+ * is nothing more to add up to the height if the index we were given was
+ * already on the first display line of a logical line.
+ */
+
+ if (alreadyStartOfLine) {
+ return pixelHeight;
+ }
+
+ /*
+ * Iterate through display lines, starting at the logical line belonging
+ * to index, adding up the pixel height of each such display line as we
+ * go along, until we go past 'indexPtr'.
+ */
+
+ while (1) {
+ int bytes, height, compare;
+
+ /*
+ * Currently this call doesn't have many side-effects. However, if in
+ * the future we change the code so there are side-effects (such as
+ * adjusting linePtr->pixelHeight), then the code might not quite work
+ * as intended, specifically the 'linePtr->pixelHeight == pixelHeight'
+ * test below this while loop.
+ */
+
+ height = CalculateDisplayLineHeight(textPtr, &index, &bytes, NULL);
+
+ TkTextIndexForwBytes(textPtr, &index, bytes, &index);
+
+ compare = TkTextIndexCmp(&index,indexPtr);
+ if (compare > 0) {
+ return pixelHeight;
+ }
+
+ if (height > 0) {
+ pixelHeight += height;
+ }
+
+ if (compare == 0) {
+ return pixelHeight;
+ }
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkTextUpdateOneLine --
+ *
+ * This function is invoked to recalculate the height of a particular
+ * logical line, whether that line is displayed or not.
+ *
+ * It must NEVER be called for the artificial last TkTextLine which is
+ * used internally for administrative purposes only. That line must
+ * retain its initial height of 0 otherwise the pixel height calculation
+ * maintained by the B-tree will be wrong.
+ *
+ * Results:
+ * The number of display lines in the logical line. This could be zero if
+ * the line is totally elided.
+ *
+ * Side effects:
+ * Line heights may be recalculated, and a timer to update the scrollbar
+ * may be installed. Also see the called function
+ * CalculateDisplayLineHeight for its side effects.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TkTextUpdateOneLine(
+ TkText *textPtr, /* Widget record for text widget. */
+ TkTextLine *linePtr, /* The line of which to calculate the
+ * height. */
+ int pixelHeight, /* If indexPtr is non-NULL, then this is the
+ * number of pixels in the logical line
+ * linePtr, up to the index which has been
+ * given. */
+ TkTextIndex *indexPtr, /* Either NULL or an index at the start of a
+ * display line belonging to linePtr, at which
+ * we wish to start (e.g. up to which we have
+ * already calculated). On return this will be
+ * set to the first index on the next line. */
+ int partialCalc) /* Set to 1 if we are allowed to do partial
+ * height calculations of long-lines. In this
+ * case we'll only return what we know so
+ * far. */
+{
+ TkTextIndex index;
+ int displayLines;
+ int mergedLines;
+
+ if (indexPtr == NULL) {
+ index.tree = textPtr->sharedTextPtr->tree;
+ index.linePtr = linePtr;
+ index.byteIndex = 0;
+ index.textPtr = NULL;
+ indexPtr = &index;
+ pixelHeight = 0;
+ }
+
+ /*
+ * CalculateDisplayLineHeight _must_ be called (below) with an index at
+ * the beginning of a display line. Force this to happen. This is needed
+ * when TkTextUpdateOneLine is called with a line that is merged with its
+ * previous line: the number of merged logical lines in a display line is
+ * calculated correctly only when CalculateDisplayLineHeight receives
+ * an index at the beginning of a display line. In turn this causes the
+ * merged lines to receive their correct zero pixel height in
+ * TkBTreeAdjustPixelHeight.
+ */
+
+ TkTextFindDisplayLineEnd(textPtr, indexPtr, 0, NULL);
+ linePtr = indexPtr->linePtr;
+
+ /*
+ * Iterate through all display-lines corresponding to the single logical
+ * line 'linePtr' (and lines merged into this line due to eol elision),
+ * adding up the pixel height of each such display line as we go along.
+ * The final total is, therefore, the total height of all display lines
+ * made up by the logical line 'linePtr' and subsequent logical lines
+ * merged into this line.
+ */
+
+ displayLines = 0;
+ mergedLines = 0;
+
+ while (1) {
+ int bytes, height, logicalLines;
+
+ /*
+ * Currently this call doesn't have many side-effects. However, if in
+ * the future we change the code so there are side-effects (such as
+ * adjusting linePtr->pixelHeight), then the code might not quite work
+ * as intended, specifically the 'linePtr->pixelHeight == pixelHeight'
+ * test below this while loop.
+ */
+
+ height = CalculateDisplayLineHeight(textPtr, indexPtr, &bytes,
+ &logicalLines);
+
+ if (height > 0) {
+ pixelHeight += height;
+ displayLines++;
+ }
+
+ mergedLines += logicalLines;
+
+ if (TkTextIndexForwBytes(textPtr, indexPtr, bytes, indexPtr)) {
+ break;
+ }
+
+ if (mergedLines == 0) {
+ if (indexPtr->linePtr != linePtr) {
+ /*
+ * If we reached the end of the logical line, then either way
+ * we don't have a partial calculation.
+ */
+
+ partialCalc = 0;
+ break;
+ }
+ } else {
+ if (IsStartOfNotMergedLine(textPtr, indexPtr)) {
+ /*
+ * We've ended a logical line.
+ */
+
+ partialCalc = 0;
+ break;
+ }
+
+ /*
+ * We must still be on the same wrapped line, on a new logical
+ * line merged with the logical line 'linePtr'.
+ */
+ }
+ if (partialCalc && displayLines > 50 && mergedLines == 0) {
+ /*
+ * Only calculate 50 display lines at a time, to avoid huge
+ * delays. In any case it is very rare that a single line wraps 50
+ * times!
+ *
+ * If we have any merged lines, we must complete the full logical
+ * line layout here and now, because the partial-calculation code
+ * isn't designed to handle merged logical lines. Hence the
+ * 'mergedLines == 0' check.
+ */
+
+ break;
+ }
+ }
+
+ if (!partialCalc) {
+ int changed = 0;
+
+ /*
+ * Cancel any partial line height calculation state.
+ */
+
+ textPtr->dInfoPtr->metricEpoch = -1;
+
+ /*
+ * Mark the logical line as being up to date (caution: it isn't yet up
+ * to date, that will happen in TkBTreeAdjustPixelHeight just below).
+ */
+
+ TkBTreeLinePixelEpoch(textPtr, linePtr)
+ = textPtr->dInfoPtr->lineMetricUpdateEpoch;
+ if (TkBTreeLinePixelCount(textPtr, linePtr) != pixelHeight) {
+ changed = 1;
+ }
+
+ if (mergedLines > 0) {
+ int i = mergedLines;
+ TkTextLine *mergedLinePtr;
+
+ /*
+ * Loop over all merged logical lines, marking them up to date
+ * (again, the pixel count setting will actually happen in
+ * TkBTreeAdjustPixelHeight).
+ */
+
+ mergedLinePtr = linePtr;
+ while (i-- > 0) {
+ mergedLinePtr = TkBTreeNextLine(textPtr, mergedLinePtr);
+ TkBTreeLinePixelEpoch(textPtr, mergedLinePtr)
+ = textPtr->dInfoPtr->lineMetricUpdateEpoch;
+ if (TkBTreeLinePixelCount(textPtr, mergedLinePtr) != 0) {
+ changed = 1;
+ }
+ }
+ }
+
+ if (!changed) {
+ /*
+ * If there's nothing to change, then we can already return.
+ */
+
+ return displayLines;
+ }
+ }
+
+ /*
+ * We set the line's height, but the return value is now the height of the
+ * entire widget, which may be used just below for reporting/debugging
+ * purposes.
+ */
+
+ pixelHeight = TkBTreeAdjustPixelHeight(textPtr, linePtr, pixelHeight,
+ mergedLines);
+
+ if (tkTextDebug) {
+ char buffer[2 * TCL_INTEGER_SPACE + 1];
+
+ if (TkBTreeNextLine(textPtr, linePtr) == NULL) {
+ Tcl_Panic("Mustn't ever update line height of last artificial line");
+ }
+
+ sprintf(buffer, "%d %d", TkBTreeLinesTo(textPtr,linePtr), pixelHeight);
+ LOG("tk_textNumPixels", buffer);
+ }
+ if (textPtr->dInfoPtr->scrollbarTimer == NULL) {
+ textPtr->refCount++;
+ textPtr->dInfoPtr->scrollbarTimer = Tcl_CreateTimerHandler(200,
+ AsyncUpdateYScrollbar, textPtr);
+ }
+ return displayLines;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * DisplayText --
+ *
+ * This function is invoked as a when-idle handler to update the display.
+ * It only redisplays the parts of the text widget that are out of date.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Information is redrawn on the screen.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+DisplayText(
+ ClientData clientData) /* Information about widget. */
+{
+ register TkText *textPtr = clientData;
+ TextDInfo *dInfoPtr = textPtr->dInfoPtr;
+ register DLine *dlPtr;
+ DLine *prevPtr;
+ Pixmap pixmap;
+ int maxHeight, borders;
+ int bottomY = 0; /* Initialization needed only to stop compiler
+ * warnings. */
+ Tcl_Interp *interp;
+
+#ifdef MAC_OSX_TK
+ /*
+ * If drawing is disabled, all we need to do is
+ * clear the REDRAW_PENDING flag.
+ */
+ TkWindow *winPtr = (TkWindow *)(textPtr->tkwin);
+ MacDrawable *macWin = winPtr->privatePtr;
+ if (macWin && (macWin->flags & TK_DO_NOT_DRAW)){
+ dInfoPtr->flags &= ~REDRAW_PENDING;
+ return;
+ }
+#endif
+
+ if ((textPtr->tkwin == NULL) || (textPtr->flags & DESTROYED)) {
+ /*
+ * The widget has been deleted. Don't do anything.
+ */
+
+ return;
+ }
+
+ interp = textPtr->interp;
+ Tcl_Preserve(interp);
+
+ if (tkTextDebug) {
+ Tcl_SetVar2(interp, "tk_textRelayout", NULL, "", TCL_GLOBAL_ONLY);
+ }
+
+ if (!Tk_IsMapped(textPtr->tkwin) || (dInfoPtr->maxX <= dInfoPtr->x)
+ || (dInfoPtr->maxY <= dInfoPtr->y)) {
+ UpdateDisplayInfo(textPtr);
+ dInfoPtr->flags &= ~REDRAW_PENDING;
+ goto doScrollbars;
+ }
+ numRedisplays++;
+ if (tkTextDebug) {
+ Tcl_SetVar2(interp, "tk_textRedraw", NULL, "", TCL_GLOBAL_ONLY);
+ }
+
+ /*
+ * Choose a new current item if that is needed (this could cause event
+ * handlers to be invoked, hence the preserve/release calls and the loop,
+ * since the handlers could conceivably necessitate yet another current
+ * item calculation). The tkwin check is because the whole window could go
+ * away in the Tcl_Release call.
+ */
+
+ while (dInfoPtr->flags & REPICK_NEEDED) {
+ textPtr->refCount++;
+ dInfoPtr->flags &= ~REPICK_NEEDED;
+ TkTextPickCurrent(textPtr, &textPtr->pickEvent);
+ if (--textPtr->refCount == 0) {
+ ckfree(textPtr);
+ goto end;
+ }
+ if ((textPtr->tkwin == NULL) || (textPtr->flags & DESTROYED)) {
+ goto end;
+ }
+ }
+
+ /*
+ * First recompute what's supposed to be displayed.
+ */
+
+ UpdateDisplayInfo(textPtr);
+ dInfoPtr->dLinesInvalidated = 0;
+
+ /*
+ * See if it's possible to bring some parts of the screen up-to-date by
+ * scrolling (copying from other parts of the screen). We have to be
+ * particularly careful with the top and bottom lines of the display,
+ * since these may only be partially visible and therefore not helpful for
+ * some scrolling purposes.
+ */
+
+ for (dlPtr = dInfoPtr->dLinePtr; dlPtr != NULL; dlPtr = dlPtr->nextPtr) {
+ register DLine *dlPtr2;
+ int offset, height, y, oldY;
+ TkRegion damageRgn;
+
+ /*
+ * These tests are, in order:
+ *
+ * 1. If the line is already marked as invalid
+ * 2. If the line hasn't moved
+ * 3. If the line overlaps the bottom of the window and we are
+ * scrolling up.
+ * 4. If the line overlaps the top of the window and we are scrolling
+ * down.
+ *
+ * If any of these tests are true, then we can't scroll this line's
+ * part of the display.
+ *
+ * Note that even if tests 3 or 4 aren't true, we may be able to
+ * scroll the line, but we still need to be sure to call embedded
+ * window display procs on top and bottom lines if they have any
+ * portion non-visible (see below).
+ */
+
+ if ((dlPtr->flags & OLD_Y_INVALID)
+ || (dlPtr->y == dlPtr->oldY)
+ || (((dlPtr->oldY + dlPtr->height) > dInfoPtr->maxY)
+ && (dlPtr->y < dlPtr->oldY))
+ || ((dlPtr->oldY < dInfoPtr->y) && (dlPtr->y > dlPtr->oldY))) {
+ continue;
+ }
+
+ /*
+ * This line is already drawn somewhere in the window so it only needs
+ * to be copied to its new location. See if there's a group of lines
+ * that can all be copied together.
+ */
+
+ offset = dlPtr->y - dlPtr->oldY;
+ height = dlPtr->height;
+ y = dlPtr->y;
+ for (dlPtr2 = dlPtr->nextPtr; dlPtr2 != NULL;
+ dlPtr2 = dlPtr2->nextPtr) {
+ if ((dlPtr2->flags & OLD_Y_INVALID)
+ || ((dlPtr2->oldY + offset) != dlPtr2->y)
+ || ((dlPtr2->oldY + dlPtr2->height) > dInfoPtr->maxY)) {
+ break;
+ }
+ height += dlPtr2->height;
+ }
+
+ /*
+ * Reduce the height of the area being copied if necessary to avoid
+ * overwriting the border area.
+ */
+
+ if ((y + height) > dInfoPtr->maxY) {
+ height = dInfoPtr->maxY - y;
+ }
+ oldY = dlPtr->oldY;
+ if (y < dInfoPtr->y) {
+ /*
+ * Adjust if the area being copied is going to overwrite the top
+ * border of the window (so the top line is only half onscreen).
+ */
+
+ int y_off = dInfoPtr->y - dlPtr->y;
+ height -= y_off;
+ oldY += y_off;
+ y = dInfoPtr->y;
+ }
+
+ /*
+ * Update the lines we are going to scroll to show that they have been
+ * copied.
+ */
+
+ while (1) {
+ /*
+ * The DLine already has OLD_Y_INVALID cleared.
+ */
+
+ dlPtr->oldY = dlPtr->y;
+ if (dlPtr->nextPtr == dlPtr2) {
+ break;
+ }
+ dlPtr = dlPtr->nextPtr;
+ }
+
+ /*
+ * Scan through the lines following the copied ones to see if we are
+ * going to overwrite them with the copy operation. If so, mark them
+ * for redisplay.
+ */
+
+ for ( ; dlPtr2 != NULL; dlPtr2 = dlPtr2->nextPtr) {
+ if ((!(dlPtr2->flags & OLD_Y_INVALID))
+ && ((dlPtr2->oldY + dlPtr2->height) > y)
+ && (dlPtr2->oldY < (y + height))) {
+ dlPtr2->flags |= OLD_Y_INVALID;
+ }
+ }
+
+ /*
+ * Now scroll the lines. This may generate damage which we handle by
+ * calling TextInvalidateRegion to mark the display blocks as stale.
+ */
+
+ damageRgn = TkCreateRegion();
+ if (TkScrollWindow(textPtr->tkwin, dInfoPtr->scrollGC, dInfoPtr->x,
+ oldY, dInfoPtr->maxX-dInfoPtr->x, height, 0, y-oldY,
+ damageRgn)) {
+ TextInvalidateRegion(textPtr, damageRgn);
+
+ }
+ numCopies++;
+ TkDestroyRegion(damageRgn);
+ }
+
+ /*
+ * Clear the REDRAW_PENDING flag here. This is actually pretty tricky. We
+ * want to wait until *after* doing the scrolling, since that could
+ * generate more areas to redraw and don't want to reschedule a redisplay
+ * for them. On the other hand, we can't wait until after all the
+ * redisplaying, because the act of redisplaying could actually generate
+ * more redisplays (e.g. in the case of a nested window with event
+ * bindings triggered by redisplay).
+ */
+
+ dInfoPtr->flags &= ~REDRAW_PENDING;
+
+ /*
+ * Redraw the borders if that's needed.
+ */
+
+ if (dInfoPtr->flags & REDRAW_BORDERS) {
+ if (tkTextDebug) {
+ LOG("tk_textRedraw", "borders");
+ }
+
+ if (textPtr->tkwin == NULL) {
+ /*
+ * The widget has been deleted. Don't do anything.
+ */
+
+ goto end;
+ }
+
+ Tk_Draw3DRectangle(textPtr->tkwin, Tk_WindowId(textPtr->tkwin),
+ textPtr->border, textPtr->highlightWidth,
+ textPtr->highlightWidth,
+ Tk_Width(textPtr->tkwin) - 2*textPtr->highlightWidth,
+ Tk_Height(textPtr->tkwin) - 2*textPtr->highlightWidth,
+ textPtr->borderWidth, textPtr->relief);
+ if (textPtr->highlightWidth != 0) {
+ GC fgGC, bgGC;
+
+ bgGC = Tk_GCForColor(textPtr->highlightBgColorPtr,
+ Tk_WindowId(textPtr->tkwin));
+ if (textPtr->flags & GOT_FOCUS) {
+ fgGC = Tk_GCForColor(textPtr->highlightColorPtr,
+ Tk_WindowId(textPtr->tkwin));
+ TkpDrawHighlightBorder(textPtr->tkwin, fgGC, bgGC,
+ textPtr->highlightWidth, Tk_WindowId(textPtr->tkwin));
+ } else {
+ TkpDrawHighlightBorder(textPtr->tkwin, bgGC, bgGC,
+ textPtr->highlightWidth, Tk_WindowId(textPtr->tkwin));
+ }
+ }
+ borders = textPtr->borderWidth + textPtr->highlightWidth;
+ if (textPtr->padY > 0) {
+ Tk_Fill3DRectangle(textPtr->tkwin, Tk_WindowId(textPtr->tkwin),
+ textPtr->border, borders, borders,
+ Tk_Width(textPtr->tkwin) - 2*borders, textPtr->padY,
+ 0, TK_RELIEF_FLAT);
+ Tk_Fill3DRectangle(textPtr->tkwin, Tk_WindowId(textPtr->tkwin),
+ textPtr->border, borders,
+ Tk_Height(textPtr->tkwin) - borders - textPtr->padY,
+ Tk_Width(textPtr->tkwin) - 2*borders,
+ textPtr->padY, 0, TK_RELIEF_FLAT);
+ }
+ if (textPtr->padX > 0) {
+ Tk_Fill3DRectangle(textPtr->tkwin, Tk_WindowId(textPtr->tkwin),
+ textPtr->border, borders, borders + textPtr->padY,
+ textPtr->padX,
+ Tk_Height(textPtr->tkwin) - 2*borders -2*textPtr->padY,
+ 0, TK_RELIEF_FLAT);
+ Tk_Fill3DRectangle(textPtr->tkwin, Tk_WindowId(textPtr->tkwin),
+ textPtr->border,
+ Tk_Width(textPtr->tkwin) - borders - textPtr->padX,
+ borders + textPtr->padY, textPtr->padX,
+ Tk_Height(textPtr->tkwin) - 2*borders -2*textPtr->padY,
+ 0, TK_RELIEF_FLAT);
+ }
+ dInfoPtr->flags &= ~REDRAW_BORDERS;
+ }
+
+ /*
+ * Now we have to redraw the lines that couldn't be updated by scrolling.
+ * First, compute the height of the largest line and allocate an off-
+ * screen pixmap to use for double-buffered displays.
+ */
+
+ maxHeight = -1;
+ for (dlPtr = dInfoPtr->dLinePtr; dlPtr != NULL;
+ dlPtr = dlPtr->nextPtr) {
+ if ((dlPtr->height > maxHeight) &&
+ ((dlPtr->flags&OLD_Y_INVALID) || (dlPtr->oldY != dlPtr->y))) {
+ maxHeight = dlPtr->height;
+ }
+ bottomY = dlPtr->y + dlPtr->height;
+ }
+
+ /*
+ * There used to be a line here which restricted 'maxHeight' to be no
+ * larger than 'dInfoPtr->maxY', but this is incorrect for the case where
+ * individual lines may be taller than the widget _and_ we have smooth
+ * scrolling. What we can do is restrict maxHeight to be no larger than
+ * 'dInfoPtr->maxY + dInfoPtr->topPixelOffset'.
+ */
+
+ if (maxHeight > (dInfoPtr->maxY + dInfoPtr->topPixelOffset)) {
+ maxHeight = (dInfoPtr->maxY + dInfoPtr->topPixelOffset);
+ }
+
+ if (maxHeight > 0) {
+#ifndef TK_NO_DOUBLE_BUFFERING
+ pixmap = Tk_GetPixmap(Tk_Display(textPtr->tkwin),
+ Tk_WindowId(textPtr->tkwin), Tk_Width(textPtr->tkwin),
+ maxHeight, Tk_Depth(textPtr->tkwin));
+#else
+ pixmap = Tk_WindowId(textPtr->tkwin);
+#endif /* TK_NO_DOUBLE_BUFFERING */
+ 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->flags & OLD_Y_INVALID) || dlPtr->oldY != dlPtr->y) {
+ if (tkTextDebug) {
+ char string[TK_POS_CHARS];
+
+ TkTextPrintIndex(textPtr, &dlPtr->index, string);
+ LOG("tk_textRedraw", string);
+ }
+ DisplayDLine(textPtr, dlPtr, prevPtr, pixmap);
+ if (dInfoPtr->dLinesInvalidated) {
+#ifndef TK_NO_DOUBLE_BUFFERING
+ Tk_FreePixmap(Tk_Display(textPtr->tkwin), pixmap);
+#endif /* TK_NO_DOUBLE_BUFFERING */
+ return;
+ }
+ dlPtr->oldY = dlPtr->y;
+ dlPtr->flags &= ~(NEW_LAYOUT | OLD_Y_INVALID);
+ } else if (dlPtr->chunkPtr != NULL && ((dlPtr->y < 0)
+ || (dlPtr->y + dlPtr->height > dInfoPtr->maxY))) {
+ register TkTextDispChunk *chunkPtr;
+
+ /*
+ * It's the first or last DLine which are also overlapping the
+ * top or bottom of the window, but we decided above it wasn't
+ * necessary to display them (we were able to update them by
+ * scrolling). This is fine, except that if the lines contain
+ * any embedded windows, we must still call the display proc
+ * on them because they might need to be unmapped or they
+ * might need to be moved to reflect their new position.
+ * Otherwise, everything else moves, but the embedded window
+ * doesn't!
+ *
+ * So, we loop through all the chunks, calling the display
+ * proc of embedded windows only.
+ */
+
+ for (chunkPtr = dlPtr->chunkPtr; (chunkPtr != NULL);
+ chunkPtr = chunkPtr->nextPtr) {
+ int x;
+ if (chunkPtr->displayProc != TkTextEmbWinDisplayProc) {
+ continue;
+ }
+ x = chunkPtr->x + dInfoPtr->x - dInfoPtr->curXPixelOffset;
+ if ((x + chunkPtr->width <= 0) || (x >= dInfoPtr->maxX)) {
+ /*
+ * Note: we have to call the displayProc even for
+ * chunks that are off-screen. This is needed, for
+ * example, so that embedded windows can be unmapped
+ * in this case. Display the chunk at a coordinate
+ * that can be clearly identified by the displayProc
+ * as being off-screen to the left (the displayProc
+ * may not be able to tell if something is off to the
+ * right).
+ */
+
+ x = -chunkPtr->width;
+ }
+ TkTextEmbWinDisplayProc(textPtr, chunkPtr, x,
+ dlPtr->spaceAbove,
+ dlPtr->height-dlPtr->spaceAbove-dlPtr->spaceBelow,
+ dlPtr->baseline - dlPtr->spaceAbove, NULL,
+ (Drawable) None, dlPtr->y + dlPtr->spaceAbove);
+ }
+
+ }
+ }
+#ifndef TK_NO_DOUBLE_BUFFERING
+ Tk_FreePixmap(Tk_Display(textPtr->tkwin), pixmap);
+#endif /* TK_NO_DOUBLE_BUFFERING */
+ }
+
+ /*
+ * See if we need to refresh the part of the window below the last line of
+ * text (if there is any such area). Refresh the padding area on the left
+ * too, since the insertion cursor might have been displayed there
+ * previously).
+ */
+
+ if (dInfoPtr->topOfEof > dInfoPtr->maxY) {
+ dInfoPtr->topOfEof = dInfoPtr->maxY;
+ }
+ if (bottomY < dInfoPtr->topOfEof) {
+ if (tkTextDebug) {
+ LOG("tk_textRedraw", "eof");
+ }
+
+ if ((textPtr->tkwin == NULL) || (textPtr->flags & DESTROYED)) {
+ /*
+ * The widget has been deleted. Don't do anything.
+ */
+
+ goto end;
+ }
+
+ Tk_Fill3DRectangle(textPtr->tkwin, Tk_WindowId(textPtr->tkwin),
+ textPtr->border, dInfoPtr->x - textPtr->padX, bottomY,
+ dInfoPtr->maxX - (dInfoPtr->x - textPtr->padX),
+ dInfoPtr->topOfEof-bottomY, 0, TK_RELIEF_FLAT);
+ }
+ dInfoPtr->topOfEof = bottomY;
+
+ /*
+ * Update the vertical scrollbar, if there is one. Note: it's important to
+ * clear REDRAW_PENDING here, just in case the scroll function does
+ * something that requires redisplay.
+ */
+
+ doScrollbars:
+ if (textPtr->flags & UPDATE_SCROLLBARS) {
+ textPtr->flags &= ~UPDATE_SCROLLBARS;
+ if (textPtr->yScrollCmd != NULL) {
+ GetYView(textPtr->interp, textPtr, 1);
+ }
+
+ if ((textPtr->tkwin == NULL) || (textPtr->flags & DESTROYED)) {
+ /*
+ * The widget has been deleted. Don't do anything.
+ */
+
+ goto end;
+ }
+
+ /*
+ * Update the horizontal scrollbar, if any.
+ */
+
+ if (textPtr->xScrollCmd != NULL) {
+ GetXView(textPtr->interp, textPtr, 1);
+ }
+ }
+
+ end:
+ Tcl_Release(interp);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkTextEventuallyRepick --
+ *
+ * This function is invoked whenever something happens that could change
+ * the current character or the tags associated with it.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * A repick is scheduled as an idle handler.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TkTextEventuallyRepick(
+ TkText *textPtr) /* Widget record for text widget. */
+{
+ TextDInfo *dInfoPtr = textPtr->dInfoPtr;
+
+ dInfoPtr->flags |= REPICK_NEEDED;
+ if (!(dInfoPtr->flags & REDRAW_PENDING)) {
+ dInfoPtr->flags |= REDRAW_PENDING;
+ Tcl_DoWhenIdle(DisplayText, textPtr);
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkTextRedrawRegion --
+ *
+ * This function is invoked to schedule a redisplay for a given region of
+ * a text widget. The redisplay itself may not occur immediately: it's
+ * scheduled as a when-idle handler.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Information will eventually be redrawn on the screen.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TkTextRedrawRegion(
+ TkText *textPtr, /* Widget record for text widget. */
+ int x, int y, /* Coordinates of upper-left corner of area to
+ * be redrawn, in pixels relative to textPtr's
+ * window. */
+ int width, int height) /* Width and height of area to be redrawn. */
+{
+ TextDInfo *dInfoPtr = textPtr->dInfoPtr;
+ TkRegion damageRgn = TkCreateRegion();
+ XRectangle rect;
+
+ rect.x = x;
+ rect.y = y;
+ rect.width = width;
+ rect.height = height;
+ TkUnionRectWithRegion(&rect, damageRgn, damageRgn);
+
+ TextInvalidateRegion(textPtr, damageRgn);
+
+ if (!(dInfoPtr->flags & REDRAW_PENDING)) {
+ dInfoPtr->flags |= REDRAW_PENDING;
+ Tcl_DoWhenIdle(DisplayText, textPtr);
+ }
+ TkDestroyRegion(damageRgn);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TextInvalidateRegion --
+ *
+ * Mark a region of text as invalid.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Updates the display information for the text widget.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+TextInvalidateRegion(
+ TkText *textPtr, /* Widget record for text widget. */
+ TkRegion region) /* Region of area to redraw. */
+{
+ register DLine *dlPtr;
+ TextDInfo *dInfoPtr = textPtr->dInfoPtr;
+ int maxY, inset;
+ XRectangle rect;
+
+ /*
+ * Find all lines that overlap the given region and mark them for
+ * redisplay.
+ */
+
+ TkClipBox(region, &rect);
+ maxY = rect.y + rect.height;
+ for (dlPtr = dInfoPtr->dLinePtr; dlPtr != NULL;
+ dlPtr = dlPtr->nextPtr) {
+ if ((!(dlPtr->flags & OLD_Y_INVALID))
+ && (TkRectInRegion(region, rect.x, dlPtr->y,
+ rect.width, (unsigned int) dlPtr->height) != RectangleOut)) {
+ dlPtr->flags |= OLD_Y_INVALID;
+ }
+ }
+ if (dInfoPtr->topOfEof < maxY) {
+ dInfoPtr->topOfEof = maxY;
+ }
+
+ /*
+ * Schedule the redisplay operation if there isn't one already scheduled.
+ */
+
+ inset = textPtr->borderWidth + textPtr->highlightWidth;
+ if ((rect.x < (inset + textPtr->padX))
+ || (rect.y < (inset + textPtr->padY))
+ || ((int) (rect.x + rect.width) > (Tk_Width(textPtr->tkwin)
+ - inset - textPtr->padX))
+ || (maxY > (Tk_Height(textPtr->tkwin) - inset - textPtr->padY))) {
+ dInfoPtr->flags |= REDRAW_BORDERS;
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkTextChanged, TextChanged --
+ *
+ * This function is invoked when info in a text widget is about to be
+ * modified in a way that changes how it is displayed (e.g. characters
+ * were inserted or deleted, or tag information was changed). This
+ * function must be called *before* a change is made, so that indexes in
+ * the display information are still valid.
+ *
+ * Note: if the range of indices may change geometry as well as simply
+ * requiring redisplay, then the caller should also call
+ * TkTextInvalidateLineMetrics.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The range of character between index1Ptr (inclusive) and index2Ptr
+ * (exclusive) will be redisplayed at some point in the future (the
+ * actual redisplay is scheduled as a when-idle handler).
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TkTextChanged(
+ TkSharedText *sharedTextPtr,/* Shared widget section, or NULL. */
+ TkText *textPtr, /* Widget record for text widget, or NULL. */
+ const TkTextIndex*index1Ptr,/* Index of first character to redisplay. */
+ const TkTextIndex*index2Ptr)/* Index of character just after last one to
+ * redisplay. */
+{
+ if (sharedTextPtr == NULL) {
+ TextChanged(textPtr, index1Ptr, index2Ptr);
+ } else {
+ textPtr = sharedTextPtr->peers;
+ while (textPtr != NULL) {
+ TextChanged(textPtr, index1Ptr, index2Ptr);
+ textPtr = textPtr->next;
+ }
+ }
+}
+
+static void
+TextChanged(
+ TkText *textPtr, /* Widget record for text widget, or NULL. */
+ const TkTextIndex*index1Ptr,/* Index of first character to redisplay. */
+ const TkTextIndex*index2Ptr)/* Index of character just after last one to
+ * redisplay. */
+{
+ TextDInfo *dInfoPtr = textPtr->dInfoPtr;
+ DLine *firstPtr, *lastPtr;
+ TkTextIndex rounded;
+ TkTextLine *linePtr;
+ int notBegin;
+
+ /*
+ * Schedule both a redisplay and a recomputation of display information.
+ * It's done here rather than the end of the function for two reasons:
+ *
+ * 1. If there are no display lines to update we'll want to return
+ * immediately, well before the end of the function.
+ * 2. It's important to arrange for the redisplay BEFORE calling
+ * FreeDLines. The reason for this is subtle and has to do with
+ * embedded windows. The chunk delete function for an embedded window
+ * will schedule an idle handler to unmap the window. However, we want
+ * the idle handler for redisplay to be called first, so that it can
+ * put the embedded window back on the screen again (if appropriate).
+ * This will prevent the window from ever being unmapped, and thereby
+ * avoid flashing.
+ */
+
+ if (!(dInfoPtr->flags & REDRAW_PENDING)) {
+ Tcl_DoWhenIdle(DisplayText, textPtr);
+ }
+ dInfoPtr->flags |= REDRAW_PENDING|DINFO_OUT_OF_DATE|REPICK_NEEDED;
+
+ /*
+ * Find the DLines corresponding to index1Ptr and index2Ptr. There is one
+ * tricky thing here, which is that we have to relayout in units of whole
+ * text lines: This is necessary because the indices stored in the display
+ * lines will no longer be valid. It's also needed because any edit could
+ * change the way lines wrap.
+ * To relayout in units of whole text (logical) lines, round index1Ptr
+ * back to the beginning of its text line (or, if this line start is
+ * elided, to the beginning of the text line that starts the display line
+ * it is included in), and include all the display lines after index2Ptr,
+ * up to the end of its text line (or, if this line end is elided, up to
+ * the end of the first non elided text line after this line end).
+ */
+
+ rounded = *index1Ptr;
+ rounded.byteIndex = 0;
+ notBegin = 0;
+ while (!IsStartOfNotMergedLine(textPtr, &rounded) && notBegin) {
+ notBegin = !TkTextIndexBackBytes(textPtr, &rounded, 1, &rounded);
+ rounded.byteIndex = 0;
+ }
+
+ /*
+ * 'rounded' now points to the start of a display line as well as the
+ * real (non elided) start of a logical line, and this index is the
+ * closest before index1Ptr.
+ */
+
+ firstPtr = FindDLine(textPtr, dInfoPtr->dLinePtr, &rounded);
+
+ if (firstPtr == NULL) {
+ /*
+ * index1Ptr pertains to no display line, i.e this index is after
+ * the last display line. Since index2Ptr is after index1Ptr, there
+ * is no display line to free/redisplay and we can return early.
+ */
+
+ return;
+ }
+
+ rounded = *index2Ptr;
+ linePtr = index2Ptr->linePtr;
+ do {
+ linePtr = TkBTreeNextLine(textPtr, linePtr);
+ if (linePtr == NULL) {
+ break;
+ }
+ rounded.linePtr = linePtr;
+ rounded.byteIndex = 0;
+ } while (!IsStartOfNotMergedLine(textPtr, &rounded));
+
+ if (linePtr == NULL) {
+ lastPtr = NULL;
+ } else {
+ /*
+ * 'rounded' now points to the start of a display line as well as the
+ * start of a logical line not merged with its previous line, and
+ * this index is the closest after index2Ptr.
+ */
+
+ lastPtr = FindDLine(textPtr, dInfoPtr->dLinePtr, &rounded);
+
+ /*
+ * At least one display line is supposed to change. This makes the
+ * redisplay OK in case the display line we expect to get here was
+ * unlinked by a previous call to TkTextChanged and the text widget
+ * did not update before reaching this point. This happens for
+ * instance when moving the cursor up one line.
+ * Note that lastPtr != NULL here, otherwise we would have returned
+ * earlier when we tested for firstPtr being NULL.
+ */
+
+ if (lastPtr == firstPtr) {
+ lastPtr = lastPtr->nextPtr;
+ }
+ }
+
+ /*
+ * Delete all the DLines from firstPtr up to but not including lastPtr.
+ */
+
+ FreeDLines(textPtr, firstPtr, lastPtr, DLINE_UNLINK);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkTextRedrawTag, TextRedrawTag --
+ *
+ * This function is invoked to request a redraw of all characters in a
+ * given range that have a particular tag on or off. It's called, for
+ * example, when tag options change.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Information on the screen may be redrawn, and the layout of the screen
+ * may change.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TkTextRedrawTag(
+ TkSharedText *sharedTextPtr,/* Shared widget section, or NULL. */
+ TkText *textPtr, /* Widget record for text widget. */
+ TkTextIndex *index1Ptr, /* First character in range to consider for
+ * redisplay. NULL means start at beginning of
+ * text. */
+ TkTextIndex *index2Ptr, /* Character just after last one to consider
+ * for redisplay. NULL means process all the
+ * characters in the text. */
+ TkTextTag *tagPtr, /* Information about tag. */
+ int withTag) /* 1 means redraw characters that have the
+ * tag, 0 means redraw those without. */
+{
+ if (sharedTextPtr == NULL) {
+ TextRedrawTag(textPtr, index1Ptr, index2Ptr, tagPtr, withTag);
+ } else {
+ textPtr = sharedTextPtr->peers;
+ while (textPtr != NULL) {
+ TextRedrawTag(textPtr, index1Ptr, index2Ptr, tagPtr, withTag);
+ textPtr = textPtr->next;
+ }
+ }
+}
+
+static void
+TextRedrawTag(
+ TkText *textPtr, /* Widget record for text widget. */
+ TkTextIndex *index1Ptr, /* First character in range to consider for
+ * redisplay. NULL means start at beginning of
+ * text. */
+ TkTextIndex *index2Ptr, /* Character just after last one to consider
+ * for redisplay. NULL means process all the
+ * characters in the text. */
+ TkTextTag *tagPtr, /* Information about tag. */
+ int withTag) /* 1 means redraw characters that have the
+ * tag, 0 means redraw those without. */
+{
+ register DLine *dlPtr;
+ DLine *endPtr;
+ int tagOn;
+ TkTextSearch search;
+ TextDInfo *dInfoPtr = textPtr->dInfoPtr;
+ TkTextIndex *curIndexPtr;
+ TkTextIndex endOfText, *endIndexPtr;
+
+ /*
+ * Invalidate the pixel calculation of all lines in the given range. This
+ * may be a bit over-aggressive, so we could consider more subtle
+ * techniques here in the future. In particular, when we create a tag for
+ * the first time with '.t tag configure foo -font "Arial 20"', say, even
+ * though that obviously can't apply to anything at all (the tag didn't
+ * exist a moment ago), we invalidate every single line in the widget.
+ */
+
+ if (tagPtr->affectsDisplayGeometry) {
+ TkTextLine *startLine, *endLine;
+ int lineCount;
+
+ if (index2Ptr == NULL) {
+ endLine = NULL;
+ lineCount = TkBTreeNumLines(textPtr->sharedTextPtr->tree, textPtr);
+ } else {
+ endLine = index2Ptr->linePtr;
+ lineCount = TkBTreeLinesTo(textPtr, endLine);
+ }
+ if (index1Ptr == NULL) {
+ startLine = NULL;
+ } else {
+ startLine = index1Ptr->linePtr;
+ lineCount -= TkBTreeLinesTo(textPtr, startLine);
+ }
+ TkTextInvalidateLineMetrics(NULL, textPtr, startLine, lineCount,
+ TK_TEXT_INVALIDATE_ONLY);
+ }
+
+ /*
+ * Round up the starting position if it's before the first line visible on
+ * the screen (we only care about what's on the screen).
+ */
+
+ dlPtr = dInfoPtr->dLinePtr;
+ if (dlPtr == NULL) {
+ return;
+ }
+ if ((index1Ptr == NULL) || (TkTextIndexCmp(&dlPtr->index, index1Ptr)>0)) {
+ index1Ptr = &dlPtr->index;
+ }
+
+ /*
+ * Set the stopping position if it wasn't specified.
+ */
+
+ if (index2Ptr == NULL) {
+ int lastLine = TkBTreeNumLines(textPtr->sharedTextPtr->tree, textPtr);
+
+ index2Ptr = TkTextMakeByteIndex(textPtr->sharedTextPtr->tree, textPtr,
+ lastLine, 0, &endOfText);
+ }
+
+ /*
+ * Initialize a search through all transitions on the tag, starting with
+ * the first transition where the tag's current state is different from
+ * what it will eventually be.
+ */
+
+ TkBTreeStartSearch(index1Ptr, index2Ptr, tagPtr, &search);
+
+ /*
+ * Make our own curIndex because at this point search.curIndex may not
+ * equal index1Ptr->curIndex in the case the first tag toggle comes after
+ * index1Ptr (See the use of FindTagStart in TkBTreeStartSearch).
+ */
+
+ curIndexPtr = index1Ptr;
+ tagOn = TkBTreeCharTagged(index1Ptr, tagPtr);
+ if (tagOn != withTag) {
+ if (!TkBTreeNextTag(&search)) {
+ return;
+ }
+ curIndexPtr = &search.curIndex;
+ }
+
+ /*
+ * Schedule a redisplay and layout recalculation if they aren't already
+ * pending. This has to be done before calling FreeDLines, for the reason
+ * given in TkTextChanged.
+ */
+
+ if (!(dInfoPtr->flags & REDRAW_PENDING)) {
+ Tcl_DoWhenIdle(DisplayText, textPtr);
+ }
+ dInfoPtr->flags |= REDRAW_PENDING|DINFO_OUT_OF_DATE|REPICK_NEEDED;
+
+ /*
+ * Each loop through the loop below is for one range of characters where
+ * the tag's current state is different than its eventual state. At the
+ * top of the loop, search contains information about the first character
+ * in the range.
+ */
+
+ while (1) {
+ /*
+ * Find the first DLine structure in the range. Note: if the desired
+ * character isn't the first in its text line, then look for the
+ * character just before it instead. This is needed to handle the case
+ * where the first character of a wrapped display line just got
+ * smaller, so that it now fits on the line before: need to relayout
+ * the line containing the previous character.
+ */
+
+ if (IsStartOfNotMergedLine(textPtr, curIndexPtr)) {
+ dlPtr = FindDLine(textPtr, dlPtr, curIndexPtr);
+ } else {
+ TkTextIndex tmp = *curIndexPtr;
+
+ TkTextIndexBackBytes(textPtr, &tmp, 1, &tmp);
+ dlPtr = FindDLine(textPtr, dlPtr, &tmp);
+ }
+ if (dlPtr == NULL) {
+ break;
+ }
+
+ /*
+ * Find the first DLine structure that's past the end of the range.
+ */
+
+ if (!TkBTreeNextTag(&search)) {
+ endIndexPtr = index2Ptr;
+ } else {
+ curIndexPtr = &search.curIndex;
+ endIndexPtr = curIndexPtr;
+ }
+ endPtr = FindDLine(textPtr, dlPtr, endIndexPtr);
+ if ((endPtr != NULL)
+ && (TkTextIndexCmp(&endPtr->index,endIndexPtr) < 0)) {
+ endPtr = endPtr->nextPtr;
+ }
+
+ /*
+ * Delete all of the display lines in the range, so that they'll be
+ * re-layed out and redrawn.
+ */
+
+ FreeDLines(textPtr, dlPtr, endPtr, DLINE_UNLINK);
+ dlPtr = endPtr;
+
+ /*
+ * Find the first text line in the next range.
+ */
+
+ if (!TkBTreeNextTag(&search)) {
+ break;
+ }
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkTextRelayoutWindow --
+ *
+ * This function is called when something has happened that invalidates
+ * the whole layout of characters on the screen, such as a change in a
+ * configuration option for the overall text widget or a change in the
+ * window size. It causes all display information to be recomputed and
+ * the window to be redrawn.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * All the display information will be recomputed for the window and the
+ * window will be redrawn.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TkTextRelayoutWindow(
+ TkText *textPtr, /* Widget record for text widget. */
+ int mask) /* OR'd collection of bits showing what has
+ * changed. */
+{
+ TextDInfo *dInfoPtr = textPtr->dInfoPtr;
+ GC newGC;
+ XGCValues gcValues;
+
+ /*
+ * Schedule the window redisplay. See TkTextChanged for the reason why
+ * this has to be done before any calls to FreeDLines.
+ */
+
+ if (!(dInfoPtr->flags & REDRAW_PENDING)) {
+ Tcl_DoWhenIdle(DisplayText, textPtr);
+ }
+ dInfoPtr->flags |= REDRAW_PENDING|REDRAW_BORDERS|DINFO_OUT_OF_DATE
+ |REPICK_NEEDED;
+
+ /*
+ * (Re-)create the graphics context for drawing the traversal highlight.
+ */
+
+ gcValues.graphics_exposures = False;
+ newGC = Tk_GetGC(textPtr->tkwin, GCGraphicsExposures, &gcValues);
+ if (dInfoPtr->copyGC != None) {
+ Tk_FreeGC(textPtr->display, dInfoPtr->copyGC);
+ }
+ dInfoPtr->copyGC = newGC;
+
+ /*
+ * Throw away all the current layout information.
+ */
+
+ FreeDLines(textPtr, dInfoPtr->dLinePtr, NULL, DLINE_UNLINK);
+ dInfoPtr->dLinePtr = NULL;
+
+ /*
+ * Recompute some overall things for the layout. Even if the window gets
+ * very small, pretend that there's at least one pixel of drawing space in
+ * it.
+ */
+
+ if (textPtr->highlightWidth < 0) {
+ textPtr->highlightWidth = 0;
+ }
+ dInfoPtr->x = textPtr->highlightWidth + textPtr->borderWidth
+ + textPtr->padX;
+ dInfoPtr->y = textPtr->highlightWidth + textPtr->borderWidth
+ + textPtr->padY;
+ dInfoPtr->maxX = Tk_Width(textPtr->tkwin) - textPtr->highlightWidth
+ - textPtr->borderWidth - textPtr->padX;
+ if (dInfoPtr->maxX <= dInfoPtr->x) {
+ dInfoPtr->maxX = dInfoPtr->x + 1;
+ }
+
+ /*
+ * This is the only place where dInfoPtr->maxY is set.
+ */
+
+ dInfoPtr->maxY = Tk_Height(textPtr->tkwin) - textPtr->highlightWidth
+ - textPtr->borderWidth - textPtr->padY;
+ if (dInfoPtr->maxY <= dInfoPtr->y) {
+ dInfoPtr->maxY = dInfoPtr->y + 1;
+ }
+ dInfoPtr->topOfEof = dInfoPtr->maxY;
+
+ /*
+ * If the upper-left character isn't the first in a line, recompute it.
+ * This is necessary because a change in the window's size or options
+ * could change the way lines wrap.
+ */
+
+ if (!IsStartOfNotMergedLine(textPtr, &textPtr->topIndex)) {
+ TkTextFindDisplayLineEnd(textPtr, &textPtr->topIndex, 0, NULL);
+ }
+
+ /*
+ * Invalidate cached scrollbar positions, so that scrollbars sliders will
+ * be udpated.
+ */
+
+ dInfoPtr->xScrollFirst = dInfoPtr->xScrollLast = -1;
+ dInfoPtr->yScrollFirst = dInfoPtr->yScrollLast = -1;
+
+ if (mask & TK_TEXT_LINE_GEOMETRY) {
+ /*
+ * Set up line metric recalculation.
+ *
+ * Avoid the special zero value, since that is used to mark individual
+ * lines as being out of date.
+ */
+
+ if ((++dInfoPtr->lineMetricUpdateEpoch) == 0) {
+ dInfoPtr->lineMetricUpdateEpoch++;
+ }
+
+ dInfoPtr->currentMetricUpdateLine = -1;
+
+ /*
+ * Also cancel any partial line-height calculations (for long-wrapped
+ * lines) in progress.
+ */
+
+ dInfoPtr->metricEpoch = -1;
+
+ if (dInfoPtr->lineUpdateTimer == NULL) {
+ textPtr->refCount++;
+ dInfoPtr->lineUpdateTimer = Tcl_CreateTimerHandler(1,
+ AsyncUpdateLineMetrics, textPtr);
+ GenerateWidgetViewSyncEvent(textPtr, 0);
+ }
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkTextSetYView --
+ *
+ * This function is called to specify what lines are to be displayed in a
+ * text widget.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The display will (eventually) be updated so that the position given by
+ * "indexPtr" is visible on the screen at the position determined by
+ * "pickPlace".
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TkTextSetYView(
+ TkText *textPtr, /* Widget record for text widget. */
+ TkTextIndex *indexPtr, /* Position that is to appear somewhere in the
+ * view. */
+ int pickPlace) /* 0 means the given index must appear exactly
+ * at the top of the screen. TK_TEXT_PICKPLACE
+ * (-1) means we get to pick where it appears:
+ * minimize screen motion or else display line
+ * at center of screen. TK_TEXT_NOPIXELADJUST
+ * (-2) indicates to make the given index the
+ * top line, but if it is already the top
+ * line, don't nudge it up or down by a few
+ * pixels just to make sure it is entirely
+ * displayed. Positive numbers indicate the
+ * number of pixels of the index's line which
+ * are to be off the top of the screen. */
+{
+ TextDInfo *dInfoPtr = textPtr->dInfoPtr;
+ register DLine *dlPtr;
+ int bottomY, close, lineIndex;
+ TkTextIndex tmpIndex, rounded;
+ int lineHeight;
+
+ /*
+ * If the specified position is the extra line at the end of the text,
+ * round it back to the last real line.
+ */
+
+ lineIndex = TkBTreeLinesTo(textPtr, indexPtr->linePtr);
+ if (lineIndex == TkBTreeNumLines(indexPtr->tree, textPtr)) {
+ TkTextIndexBackChars(textPtr, indexPtr, 1, &rounded, COUNT_INDICES);
+ indexPtr = &rounded;
+ }
+
+ if (pickPlace == TK_TEXT_NOPIXELADJUST) {
+ if (textPtr->topIndex.linePtr == indexPtr->linePtr
+ && textPtr->topIndex.byteIndex == indexPtr->byteIndex) {
+ pickPlace = dInfoPtr->topPixelOffset;
+ } else {
+ pickPlace = 0;
+ }
+ }
+
+ if (pickPlace != TK_TEXT_PICKPLACE) {
+ /*
+ * The specified position must go at the top of the screen. Just leave
+ * all the DLine's alone: we may be able to reuse some of the
+ * information that's currently on the screen without redisplaying it
+ * all.
+ */
+
+ textPtr->topIndex = *indexPtr;
+ if (!IsStartOfNotMergedLine(textPtr, indexPtr)) {
+ TkTextFindDisplayLineEnd(textPtr, &textPtr->topIndex, 0, NULL);
+ }
+ dInfoPtr->newTopPixelOffset = pickPlace;
+ goto scheduleUpdate;
+ }
+
+ /*
+ * We have to pick where to display the index. First, bring the display
+ * information up to date and see if the index will be completely visible
+ * in the current screen configuration. If so then there's nothing to do.
+ */
+
+ if (dInfoPtr->flags & DINFO_OUT_OF_DATE) {
+ UpdateDisplayInfo(textPtr);
+ }
+ dlPtr = FindDLine(textPtr, dInfoPtr->dLinePtr, indexPtr);
+ if (dlPtr != NULL) {
+ if ((dlPtr->y + dlPtr->height) > dInfoPtr->maxY) {
+ /*
+ * Part of the line hangs off the bottom of the screen; pretend
+ * the whole line is off-screen.
+ */
+
+ dlPtr = NULL;
+ } else {
+ if (TkTextIndexCmp(&dlPtr->index, indexPtr) <= 0) {
+ if (dInfoPtr->dLinePtr == dlPtr && dInfoPtr->topPixelOffset != 0) {
+ /*
+ * It is on the top line, but that line is hanging off the top
+ * of the screen. Change the top overlap to zero and update.
+ */
+
+ dInfoPtr->newTopPixelOffset = 0;
+ goto scheduleUpdate;
+ }
+ /*
+ * The line is already on screen, with no need to scroll.
+ */
+ return;
+ }
+ }
+ }
+
+ /*
+ * The desired line isn't already on-screen. Figure out what it means to
+ * be "close" to the top or bottom of the screen. Close means within 1/3
+ * of the screen height or within three lines, whichever is greater.
+ *
+ * If the line is not close, place it in the center of the window.
+ */
+
+ tmpIndex = *indexPtr;
+ TkTextFindDisplayLineEnd(textPtr, &tmpIndex, 0, NULL);
+ lineHeight = CalculateDisplayLineHeight(textPtr, &tmpIndex, NULL, NULL);
+
+ /*
+ * It would be better if 'bottomY' were calculated using the actual height
+ * of the given line, not 'textPtr->charHeight'.
+ */
+
+ bottomY = (dInfoPtr->y + dInfoPtr->maxY + lineHeight)/2;
+ close = (dInfoPtr->maxY - dInfoPtr->y)/3;
+ if (close < 3*textPtr->charHeight) {
+ close = 3*textPtr->charHeight;
+ }
+ if (dlPtr != NULL) {
+ int overlap;
+
+ /*
+ * The desired line is above the top of screen. If it is "close" to
+ * the top of the window then make it the top line on the screen.
+ * MeasureUp counts from the bottom of the given index upwards, so we
+ * add an extra half line to be sure we count far enough.
+ */
+
+ MeasureUp(textPtr, &textPtr->topIndex, close + textPtr->charHeight/2,
+ &tmpIndex, &overlap);
+ if (TkTextIndexCmp(&tmpIndex, indexPtr) <= 0) {
+ textPtr->topIndex = *indexPtr;
+ TkTextFindDisplayLineEnd(textPtr, &textPtr->topIndex, 0, NULL);
+ dInfoPtr->newTopPixelOffset = 0;
+ goto scheduleUpdate;
+ }
+ } else {
+ int overlap;
+
+ /*
+ * The desired line is below the bottom of the screen. If it is
+ * "close" to the bottom of the screen then position it at the bottom
+ * of the screen.
+ */
+
+ MeasureUp(textPtr, indexPtr, close + lineHeight
+ - textPtr->charHeight/2, &tmpIndex, &overlap);
+ if (FindDLine(textPtr, dInfoPtr->dLinePtr, &tmpIndex) != NULL) {
+ bottomY = dInfoPtr->maxY - dInfoPtr->y;
+ }
+ }
+
+ /*
+ * If the window height is smaller than the line height, prefer to make
+ * the top of the line visible.
+ */
+
+ if (dInfoPtr->maxY - dInfoPtr->y < lineHeight) {
+ bottomY = lineHeight;
+ }
+
+ /*
+ * Our job now is to arrange the display so that indexPtr appears as low
+ * on the screen as possible but with its bottom no lower than bottomY.
+ * BottomY is the bottom of the window if the desired line is just below
+ * the current screen, otherwise it is a half-line lower than the center
+ * of the window.
+ */
+
+ MeasureUp(textPtr, indexPtr, bottomY, &textPtr->topIndex,
+ &dInfoPtr->newTopPixelOffset);
+
+ scheduleUpdate:
+ if (!(dInfoPtr->flags & REDRAW_PENDING)) {
+ Tcl_DoWhenIdle(DisplayText, textPtr);
+ }
+ dInfoPtr->flags |= REDRAW_PENDING|DINFO_OUT_OF_DATE|REPICK_NEEDED;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * TkTextMeasureDown --
+ *
+ * Given one index, find the index of the first character on the highest
+ * display line that would be displayed no more than "distance" pixels
+ * below the top of the given index.
+ *
+ * Results:
+ * The srcPtr is manipulated in place to reflect the new position. We
+ * return the number of pixels by which 'distance' overlaps the srcPtr.
+ *
+ * Side effects:
+ * None.
+ *
+ *--------------------------------------------------------------
+ */
+
+int
+TkTextMeasureDown(
+ TkText *textPtr, /* Text widget in which to measure. */
+ TkTextIndex *srcPtr, /* Index of character from which to start
+ * measuring. */
+ int distance) /* Vertical distance in pixels measured from
+ * the top pixel in srcPtr's logical line. */
+{
+ TkTextLine *lastLinePtr;
+ DLine *dlPtr;
+ TkTextIndex loop;
+
+ lastLinePtr = TkBTreeFindLine(textPtr->sharedTextPtr->tree, textPtr,
+ TkBTreeNumLines(textPtr->sharedTextPtr->tree, textPtr));
+
+ do {
+ dlPtr = LayoutDLine(textPtr, srcPtr);
+ dlPtr->nextPtr = NULL;
+
+ if (distance < dlPtr->height) {
+ FreeDLines(textPtr, dlPtr, NULL, DLINE_FREE_TEMP);
+ break;
+ }
+ distance -= dlPtr->height;
+ TkTextIndexForwBytes(textPtr, srcPtr, dlPtr->byteCount, &loop);
+ FreeDLines(textPtr, dlPtr, NULL, DLINE_FREE_TEMP);
+ if (loop.linePtr == lastLinePtr) {
+ break;
+ }
+ *srcPtr = loop;
+ } while (distance > 0);
+
+ return distance;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * MeasureUp --
+ *
+ * Given one index, find the index of the first character on the highest
+ * display line that would be displayed no more than "distance" pixels
+ * above the given index.
+ *
+ * If this function is called with distance=0, it simply finds the first
+ * index on the same display line as srcPtr. However, there is a another
+ * function TkTextFindDisplayLineEnd designed just for that task which is
+ * probably better to use.
+ *
+ * Results:
+ * *dstPtr is filled in with the index of the first character on a
+ * display line. The display line is found by measuring up "distance"
+ * pixels above the pixel just below an imaginary display line that
+ * contains srcPtr. If the display line that covers this coordinate
+ * actually extends above the coordinate, then return any excess pixels
+ * in *overlap, if that is non-NULL.
+ *
+ * Side effects:
+ * None.
+ *
+ *--------------------------------------------------------------
+ */
+
+static void
+MeasureUp(
+ TkText *textPtr, /* Text widget in which to measure. */
+ const TkTextIndex *srcPtr, /* Index of character from which to start
+ * measuring. */
+ int distance, /* Vertical distance in pixels measured from
+ * the pixel just below the lowest one in
+ * srcPtr's line. */
+ TkTextIndex *dstPtr, /* Index to fill in with result. */
+ int *overlap) /* Used to store how much of the final index
+ * returned was not covered by 'distance'. */
+{
+ int lineNum; /* Number of current line. */
+ int bytesToCount; /* Maximum number of bytes to measure in
+ * current line. */
+ TkTextIndex index;
+ DLine *dlPtr, *lowestPtr;
+
+ bytesToCount = srcPtr->byteIndex + 1;
+ index.tree = srcPtr->tree;
+ for (lineNum = TkBTreeLinesTo(textPtr, srcPtr->linePtr); lineNum >= 0;
+ lineNum--) {
+ /*
+ * Layout an entire text line (potentially > 1 display line).
+ *
+ * For the first line, which contains srcPtr, only layout the part up
+ * through srcPtr (bytesToCount is non-infinite to accomplish this).
+ * Make a list of all the display lines in backwards order (the lowest
+ * DLine on the screen is first in the list).
+ */
+
+ index.linePtr = TkBTreeFindLine(srcPtr->tree, textPtr, lineNum);
+ index.byteIndex = 0;
+ TkTextFindDisplayLineEnd(textPtr, &index, 0, NULL);
+ lineNum = TkBTreeLinesTo(textPtr, index.linePtr);
+ lowestPtr = NULL;
+ do {
+ dlPtr = LayoutDLine(textPtr, &index);
+ dlPtr->nextPtr = lowestPtr;
+ lowestPtr = dlPtr;
+ TkTextIndexForwBytes(textPtr, &index, dlPtr->byteCount, &index);
+ bytesToCount -= dlPtr->byteCount;
+ } while (bytesToCount>0 && index.linePtr==dlPtr->index.linePtr);
+
+ /*
+ * Scan through the display lines to see if we've covered enough
+ * vertical distance. If so, save the starting index for the line at
+ * the desired location. If distance was zero to start with then we
+ * simply get the first index on the same display line as the original
+ * index.
+ */
+
+ for (dlPtr = lowestPtr; dlPtr != NULL; dlPtr = dlPtr->nextPtr) {
+ distance -= dlPtr->height;
+ if (distance <= 0) {
+ *dstPtr = dlPtr->index;
+
+ /*
+ * dstPtr is the start of a display line that is or is not
+ * the start of a logical line. If it is the start of a
+ * logical line, we must check whether this line is merged
+ * with the previous logical line, and if so we must adjust
+ * dstPtr to the start of the display line since a display
+ * line start needs to be returned.
+ */
+ if (!IsStartOfNotMergedLine(textPtr, dstPtr)) {
+ TkTextFindDisplayLineEnd(textPtr, dstPtr, 0, NULL);
+ }
+
+ if (overlap != NULL) {
+ *overlap = -distance;
+ }
+ break;
+ }
+ }
+
+ /*
+ * Discard the display lines, then either return or prepare for the
+ * next display line to lay out.
+ */
+
+ FreeDLines(textPtr, lowestPtr, NULL, DLINE_FREE);
+ if (distance <= 0) {
+ return;
+ }
+ bytesToCount = INT_MAX; /* Consider all chars. in next line. */
+ }
+
+ /*
+ * Ran off the beginning of the text. Return the first character in the
+ * text.
+ */
+
+ TkTextMakeByteIndex(textPtr->sharedTextPtr->tree, textPtr, 0, 0, dstPtr);
+ if (overlap != NULL) {
+ *overlap = 0;
+ }
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * TkTextSeeCmd --
+ *
+ * This function is invoked to process the "see" option for the widget
+ * command for text widgets. See the user documentation for details on
+ * what it does.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * See the user documentation.
+ *
+ *--------------------------------------------------------------
+ */
+
+int
+TkTextSeeCmd(
+ TkText *textPtr, /* Information about text widget. */
+ Tcl_Interp *interp, /* Current interpreter. */
+ int objc, /* Number of arguments. */
+ Tcl_Obj *const objv[]) /* Argument objects. Someone else has already
+ * parsed this command enough to know that
+ * objv[1] is "see". */
+{
+ TextDInfo *dInfoPtr = textPtr->dInfoPtr;
+ TkTextIndex index;
+ int x, y, width, height, lineWidth, byteCount, oneThird, delta;
+ DLine *dlPtr;
+ TkTextDispChunk *chunkPtr;
+
+ if (objc != 3) {
+ Tcl_WrongNumArgs(interp, 2, objv, "index");
+ return TCL_ERROR;
+ }
+ if (TkTextGetObjIndex(interp, textPtr, objv[2], &index) != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ /*
+ * If the specified position is the extra line at the end of the text,
+ * round it back to the last real line.
+ */
+
+ if (TkBTreeLinesTo(textPtr, index.linePtr)
+ == TkBTreeNumLines(index.tree, textPtr)) {
+ TkTextIndexBackChars(textPtr, &index, 1, &index, COUNT_INDICES);
+ }
+
+ /*
+ * First get the desired position into the vertical range of the window.
+ */
+
+ TkTextSetYView(textPtr, &index, TK_TEXT_PICKPLACE);
+
+ /*
+ * Now make sure that the character is in view horizontally.
+ */
+
+ if (dInfoPtr->flags & DINFO_OUT_OF_DATE) {
+ UpdateDisplayInfo(textPtr);
+ }
+ lineWidth = dInfoPtr->maxX - dInfoPtr->x;
+ if (dInfoPtr->maxLength < lineWidth) {
+ return TCL_OK;
+ }
+
+ /*
+ * Find the display line containing the desired index. dlPtr may be NULL
+ * if the widget is not mapped. [Bug #641778]
+ */
+
+ dlPtr = FindDLine(textPtr, dInfoPtr->dLinePtr, &index);
+ if (dlPtr == NULL) {
+ return TCL_OK;
+ }
+
+ /*
+ * Find the chunk within the display line that contains the desired
+ * index. The chunks making the display line are skipped up to but not
+ * including the one crossing index. Skipping is done based on a
+ * byteCount offset possibly spanning several logical lines in case
+ * they are elided.
+ */
+
+ byteCount = TkTextIndexCountBytes(textPtr, &dlPtr->index, &index);
+ for (chunkPtr = dlPtr->chunkPtr; chunkPtr != NULL ;
+ chunkPtr = chunkPtr->nextPtr) {
+ if (byteCount < chunkPtr->numBytes) {
+ break;
+ }
+ byteCount -= chunkPtr->numBytes;
+ }
+
+ /*
+ * Call a chunk-specific function to find the horizontal range of the
+ * character within the chunk. chunkPtr is NULL if trying to see in elided
+ * region.
+ */
+
+ if (chunkPtr != NULL) {
+ chunkPtr->bboxProc(textPtr, chunkPtr, byteCount,
+ dlPtr->y + dlPtr->spaceAbove,
+ dlPtr->height - dlPtr->spaceAbove - dlPtr->spaceBelow,
+ dlPtr->baseline - dlPtr->spaceAbove, &x, &y, &width,
+ &height);
+ delta = x - dInfoPtr->curXPixelOffset;
+ oneThird = lineWidth/3;
+ if (delta < 0) {
+ if (delta < -oneThird) {
+ dInfoPtr->newXPixelOffset = x - lineWidth/2;
+ } else {
+ dInfoPtr->newXPixelOffset += delta;
+ }
+ } else {
+ delta -= lineWidth - width;
+ if (delta <= 0) {
+ return TCL_OK;
+ }
+ if (delta > oneThird) {
+ dInfoPtr->newXPixelOffset = x - lineWidth/2;
+ } else {
+ dInfoPtr->newXPixelOffset += delta;
+ }
+ }
+ }
+ dInfoPtr->flags |= DINFO_OUT_OF_DATE;
+ if (!(dInfoPtr->flags & REDRAW_PENDING)) {
+ dInfoPtr->flags |= REDRAW_PENDING;
+ Tcl_DoWhenIdle(DisplayText, textPtr);
+ }
+ return TCL_OK;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * TkTextXviewCmd --
+ *
+ * This function is invoked to process the "xview" option for the widget
+ * command for text widgets. See the user documentation for details on
+ * what it does.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * See the user documentation.
+ *
+ *--------------------------------------------------------------
+ */
+
+int
+TkTextXviewCmd(
+ TkText *textPtr, /* Information about text widget. */
+ Tcl_Interp *interp, /* Current interpreter. */
+ int objc, /* Number of arguments. */
+ Tcl_Obj *const objv[]) /* Argument objects. Someone else has already
+ * parsed this command enough to know that
+ * objv[1] is "xview". */
+{
+ TextDInfo *dInfoPtr = textPtr->dInfoPtr;
+ int type, count;
+ double fraction;
+
+ if (dInfoPtr->flags & DINFO_OUT_OF_DATE) {
+ UpdateDisplayInfo(textPtr);
+ }
+
+ if (objc == 2) {
+ GetXView(interp, textPtr, 0);
+ return TCL_OK;
+ }
+
+ type = TextGetScrollInfoObj(interp, textPtr, objc, objv,
+ &fraction, &count);
+ switch (type) {
+ case TKTEXT_SCROLL_ERROR:
+ return TCL_ERROR;
+ case TKTEXT_SCROLL_MOVETO:
+ if (fraction > 1.0) {
+ fraction = 1.0;
+ }
+ if (fraction < 0) {
+ fraction = 0;
+ }
+ dInfoPtr->newXPixelOffset = (int)
+ (fraction * dInfoPtr->maxLength + 0.5);
+ break;
+ case TKTEXT_SCROLL_PAGES: {
+ int pixelsPerPage;
+
+ pixelsPerPage = (dInfoPtr->maxX-dInfoPtr->x) - 2*textPtr->charWidth;
+ if (pixelsPerPage < 1) {
+ pixelsPerPage = 1;
+ }
+ dInfoPtr->newXPixelOffset += pixelsPerPage * count;
+ break;
+ }
+ case TKTEXT_SCROLL_UNITS:
+ dInfoPtr->newXPixelOffset += count * textPtr->charWidth;
+ break;
+ case TKTEXT_SCROLL_PIXELS:
+ dInfoPtr->newXPixelOffset += count;
+ break;
+ }
+
+ dInfoPtr->flags |= DINFO_OUT_OF_DATE;
+ if (!(dInfoPtr->flags & REDRAW_PENDING)) {
+ dInfoPtr->flags |= REDRAW_PENDING;
+ Tcl_DoWhenIdle(DisplayText, textPtr);
+ }
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * YScrollByPixels --
+ *
+ * This function is called to scroll a text widget up or down by a given
+ * number of pixels.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The view in textPtr's window changes to reflect the value of "offset".
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+YScrollByPixels(
+ TkText *textPtr, /* Widget to scroll. */
+ int offset) /* Amount by which to scroll, in pixels.
+ * Positive means that information later in
+ * text becomes visible, negative means that
+ * information earlier in the text becomes
+ * visible. */
+{
+ TextDInfo *dInfoPtr = textPtr->dInfoPtr;
+
+ if (offset < 0) {
+ /*
+ * Now we want to measure up this number of pixels from the top of the
+ * screen. But the top line may not be totally visible. Note that
+ * 'count' is negative here.
+ */
+
+ offset -= CalculateDisplayLineHeight(textPtr,
+ &textPtr->topIndex, NULL, NULL) - dInfoPtr->topPixelOffset;
+ MeasureUp(textPtr, &textPtr->topIndex, -offset,
+ &textPtr->topIndex, &dInfoPtr->newTopPixelOffset);
+ } else if (offset > 0) {
+ DLine *dlPtr;
+ TkTextLine *lastLinePtr;
+ TkTextIndex newIdx;
+
+ /*
+ * Scrolling down by pixels. Layout lines starting at the top index
+ * and count through the desired vertical distance.
+ */
+
+ lastLinePtr = TkBTreeFindLine(textPtr->sharedTextPtr->tree, textPtr,
+ TkBTreeNumLines(textPtr->sharedTextPtr->tree, textPtr));
+ offset += dInfoPtr->topPixelOffset;
+ dInfoPtr->newTopPixelOffset = 0;
+ while (offset > 0) {
+ dlPtr = LayoutDLine(textPtr, &textPtr->topIndex);
+ dlPtr->nextPtr = NULL;
+ TkTextIndexForwBytes(textPtr, &textPtr->topIndex,
+ dlPtr->byteCount, &newIdx);
+ if (offset <= dlPtr->height) {
+ /*
+ * Adjust the top overlap accordingly.
+ */
+
+ dInfoPtr->newTopPixelOffset = offset;
+ }
+ offset -= dlPtr->height;
+ FreeDLines(textPtr, dlPtr, NULL, DLINE_FREE_TEMP);
+ if (newIdx.linePtr == lastLinePtr || offset <= 0) {
+ break;
+ }
+ textPtr->topIndex = newIdx;
+ }
+ } else {
+ /*
+ * offset = 0, so no scrolling required.
+ */
+
+ return;
+ }
+ if (!(dInfoPtr->flags & REDRAW_PENDING)) {
+ Tcl_DoWhenIdle(DisplayText, textPtr);
+ }
+ dInfoPtr->flags |= REDRAW_PENDING|DINFO_OUT_OF_DATE|REPICK_NEEDED;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * YScrollByLines --
+ *
+ * This function is called to scroll a text widget up or down by a given
+ * number of lines.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The view in textPtr's window changes to reflect the value of "offset".
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+YScrollByLines(
+ TkText *textPtr, /* Widget to scroll. */
+ int offset) /* Amount by which to scroll, in display
+ * lines. Positive means that information
+ * later in text becomes visible, negative
+ * means that information earlier in the text
+ * becomes visible. */
+{
+ int i, bytesToCount, lineNum;
+ TkTextIndex newIdx, index;
+ TkTextLine *lastLinePtr;
+ TextDInfo *dInfoPtr = textPtr->dInfoPtr;
+ DLine *dlPtr, *lowestPtr;
+
+ if (offset < 0) {
+ /*
+ * Must scroll up (to show earlier information in the text). The code
+ * below is similar to that in MeasureUp, except that it counts lines
+ * instead of pixels.
+ */
+
+ bytesToCount = textPtr->topIndex.byteIndex + 1;
+ index.tree = textPtr->sharedTextPtr->tree;
+ offset--; /* Skip line containing topIndex. */
+ for (lineNum = TkBTreeLinesTo(textPtr, textPtr->topIndex.linePtr);
+ lineNum >= 0; lineNum--) {
+ index.linePtr = TkBTreeFindLine(textPtr->sharedTextPtr->tree,
+ textPtr, lineNum);
+ index.byteIndex = 0;
+ lowestPtr = NULL;
+ do {
+ dlPtr = LayoutDLine(textPtr, &index);
+ dlPtr->nextPtr = lowestPtr;
+ lowestPtr = dlPtr;
+ TkTextIndexForwBytes(textPtr, &index, dlPtr->byteCount,&index);
+ bytesToCount -= dlPtr->byteCount;
+ } while ((bytesToCount > 0)
+ && (index.linePtr == dlPtr->index.linePtr));
+
+ for (dlPtr = lowestPtr; dlPtr != NULL; dlPtr = dlPtr->nextPtr) {
+ offset++;
+ if (offset == 0) {
+ textPtr->topIndex = dlPtr->index;
+
+ /*
+ * topIndex is the start of a logical line. However, if
+ * the eol of the previous logical line is elided, then
+ * topIndex may be elsewhere than the first character of
+ * a display line, which is unwanted. Adjust to the start
+ * of the display line, if needed.
+ * topIndex is the start of a display line that is or is
+ * not the start of a logical line. If it is the start of
+ * a logical line, we must check whether this line is
+ * merged with the previous logical line, and if so we
+ * must adjust topIndex to the start of the display line.
+ */
+ if (!IsStartOfNotMergedLine(textPtr, &textPtr->topIndex)) {
+ TkTextFindDisplayLineEnd(textPtr, &textPtr->topIndex,
+ 0, NULL);
+ }
+
+ break;
+ }
+ }
+
+ /*
+ * Discard the display lines, then either return or prepare for
+ * the next display line to lay out.
+ */
+
+ FreeDLines(textPtr, lowestPtr, NULL, DLINE_FREE);
+ if (offset >= 0) {
+ goto scheduleUpdate;
+ }
+ bytesToCount = INT_MAX;
+ }
+
+ /*
+ * Ran off the beginning of the text. Return the first character in
+ * the text, and make sure we haven't left anything overlapping the
+ * top window border.
+ */
+
+ TkTextMakeByteIndex(textPtr->sharedTextPtr->tree, textPtr, 0, 0,
+ &textPtr->topIndex);
+ dInfoPtr->newTopPixelOffset = 0;
+ } else {
+ /*
+ * Scrolling down, to show later information in the text. Just count
+ * lines from the current top of the window.
+ */
+
+ lastLinePtr = TkBTreeFindLine(textPtr->sharedTextPtr->tree, textPtr,
+ TkBTreeNumLines(textPtr->sharedTextPtr->tree, textPtr));
+ for (i = 0; i < offset; i++) {
+ dlPtr = LayoutDLine(textPtr, &textPtr->topIndex);
+ if (dlPtr->length == 0 && dlPtr->height == 0) {
+ offset++;
+ }
+ dlPtr->nextPtr = NULL;
+ TkTextIndexForwBytes(textPtr, &textPtr->topIndex,
+ dlPtr->byteCount, &newIdx);
+ FreeDLines(textPtr, dlPtr, NULL, DLINE_FREE);
+ if (newIdx.linePtr == lastLinePtr) {
+ break;
+ }
+ textPtr->topIndex = newIdx;
+ }
+ }
+
+ scheduleUpdate:
+ if (!(dInfoPtr->flags & REDRAW_PENDING)) {
+ Tcl_DoWhenIdle(DisplayText, textPtr);
+ }
+ dInfoPtr->flags |= REDRAW_PENDING|DINFO_OUT_OF_DATE|REPICK_NEEDED;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * TkTextYviewCmd --
+ *
+ * This function is invoked to process the "yview" option for the widget
+ * command for text widgets. See the user documentation for details on
+ * what it does.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * See the user documentation.
+ *
+ *--------------------------------------------------------------
+ */
+
+int
+TkTextYviewCmd(
+ TkText *textPtr, /* Information about text widget. */
+ Tcl_Interp *interp, /* Current interpreter. */
+ int objc, /* Number of arguments. */
+ Tcl_Obj *const objv[]) /* Argument objects. Someone else has already
+ * parsed this command enough to know that
+ * objv[1] is "yview". */
+{
+ TextDInfo *dInfoPtr = textPtr->dInfoPtr;
+ int pickPlace, type;
+ int pixels, count;
+ int switchLength;
+ double fraction;
+ TkTextIndex index;
+
+ if (dInfoPtr->flags & DINFO_OUT_OF_DATE) {
+ UpdateDisplayInfo(textPtr);
+ }
+
+ if (objc == 2) {
+ GetYView(interp, textPtr, 0);
+ return TCL_OK;
+ }
+
+ /*
+ * Next, handle the old syntax: "pathName yview ?-pickplace? where"
+ */
+
+ pickPlace = 0;
+ if (Tcl_GetString(objv[2])[0] == '-') {
+ register const char *switchStr =
+ Tcl_GetStringFromObj(objv[2], &switchLength);
+
+ if ((switchLength >= 2) && (strncmp(switchStr, "-pickplace",
+ (unsigned) switchLength) == 0)) {
+ pickPlace = 1;
+ if (objc != 4) {
+ Tcl_WrongNumArgs(interp, 3, objv, "lineNum|index");
+ return TCL_ERROR;
+ }
+ }
+ }
+ if ((objc == 3) || pickPlace) {
+ int lineNum;
+
+ if (Tcl_GetIntFromObj(interp, objv[2+pickPlace], &lineNum) == TCL_OK) {
+ TkTextMakeByteIndex(textPtr->sharedTextPtr->tree, textPtr,
+ lineNum, 0, &index);
+ TkTextSetYView(textPtr, &index, 0);
+ return TCL_OK;
+ }
+
+ /*
+ * The argument must be a regular text index.
+ */
+
+ Tcl_ResetResult(interp);
+ if (TkTextGetObjIndex(interp, textPtr, objv[2+pickPlace],
+ &index) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ TkTextSetYView(textPtr, &index, (pickPlace ? TK_TEXT_PICKPLACE : 0));
+ return TCL_OK;
+ }
+
+ /*
+ * New syntax: dispatch based on objv[2].
+ */
+
+ type = TextGetScrollInfoObj(interp, textPtr, objc,objv, &fraction, &count);
+ switch (type) {
+ case TKTEXT_SCROLL_ERROR:
+ return TCL_ERROR;
+ case TKTEXT_SCROLL_MOVETO: {
+ int numPixels = TkBTreeNumPixels(textPtr->sharedTextPtr->tree,
+ textPtr);
+ int topMostPixel;
+
+ if (numPixels == 0) {
+ /*
+ * If the window is totally empty no scrolling is needed, and the
+ * TkTextMakePixelIndex call below will fail.
+ */
+
+ break;
+ }
+ if (fraction > 1.0) {
+ fraction = 1.0;
+ }
+ if (fraction < 0) {
+ fraction = 0;
+ }
+
+ /*
+ * Calculate the pixel count for the new topmost pixel in the topmost
+ * line of the window. Note that the interpretation of 'fraction' is
+ * that it counts from 0 (top pixel in buffer) to 1.0 (one pixel past
+ * the last pixel in buffer).
+ */
+
+ topMostPixel = (int) (0.5 + fraction * numPixels);
+ if (topMostPixel >= numPixels) {
+ topMostPixel = numPixels -1;
+ }
+
+ /*
+ * This function returns the number of pixels by which the given line
+ * should overlap the top of the visible screen.
+ *
+ * This is then used to provide smooth scrolling.
+ */
+
+ pixels = TkTextMakePixelIndex(textPtr, topMostPixel, &index);
+ TkTextSetYView(textPtr, &index, pixels);
+ break;
+ }
+ case TKTEXT_SCROLL_PAGES: {
+ /*
+ * Scroll up or down by screenfuls. Actually, use the window height
+ * minus two lines, so that there's some overlap between adjacent
+ * pages.
+ */
+
+ int height = dInfoPtr->maxY - dInfoPtr->y;
+
+ if (textPtr->charHeight * 4 >= height) {
+ /*
+ * A single line is more than a quarter of the display. We choose
+ * to scroll by 3/4 of the height instead.
+ */
+
+ pixels = 3*height/4;
+ if (pixels < textPtr->charHeight) {
+ /*
+ * But, if 3/4 of the height is actually less than a single
+ * typical character height, then scroll by the minimum of the
+ * linespace or the total height.
+ */
+
+ if (textPtr->charHeight < height) {
+ pixels = textPtr->charHeight;
+ } else {
+ pixels = height;
+ }
+ }
+ pixels *= count;
+ } else {
+ pixels = (height - 2*textPtr->charHeight)*count;
+ }
+ YScrollByPixels(textPtr, pixels);
+ break;
+ }
+ case TKTEXT_SCROLL_PIXELS:
+ YScrollByPixels(textPtr, count);
+ break;
+ case TKTEXT_SCROLL_UNITS:
+ YScrollByLines(textPtr, count);
+ break;
+ }
+ return TCL_OK;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * TkTextPendingsync --
+ *
+ * This function checks if any line heights are not up-to-date.
+ *
+ * Results:
+ * Returns a boolean true if it is the case, or false if all line
+ * heights are up-to-date.
+ *
+ * Side effects:
+ * None.
+ *
+ *--------------------------------------------------------------
+ */
+
+Bool
+TkTextPendingsync(
+ TkText *textPtr) /* Information about text widget. */
+{
+ TextDInfo *dInfoPtr = textPtr->dInfoPtr;
+
+ return (
+ ((dInfoPtr->metricEpoch == -1) &&
+ (dInfoPtr->lastMetricUpdateLine == dInfoPtr->currentMetricUpdateLine)) ?
+ 0 : 1);
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * TkTextScanCmd --
+ *
+ * This function is invoked to process the "scan" option for the widget
+ * command for text widgets. See the user documentation for details on
+ * what it does.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * See the user documentation.
+ *
+ *--------------------------------------------------------------
+ */
+
+int
+TkTextScanCmd(
+ register TkText *textPtr, /* Information about text widget. */
+ Tcl_Interp *interp, /* Current interpreter. */
+ int objc, /* Number of arguments. */
+ Tcl_Obj *const objv[]) /* Argument objects. Someone else has already
+ * parsed this command enough to know that
+ * objv[1] is "scan". */
+{
+ TextDInfo *dInfoPtr = textPtr->dInfoPtr;
+ TkTextIndex index;
+ int c, x, y, totalScroll, gain=10;
+ size_t length;
+
+ if ((objc != 5) && (objc != 6)) {
+ Tcl_WrongNumArgs(interp, 2, objv, "mark x y");
+ Tcl_AppendResult(interp, " or \"", Tcl_GetString(objv[0]),
+ " scan dragto x y ?gain?\"", NULL);
+ /*
+ * Ought to be:
+ * Tcl_WrongNumArgs(interp, 2, objc, "dragto x y ?gain?");
+ */
+ return TCL_ERROR;
+ }
+ if (Tcl_GetIntFromObj(interp, objv[3], &x) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (Tcl_GetIntFromObj(interp, objv[4], &y) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if ((objc == 6) && (Tcl_GetIntFromObj(interp, objv[5], &gain) != TCL_OK)) {
+ return TCL_ERROR;
+ }
+ c = Tcl_GetString(objv[2])[0];
+ length = strlen(Tcl_GetString(objv[2]));
+ if (c=='d' && strncmp(Tcl_GetString(objv[2]), "dragto", length)==0) {
+ int newX, maxX;
+
+ /*
+ * Amplify the difference between the current position and the mark
+ * position to compute how much the view should shift, then update the
+ * mark position to correspond to the new view. If we run off the edge
+ * of the text, reset the mark point so that the current position
+ * continues to correspond to the edge of the window. This means that
+ * the picture will start dragging as soon as the mouse reverses
+ * direction (without this reset, might have to slide mouse a long
+ * ways back before the picture starts moving again).
+ */
+
+ newX = dInfoPtr->scanMarkXPixel + gain*(dInfoPtr->scanMarkX - x);
+ maxX = 1 + dInfoPtr->maxLength - (dInfoPtr->maxX - dInfoPtr->x);
+ if (newX < 0) {
+ newX = 0;
+ dInfoPtr->scanMarkXPixel = 0;
+ dInfoPtr->scanMarkX = x;
+ } else if (newX > maxX) {
+ newX = maxX;
+ dInfoPtr->scanMarkXPixel = maxX;
+ dInfoPtr->scanMarkX = x;
+ }
+ dInfoPtr->newXPixelOffset = newX;
+
+ totalScroll = gain*(dInfoPtr->scanMarkY - y);
+ if (totalScroll != dInfoPtr->scanTotalYScroll) {
+ index = textPtr->topIndex;
+ YScrollByPixels(textPtr, totalScroll-dInfoPtr->scanTotalYScroll);
+ dInfoPtr->scanTotalYScroll = totalScroll;
+ if ((index.linePtr == textPtr->topIndex.linePtr) &&
+ (index.byteIndex == textPtr->topIndex.byteIndex)) {
+ dInfoPtr->scanTotalYScroll = 0;
+ dInfoPtr->scanMarkY = y;
+ }
+ }
+ dInfoPtr->flags |= DINFO_OUT_OF_DATE;
+ if (!(dInfoPtr->flags & REDRAW_PENDING)) {
+ dInfoPtr->flags |= REDRAW_PENDING;
+ Tcl_DoWhenIdle(DisplayText, textPtr);
+ }
+ } else if (c=='m' && strncmp(Tcl_GetString(objv[2]), "mark", length)==0) {
+ dInfoPtr->scanMarkXPixel = dInfoPtr->newXPixelOffset;
+ dInfoPtr->scanMarkX = x;
+ dInfoPtr->scanTotalYScroll = 0;
+ dInfoPtr->scanMarkY = y;
+ } else {
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "bad scan option \"%s\": must be mark or dragto",
+ Tcl_GetString(objv[2])));
+ Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "INDEX", "scan option",
+ Tcl_GetString(objv[2]), NULL);
+ return TCL_ERROR;
+ }
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * GetXView --
+ *
+ * This function computes the fractions that indicate what's visible in a
+ * text window and, optionally, evaluates a Tcl script to report them to
+ * the text's associated scrollbar.
+ *
+ * Results:
+ * If report is zero, then the interp's result is filled in with two real
+ * numbers separated by a space, giving the position of the left and
+ * right edges of the window as fractions from 0 to 1, where 0 means the
+ * left edge of the text and 1 means the right edge. If report is
+ * non-zero, then the interp's result isn't modified directly, but
+ * instead a script is evaluated in interp to report the new horizontal
+ * scroll position to the scrollbar (if the scroll position hasn't
+ * changed then no script is invoked).
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+GetXView(
+ Tcl_Interp *interp, /* If "report" is FALSE, string describing
+ * visible range gets stored in the interp's
+ * result. */
+ TkText *textPtr, /* Information about text widget. */
+ int report) /* Non-zero means report info to scrollbar if
+ * it has changed. */
+{
+ TextDInfo *dInfoPtr = textPtr->dInfoPtr;
+ double first, last;
+ int code;
+ Tcl_Obj *listObj;
+
+ if (dInfoPtr->maxLength > 0) {
+ first = ((double) dInfoPtr->curXPixelOffset)
+ / dInfoPtr->maxLength;
+ last = ((double) (dInfoPtr->curXPixelOffset + dInfoPtr->maxX
+ - dInfoPtr->x))/dInfoPtr->maxLength;
+ if (last > 1.0) {
+ last = 1.0;
+ }
+ } else {
+ first = 0;
+ last = 1.0;
+ }
+ if (!report) {
+ listObj = Tcl_NewListObj(0, NULL);
+ Tcl_ListObjAppendElement(interp, listObj, Tcl_NewDoubleObj(first));
+ Tcl_ListObjAppendElement(interp, listObj, Tcl_NewDoubleObj(last));
+ Tcl_SetObjResult(interp, listObj);
+ return;
+ }
+ if (FP_EQUAL_SCALE(first, dInfoPtr->xScrollFirst, dInfoPtr->maxLength) &&
+ FP_EQUAL_SCALE(last, dInfoPtr->xScrollLast, dInfoPtr->maxLength)) {
+ return;
+ }
+ dInfoPtr->xScrollFirst = first;
+ dInfoPtr->xScrollLast = last;
+ if (textPtr->xScrollCmd != NULL) {
+ char buf1[TCL_DOUBLE_SPACE+1];
+ char buf2[TCL_DOUBLE_SPACE+1];
+ Tcl_DString buf;
+
+ buf1[0] = ' ';
+ buf2[0] = ' ';
+ Tcl_PrintDouble(NULL, first, buf1+1);
+ Tcl_PrintDouble(NULL, last, buf2+1);
+ Tcl_DStringInit(&buf);
+ Tcl_DStringAppend(&buf, textPtr->xScrollCmd, -1);
+ Tcl_DStringAppend(&buf, buf1, -1);
+ Tcl_DStringAppend(&buf, buf2, -1);
+ code = Tcl_EvalEx(interp, Tcl_DStringValue(&buf), -1, 0);
+ Tcl_DStringFree(&buf);
+ if (code != TCL_OK) {
+ Tcl_AddErrorInfo(interp,
+ "\n (horizontal scrolling command executed by text)");
+ Tcl_BackgroundException(interp, code);
+ }
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * GetYPixelCount --
+ *
+ * How many pixels are there between the absolute top of the widget and
+ * the top of the given DLine.
+ *
+ * While this function will work for any valid DLine, it is only ever
+ * called when dlPtr is the first display line in the widget (by
+ * 'GetYView'). This means that usually this function is a very quick
+ * calculation, since it can use the pre-calculated linked-list of DLines
+ * for height information.
+ *
+ * The only situation where this breaks down is if dlPtr's logical line
+ * wraps enough times to fill the text widget's current view - in this
+ * case we won't have enough dlPtrs in the linked list to be able to
+ * subtract off what we want.
+ *
+ * Results:
+ * The number of pixels.
+ *
+ * This value has a valid range between '0' (the very top of the widget)
+ * and the number of pixels in the total widget minus the pixel-height of
+ * the last line.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+GetYPixelCount(
+ TkText *textPtr, /* Information about text widget. */
+ DLine *dlPtr) /* Information about the layout of a given
+ * index. */
+{
+ TkTextLine *linePtr = dlPtr->index.linePtr;
+ int count;
+
+ /*
+ * Get the pixel count to the top of dlPtr's logical line. The rest of the
+ * function is then concerned with updating 'count' for any difference
+ * between the top of the logical line and the display line.
+ */
+
+ count = TkBTreePixelsTo(textPtr, linePtr);
+
+ /*
+ * For the common case where this dlPtr is also the start of the logical
+ * line, we can return right away.
+ */
+
+ if (IsStartOfNotMergedLine(textPtr, &dlPtr->index)) {
+ return count;
+ }
+
+ /*
+ * Add on the logical line's height to reach one pixel beyond the bottom
+ * of the logical line. And then subtract off the heights of all the
+ * display lines from dlPtr to the end of its logical line.
+ *
+ * A different approach would be to lay things out from the start of the
+ * logical line until we reach dlPtr, but since none of those are
+ * pre-calculated, it'll usually take a lot longer. (But there are cases
+ * where it would be more efficient: say if we're on the second of 1000
+ * wrapped lines all from a single logical line - but that sort of
+ * optimization is left for the future).
+ */
+
+ count += TkBTreeLinePixelCount(textPtr, linePtr);
+
+ do {
+ count -= dlPtr->height;
+ if (dlPtr->nextPtr == NULL) {
+ /*
+ * We've run out of pre-calculated display lines, so we have to
+ * lay them out ourselves until the end of the logical line. Here
+ * is where we could be clever and ask: what's faster, to layout
+ * all lines from here to line-end, or all lines from the original
+ * dlPtr to the line-start? We just assume the former.
+ */
+
+ TkTextIndex index;
+ int notFirst = 0;
+
+ while (1) {
+ TkTextIndexForwBytes(textPtr, &dlPtr->index,
+ dlPtr->byteCount, &index);
+ if (notFirst) {
+ FreeDLines(textPtr, dlPtr, NULL, DLINE_FREE_TEMP);
+ }
+ if (index.linePtr != linePtr) {
+ break;
+ }
+ dlPtr = LayoutDLine(textPtr, &index);
+
+ if (tkTextDebug) {
+ char string[TK_POS_CHARS];
+
+ /*
+ * Debugging is enabled, so keep a log of all the lines
+ * whose height was recalculated. The test suite uses this
+ * information.
+ */
+
+ TkTextPrintIndex(textPtr, &index, string);
+ LOG("tk_textHeightCalc", string);
+ }
+ count -= dlPtr->height;
+ notFirst = 1;
+ }
+ break;
+ }
+ dlPtr = dlPtr->nextPtr;
+ } while (dlPtr->index.linePtr == linePtr);
+
+ return count;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * GetYView --
+ *
+ * This function computes the fractions that indicate what's visible in a
+ * text window and, optionally, evaluates a Tcl script to report them to
+ * the text's associated scrollbar.
+ *
+ * Results:
+ * If report is zero, then the interp's result is filled in with two real
+ * numbers separated by a space, giving the position of the top and
+ * bottom of the window as fractions from 0 to 1, where 0 means the
+ * beginning of the text and 1 means the end. If report is non-zero, then
+ * the interp's result isn't modified directly, but a script is evaluated
+ * in interp to report the new scroll position to the scrollbar (if the
+ * scroll position hasn't changed then no script is invoked).
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+GetYView(
+ Tcl_Interp *interp, /* If "report" is FALSE, string describing
+ * visible range gets stored in the interp's
+ * result. */
+ TkText *textPtr, /* Information about text widget. */
+ int report) /* Non-zero means report info to scrollbar if
+ * it has changed. */
+{
+ TextDInfo *dInfoPtr = textPtr->dInfoPtr;
+ double first, last;
+ DLine *dlPtr;
+ int totalPixels, code, count;
+ Tcl_Obj *listObj;
+
+ dlPtr = dInfoPtr->dLinePtr;
+
+ if (dlPtr == NULL) {
+ return;
+ }
+
+ totalPixels = TkBTreeNumPixels(textPtr->sharedTextPtr->tree, textPtr);
+
+ if (totalPixels == 0) {
+ first = 0.0;
+ last = 1.0;
+ } else {
+ /*
+ * Get the pixel count for the first visible pixel of the first
+ * visible line. If the first visible line is only partially visible,
+ * then we use 'topPixelOffset' to get the difference.
+ */
+
+ count = GetYPixelCount(textPtr, dlPtr);
+ first = (count + dInfoPtr->topPixelOffset) / (double) totalPixels;
+
+ /*
+ * Add on the total number of visible pixels to get the count to one
+ * pixel _past_ the last visible pixel. This is how the 'yview'
+ * command is documented, and also explains why we are dividing by
+ * 'totalPixels' and not 'totalPixels-1'.
+ */
+
+ while (1) {
+ int extra;
+
+ count += dlPtr->height;
+ extra = dlPtr->y + dlPtr->height - dInfoPtr->maxY;
+ if (extra > 0) {
+ /*
+ * This much of the last line is not visible, so don't count
+ * these pixels. Since we've reached the bottom of the window,
+ * we break out of the loop.
+ */
+
+ count -= extra;
+ break;
+ }
+ if (dlPtr->nextPtr == NULL) {
+ break;
+ }
+ dlPtr = dlPtr->nextPtr;
+ }
+
+ if (count > totalPixels) {
+ /*
+ * It can be possible, if we do not update each line's pixelHeight
+ * cache when we lay out individual DLines that the count
+ * generated here is more up-to-date than that maintained by the
+ * BTree. In such a case, the best we can do here is to fix up
+ * 'count' and continue, which might result in small, temporary
+ * perturbations to the size of the scrollbar. This is basically
+ * harmless, but in a perfect world we would not have this
+ * problem.
+ *
+ * For debugging purposes, if anyone wishes to improve the text
+ * widget further, the following 'panic' can be activated. In
+ * principle it should be possible to ensure the BTree is always
+ * at least as up to date as the display, so in the future we
+ * might be able to leave the 'panic' in permanently when we
+ * believe we have resolved the cache synchronisation issue.
+ *
+ * However, to achieve that goal would, I think, require a fairly
+ * substantial refactorisation of the code in this file so that
+ * there is much more obvious and explicit coordination between
+ * calls to LayoutDLine and updating of each TkTextLine's
+ * pixelHeight. The complicated bit is that LayoutDLine deals with
+ * individual display lines, but pixelHeight is for a logical
+ * line.
+ */
+
+#if 0
+ Tcl_Panic("Counted more pixels (%d) than expected (%d) total "
+ "pixels in text widget scroll bar calculation.", count,
+ totalPixels);
+#endif
+ count = totalPixels;
+ }
+
+ last = ((double) count)/((double)totalPixels);
+ }
+
+ if (!report) {
+ listObj = Tcl_NewListObj(0,NULL);
+ Tcl_ListObjAppendElement(interp, listObj, Tcl_NewDoubleObj(first));
+ Tcl_ListObjAppendElement(interp, listObj, Tcl_NewDoubleObj(last));
+ Tcl_SetObjResult(interp, listObj);
+ return;
+ }
+
+ if (FP_EQUAL_SCALE(first, dInfoPtr->yScrollFirst, totalPixels) &&
+ FP_EQUAL_SCALE(last, dInfoPtr->yScrollLast, totalPixels)) {
+ return;
+ }
+
+ dInfoPtr->yScrollFirst = first;
+ dInfoPtr->yScrollLast = last;
+ if (textPtr->yScrollCmd != NULL) {
+ char buf1[TCL_DOUBLE_SPACE+1];
+ char buf2[TCL_DOUBLE_SPACE+1];
+ Tcl_DString buf;
+
+ buf1[0] = ' ';
+ buf2[0] = ' ';
+ Tcl_PrintDouble(NULL, first, buf1+1);
+ Tcl_PrintDouble(NULL, last, buf2+1);
+ Tcl_DStringInit(&buf);
+ Tcl_DStringAppend(&buf, textPtr->yScrollCmd, -1);
+ Tcl_DStringAppend(&buf, buf1, -1);
+ Tcl_DStringAppend(&buf, buf2, -1);
+ code = Tcl_EvalEx(interp, Tcl_DStringValue(&buf), -1, 0);
+ Tcl_DStringFree(&buf);
+ if (code != TCL_OK) {
+ Tcl_AddErrorInfo(interp,
+ "\n (vertical scrolling command executed by text)");
+ Tcl_BackgroundException(interp, code);
+ }
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * AsyncUpdateYScrollbar --
+ *
+ * This function is called to update the vertical scrollbar asychronously
+ * as the pixel height calculations progress for lines in the widget.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * See 'GetYView'. In particular the scrollbar position and size may be
+ * changed.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+AsyncUpdateYScrollbar(
+ ClientData clientData) /* Information about widget. */
+{
+ register TkText *textPtr = clientData;
+
+ textPtr->dInfoPtr->scrollbarTimer = NULL;
+
+ if (!(textPtr->flags & DESTROYED)) {
+ GetYView(textPtr->interp, textPtr, 1);
+ }
+
+ if (--textPtr->refCount == 0) {
+ ckfree(textPtr);
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * FindDLine --
+ *
+ * This function is called to find the DLine corresponding to a given
+ * text index.
+ *
+ * Results:
+ * The return value is a pointer to the first DLine found in the list
+ * headed by dlPtr that displays information at or after the specified
+ * position. If there is no such line in the list then NULL is returned.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static DLine *
+FindDLine(
+ TkText *textPtr, /* Widget record for text widget. */
+ register DLine *dlPtr, /* Pointer to first in list of DLines to
+ * search. */
+ const TkTextIndex *indexPtr)/* Index of desired character. */
+{
+ DLine *dlPtrPrev;
+ TkTextIndex indexPtr2;
+
+ if (dlPtr == NULL) {
+ return NULL;
+ }
+ if (TkBTreeLinesTo(NULL, indexPtr->linePtr)
+ < TkBTreeLinesTo(NULL, dlPtr->index.linePtr)) {
+ /*
+ * The first display line is already past the desired line.
+ */
+
+ return dlPtr;
+ }
+
+ /*
+ * The display line containing the desired index is such that the index
+ * of the first character of this display line is at or before the
+ * desired index, and the index of the first character of the next
+ * display line is after the desired index.
+ */
+
+ while (TkTextIndexCmp(&dlPtr->index,indexPtr) < 0) {
+ dlPtrPrev = dlPtr;
+ dlPtr = dlPtr->nextPtr;
+ if (dlPtr == NULL) {
+ /*
+ * We're past the last display line, either because the desired
+ * index lies past the visible text, or because the desired index
+ * is on the last display line.
+ */
+ indexPtr2 = dlPtrPrev->index;
+ TkTextIndexForwBytes(textPtr, &indexPtr2, dlPtrPrev->byteCount,
+ &indexPtr2);
+ if (TkTextIndexCmp(&indexPtr2,indexPtr) > 0) {
+ /*
+ * The desired index is on the last display line.
+ * --> return this display line.
+ */
+ dlPtr = dlPtrPrev;
+ } else {
+ /*
+ * The desired index is past the visible text. There is no
+ * display line displaying something at the desired index.
+ * --> return NULL.
+ */
+ }
+ break;
+ }
+ if (TkTextIndexCmp(&dlPtr->index,indexPtr) > 0) {
+ /*
+ * If we're here then we would normally expect that:
+ * dlPtrPrev->index <= indexPtr < dlPtr->index
+ * i.e. we have found the searched display line being dlPtr.
+ * However it is possible that some DLines were unlinked
+ * previously, leading to a situation where going through
+ * the list of display lines skips display lines that did
+ * exist just a moment ago.
+ */
+ indexPtr2 = dlPtrPrev->index;
+ TkTextIndexForwBytes(textPtr, &indexPtr2, dlPtrPrev->byteCount,
+ &indexPtr2);
+ if (TkTextIndexCmp(&indexPtr2,indexPtr) > 0) {
+ /*
+ * Confirmed:
+ * dlPtrPrev->index <= indexPtr < dlPtr->index
+ * --> return dlPtrPrev.
+ */
+ dlPtr = dlPtrPrev;
+ } else {
+ /*
+ * The last (rightmost) index shown by dlPtrPrev is still
+ * before the desired index. This may be because there was
+ * previously a display line between dlPtrPrev and dlPtr
+ * and this display line has been unlinked.
+ * --> return dlPtr.
+ */
+ }
+ break;
+ }
+ }
+
+ return dlPtr;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * IsStartOfNotMergedLine --
+ *
+ * This function checks whether the given index is the start of a
+ * logical line that is not merged with the previous logical line
+ * (due to elision of the eol of the previous line).
+ *
+ * Results:
+ * Returns whether the given index denotes the first index of a
+* logical line not merged with its previous line.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+IsStartOfNotMergedLine(
+ TkText *textPtr, /* Widget record for text widget. */
+ CONST TkTextIndex *indexPtr) /* Index to check. */
+{
+ TkTextIndex indexPtr2;
+
+ if (indexPtr->byteIndex != 0) {
+ /*
+ * Not the start of a logical line.
+ */
+ return 0;
+ }
+
+ if (TkTextIndexBackBytes(textPtr, indexPtr, 1, &indexPtr2)) {
+ /*
+ * indexPtr is the first index of the text widget.
+ */
+ return 1;
+ }
+
+ if (!TkTextIsElided(textPtr, &indexPtr2, NULL)) {
+ /*
+ * The eol of the line just before indexPtr is elided.
+ */
+ return 1;
+ }
+
+ return 0;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkTextPixelIndex --
+ *
+ * Given an (x,y) coordinate on the screen, find the location of the
+ * character closest to that location.
+ *
+ * Results:
+ * The index at *indexPtr is modified to refer to the character on the
+ * display that is closest to (x,y).
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TkTextPixelIndex(
+ TkText *textPtr, /* Widget record for text widget. */
+ int x, int y, /* Pixel coordinates of point in widget's
+ * window. */
+ TkTextIndex *indexPtr, /* This index gets filled in with the index of
+ * the character nearest to (x,y). */
+ int *nearest) /* If non-NULL then gets set to 0 if (x,y) is
+ * actually over the returned index, and 1 if
+ * it is just nearby (e.g. if x,y is on the
+ * border of the widget). */
+{
+ TextDInfo *dInfoPtr = textPtr->dInfoPtr;
+ register DLine *dlPtr, *validDlPtr;
+ int nearby = 0;
+
+ /*
+ * Make sure that all of the layout information about what's displayed
+ * where on the screen is up-to-date.
+ */
+
+ if (dInfoPtr->flags & DINFO_OUT_OF_DATE) {
+ UpdateDisplayInfo(textPtr);
+ }
+
+ /*
+ * If the coordinates are above the top of the window, then adjust them to
+ * refer to the upper-right corner of the window. If they're off to one
+ * side or the other, then adjust to the closest side.
+ */
+
+ if (y < dInfoPtr->y) {
+ y = dInfoPtr->y;
+ x = dInfoPtr->x;
+ nearby = 1;
+ }
+ if (x >= dInfoPtr->maxX) {
+ x = dInfoPtr->maxX - 1;
+ nearby = 1;
+ }
+ if (x < dInfoPtr->x) {
+ x = dInfoPtr->x;
+ nearby = 1;
+ }
+
+ /*
+ * Find the display line containing the desired y-coordinate.
+ */
+
+ if (dInfoPtr->dLinePtr == NULL) {
+ if (nearest != NULL) {
+ *nearest = 1;
+ }
+ *indexPtr = textPtr->topIndex;
+ return;
+ }
+ for (dlPtr = validDlPtr = dInfoPtr->dLinePtr;
+ y >= (dlPtr->y + dlPtr->height);
+ dlPtr = dlPtr->nextPtr) {
+ if (dlPtr->chunkPtr != NULL) {
+ validDlPtr = dlPtr;
+ }
+ if (dlPtr->nextPtr == NULL) {
+ /*
+ * Y-coordinate is off the bottom of the displayed text. Use the
+ * last character on the last line.
+ */
+
+ x = dInfoPtr->maxX - 1;
+ nearby = 1;
+ break;
+ }
+ }
+ if (dlPtr->chunkPtr == NULL) {
+ dlPtr = validDlPtr;
+ }
+
+ if (nearest != NULL) {
+ *nearest = nearby;
+ }
+
+ DlineIndexOfX(textPtr, dlPtr, x, indexPtr);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * DlineIndexOfX --
+ *
+ * Given an x coordinate in a display line, find the index of the
+ * character closest to that location.
+ *
+ * This is effectively the opposite of DlineXOfIndex.
+ *
+ * Results:
+ * The index at *indexPtr is modified to refer to the character on the
+ * display line that is closest to x.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+DlineIndexOfX(
+ TkText *textPtr, /* Widget record for text widget. */
+ DLine *dlPtr, /* Display information for this display
+ * line. */
+ int x, /* Pixel x coordinate of point in widget's
+ * window. */
+ TkTextIndex *indexPtr) /* This index gets filled in with the index of
+ * the character nearest to x. */
+{
+ TextDInfo *dInfoPtr = textPtr->dInfoPtr;
+ register TkTextDispChunk *chunkPtr;
+
+ /*
+ * Scan through the line's chunks to find the one that contains the
+ * desired x-coordinate. Before doing this, translate the x-coordinate
+ * from the coordinate system of the window to the coordinate system of
+ * the line (to take account of x-scrolling).
+ */
+
+ *indexPtr = dlPtr->index;
+ x = x - dInfoPtr->x + dInfoPtr->curXPixelOffset;
+ chunkPtr = dlPtr->chunkPtr;
+
+ if (chunkPtr == NULL || x == 0) {
+ /*
+ * This may occur if everything is elided, or if we're simply already
+ * at the beginning of the line.
+ */
+
+ return;
+ }
+
+ while (x >= (chunkPtr->x + chunkPtr->width)) {
+ /*
+ * Note that this forward then backward movement of the index can be
+ * problematic at the end of the buffer (we can't move forward, and
+ * then when we move backward, we do, leading to the wrong position).
+ * Hence when x == 0 we take special action above.
+ */
+
+ if (TkTextIndexForwBytes(NULL,indexPtr,chunkPtr->numBytes,indexPtr)) {
+ /*
+ * We've reached the end of the text.
+ */
+
+ TkTextIndexBackChars(NULL, indexPtr, 1, indexPtr, COUNT_INDICES);
+ return;
+ }
+ if (chunkPtr->nextPtr == NULL) {
+ /*
+ * We've reached the end of the display line.
+ */
+
+ TkTextIndexBackChars(NULL, indexPtr, 1, indexPtr, COUNT_INDICES);
+ return;
+ }
+ chunkPtr = chunkPtr->nextPtr;
+ }
+
+ /*
+ * If the chunk has more than one byte in it, ask it which character is at
+ * the desired location. In this case we can manipulate
+ * 'indexPtr->byteIndex' directly, because we know we're staying inside a
+ * single logical line.
+ */
+
+ if (chunkPtr->numBytes > 1) {
+ indexPtr->byteIndex += chunkPtr->measureProc(chunkPtr, x);
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkTextIndexOfX --
+ *
+ * Given a logical x coordinate (i.e. distance in pixels from the
+ * beginning of the display line, not taking into account any information
+ * about the window, scrolling etc.) on the display line starting with
+ * the given index, adjust that index to refer to the object under the x
+ * coordinate.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TkTextIndexOfX(
+ TkText *textPtr, /* Widget record for text widget. */
+ int x, /* The x coordinate for which we want the
+ * index. */
+ TkTextIndex *indexPtr) /* Index of display line start, which will be
+ * adjusted to the index under the given x
+ * coordinate. */
+{
+ DLine *dlPtr = LayoutDLine(textPtr, indexPtr);
+ DlineIndexOfX(textPtr, dlPtr, x + textPtr->dInfoPtr->x
+ - textPtr->dInfoPtr->curXPixelOffset, indexPtr);
+ FreeDLines(textPtr, dlPtr, NULL, DLINE_FREE_TEMP);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * DlineXOfIndex --
+ *
+ * Given a relative byte index on a given display line (i.e. the number
+ * of byte indices from the beginning of the given display line), find
+ * the x coordinate of that index within the abstract display line,
+ * without adjusting for the x-scroll state of the line.
+ *
+ * This is effectively the opposite of DlineIndexOfX.
+ *
+ * NB. The 'byteIndex' is relative to the display line, NOT the logical
+ * line.
+ *
+ * Results:
+ * The x coordinate.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+DlineXOfIndex(
+ TkText *textPtr, /* Widget record for text widget. */
+ DLine *dlPtr, /* Display information for this display
+ * line. */
+ int byteIndex) /* The byte index for which we want the
+ * coordinate. */
+{
+ register TkTextDispChunk *chunkPtr = dlPtr->chunkPtr;
+ int x = 0;
+
+ if (byteIndex == 0 || chunkPtr == NULL) {
+ return x;
+ }
+
+ /*
+ * Scan through the line's chunks to find the one that contains the
+ * desired byte index.
+ */
+
+ chunkPtr = dlPtr->chunkPtr;
+ while (byteIndex > 0) {
+ if (byteIndex < chunkPtr->numBytes) {
+ int y, width, height;
+
+ chunkPtr->bboxProc(textPtr, chunkPtr, byteIndex,
+ dlPtr->y + dlPtr->spaceAbove,
+ dlPtr->height - dlPtr->spaceAbove - dlPtr->spaceBelow,
+ dlPtr->baseline - dlPtr->spaceAbove, &x, &y, &width,
+ &height);
+ break;
+ }
+ byteIndex -= chunkPtr->numBytes;
+ if (chunkPtr->nextPtr == NULL || byteIndex == 0) {
+ x = chunkPtr->x + chunkPtr->width;
+ break;
+ }
+ chunkPtr = chunkPtr->nextPtr;
+ }
+
+ return x;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkTextIndexBbox --
+ *
+ * Given an index, find the bounding box of the screen area occupied by
+ * the entity (character, window, image) at that index.
+ *
+ * Results:
+ * Zero is returned if the index is on the screen. -1 means the index is
+ * not on the screen. If the return value is 0, then the bounding box of
+ * the part of the index that's visible on the screen is returned to
+ * *xPtr, *yPtr, *widthPtr, and *heightPtr.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TkTextIndexBbox(
+ TkText *textPtr, /* Widget record for text widget. */
+ const TkTextIndex *indexPtr,/* Index whose bounding box is desired. */
+ int *xPtr, int *yPtr, /* Filled with index's upper-left
+ * coordinate. */
+ int *widthPtr, int *heightPtr,
+ /* Filled in with index's dimensions. */
+ int *charWidthPtr) /* If the 'index' is at the end of a display
+ * line and therefore takes up a very large
+ * width, this is used to return the smaller
+ * width actually desired by the index. */
+{
+ TextDInfo *dInfoPtr = textPtr->dInfoPtr;
+ DLine *dlPtr;
+ register TkTextDispChunk *chunkPtr;
+ int byteCount;
+
+ /*
+ * Make sure that all of the screen layout information is up to date.
+ */
+
+ if (dInfoPtr->flags & DINFO_OUT_OF_DATE) {
+ UpdateDisplayInfo(textPtr);
+ }
+
+ /*
+ * Find the display line containing the desired index.
+ */
+
+ dlPtr = FindDLine(textPtr, dInfoPtr->dLinePtr, indexPtr);
+
+ /*
+ * Two cases shall be trapped here because the logic later really
+ * needs dlPtr to be the display line containing indexPtr:
+ * 1. if no display line contains the desired index (NULL dlPtr)
+ * 2. if indexPtr is before the first display line, in which case
+ * dlPtr currently points to the first display line
+ */
+
+ if ((dlPtr == NULL) || (TkTextIndexCmp(&dlPtr->index, indexPtr) > 0)) {
+ return -1;
+ }
+
+ /*
+ * Find the chunk within the display line that contains the desired
+ * index. The chunks making the display line are skipped up to but not
+ * including the one crossing indexPtr. Skipping is done based on
+ * a byteCount offset possibly spanning several logical lines in case
+ * they are elided.
+ */
+
+ byteCount = TkTextIndexCountBytes(textPtr, &dlPtr->index, indexPtr);
+ for (chunkPtr = dlPtr->chunkPtr; ; chunkPtr = chunkPtr->nextPtr) {
+ if (chunkPtr == NULL) {
+ return -1;
+ }
+ if (byteCount < chunkPtr->numBytes) {
+ break;
+ }
+ byteCount -= chunkPtr->numBytes;
+ }
+
+ /*
+ * Call a chunk-specific function to find the horizontal range of the
+ * character within the chunk, then fill in the vertical range. The
+ * x-coordinate returned by bboxProc is a coordinate within a line, not a
+ * coordinate on the screen. Translate it to reflect horizontal scrolling.
+ */
+
+ chunkPtr->bboxProc(textPtr, chunkPtr, byteCount,
+ dlPtr->y + dlPtr->spaceAbove,
+ dlPtr->height - dlPtr->spaceAbove - dlPtr->spaceBelow,
+ dlPtr->baseline - dlPtr->spaceAbove, xPtr, yPtr, widthPtr,
+ heightPtr);
+ *xPtr = *xPtr + dInfoPtr->x - dInfoPtr->curXPixelOffset;
+ if ((byteCount == chunkPtr->numBytes-1) && (chunkPtr->nextPtr == NULL)) {
+ /*
+ * Last character in display line. Give it all the space up to the
+ * line.
+ */
+
+ if (charWidthPtr != NULL) {
+ *charWidthPtr = dInfoPtr->maxX - *xPtr;
+ if (*charWidthPtr > textPtr->charWidth) {
+ *charWidthPtr = textPtr->charWidth;
+ }
+ }
+ if (*xPtr > dInfoPtr->maxX) {
+ *xPtr = dInfoPtr->maxX;
+ }
+ *widthPtr = dInfoPtr->maxX - *xPtr;
+ } else {
+ if (charWidthPtr != NULL) {
+ *charWidthPtr = *widthPtr;
+ }
+ }
+ if (*widthPtr == 0) {
+ /*
+ * With zero width (e.g. elided text) we just need to make sure it is
+ * onscreen, where the '=' case here is ok.
+ */
+
+ if (*xPtr < dInfoPtr->x) {
+ return -1;
+ }
+ } else {
+ if ((*xPtr + *widthPtr) <= dInfoPtr->x) {
+ return -1;
+ }
+ }
+ if ((*xPtr + *widthPtr) > dInfoPtr->maxX) {
+ *widthPtr = dInfoPtr->maxX - *xPtr;
+ if (*widthPtr <= 0) {
+ return -1;
+ }
+ }
+ if ((*yPtr + *heightPtr) > dInfoPtr->maxY) {
+ *heightPtr = dInfoPtr->maxY - *yPtr;
+ if (*heightPtr <= 0) {
+ return -1;
+ }
+ }
+ return 0;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkTextDLineInfo --
+ *
+ * Given an index, return information about the display line containing
+ * that character.
+ *
+ * Results:
+ * Zero is returned if the character is on the screen. -1 means the
+ * character isn't on the screen. If the return value is 0, then
+ * information is returned in the variables pointed to by xPtr, yPtr,
+ * widthPtr, heightPtr, and basePtr.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TkTextDLineInfo(
+ TkText *textPtr, /* Widget record for text widget. */
+ const TkTextIndex *indexPtr,/* Index of character whose bounding box is
+ * desired. */
+ int *xPtr, int *yPtr, /* Filled with line's upper-left
+ * coordinate. */
+ int *widthPtr, int *heightPtr,
+ /* Filled in with line's dimensions. */
+ int *basePtr) /* Filled in with the baseline position,
+ * measured as an offset down from *yPtr. */
+{
+ TextDInfo *dInfoPtr = textPtr->dInfoPtr;
+ DLine *dlPtr;
+ int dlx;
+
+ /*
+ * Make sure that all of the screen layout information is up to date.
+ */
+
+ if (dInfoPtr->flags & DINFO_OUT_OF_DATE) {
+ UpdateDisplayInfo(textPtr);
+ }
+
+ /*
+ * Find the display line containing the desired index.
+ */
+
+ dlPtr = FindDLine(textPtr, dInfoPtr->dLinePtr, indexPtr);
+
+ /*
+ * Two cases shall be trapped here because the logic later really
+ * needs dlPtr to be the display line containing indexPtr:
+ * 1. if no display line contains the desired index (NULL dlPtr)
+ * 2. if indexPtr is before the first display line, in which case
+ * dlPtr currently points to the first display line
+ */
+
+ if ((dlPtr == NULL) || (TkTextIndexCmp(&dlPtr->index, indexPtr) > 0)) {
+ return -1;
+ }
+
+ dlx = (dlPtr->chunkPtr != NULL? dlPtr->chunkPtr->x: 0);
+ *xPtr = dInfoPtr->x - dInfoPtr->curXPixelOffset + dlx;
+ *widthPtr = dlPtr->length - dlx;
+ *yPtr = dlPtr->y;
+ if ((dlPtr->y + dlPtr->height) > dInfoPtr->maxY) {
+ *heightPtr = dInfoPtr->maxY - dlPtr->y;
+ } else {
+ *heightPtr = dlPtr->height;
+ }
+ *basePtr = dlPtr->baseline;
+ return 0;
+}
+
+/*
+ * Get bounding-box information about an elided chunk.
+ */
+
+static void
+ElideBboxProc(
+ TkText *textPtr,
+ 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, int *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;
+}
+
+/*
+ * Measure an elided chunk.
+ */
+
+static int
+ElideMeasureProc(
+ TkTextDispChunk *chunkPtr, /* Chunk containing desired coord. */
+ int x) /* X-coordinate, in same coordinate system as
+ * chunkPtr->x. */
+{
+ return 0 /*chunkPtr->numBytes - 1*/;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * TkTextCharLayoutProc --
+ *
+ * This function is the "layoutProc" for character segments.
+ *
+ * Results:
+ * If there is something to display for the chunk then a non-zero value
+ * is returned and the fields of chunkPtr will be filled in (see the
+ * declaration of TkTextDispChunk in tkText.h for details). If zero is
+ * returned it means that no characters from this chunk fit in the
+ * window. If -1 is returned it means that this segment just doesn't need
+ * to be displayed (never happens for text).
+ *
+ * Side effects:
+ * Memory is allocated to hold additional information about the chunk.
+ *
+ *--------------------------------------------------------------
+ */
+
+int
+TkTextCharLayoutProc(
+ TkText *textPtr, /* Text widget being layed out. */
+ TkTextIndex *indexPtr, /* Index of first character to lay out
+ * (corresponds to segPtr and offset). */
+ TkTextSegment *segPtr, /* Segment being layed out. */
+ int byteOffset, /* Byte offset within segment of first
+ * character to consider. */
+ int maxX, /* Chunk must not occupy pixels at this
+ * position or higher. */
+ int maxBytes, /* Chunk must not include more than this many
+ * characters. */
+ int noCharsYet, /* Non-zero means no characters have been
+ * assigned to this display line yet. */
+ TkWrapMode wrapMode, /* How to handle line wrapping:
+ * TEXT_WRAPMODE_CHAR, TEXT_WRAPMODE_NONE, or
+ * TEXT_WRAPMODE_WORD. */
+ register TkTextDispChunk *chunkPtr)
+ /* Structure to fill in with information about
+ * this chunk. The x field has already been
+ * set by the caller. */
+{
+ Tk_Font tkfont;
+ int nextX, bytesThatFit, count;
+ CharInfo *ciPtr;
+ char *p;
+ TkTextSegment *nextPtr;
+ Tk_FontMetrics fm;
+#if TK_LAYOUT_WITH_BASE_CHUNKS
+ const char *line;
+ int lineOffset;
+ BaseCharInfo *bciPtr;
+ Tcl_DString *baseString;
+#endif
+
+ /*
+ * Figure out how many characters will fit in the space we've got. Include
+ * the next character, even though it won't fit completely, if any of the
+ * following is true:
+ * (a) the chunk contains no characters and the display line contains no
+ * characters yet (i.e. the line isn't wide enough to hold even a
+ * single character).
+ * (b) at least one pixel of the character is visible, we have not
+ * already exceeded the character limit, and the next character is a
+ * white space character.
+ */
+
+ p = segPtr->body.chars + byteOffset;
+ tkfont = chunkPtr->stylePtr->sValuePtr->tkfont;
+
+#if TK_LAYOUT_WITH_BASE_CHUNKS
+ if (baseCharChunkPtr == NULL) {
+ baseCharChunkPtr = chunkPtr;
+ bciPtr = ckalloc(sizeof(BaseCharInfo));
+ baseString = &bciPtr->baseChars;
+ Tcl_DStringInit(baseString);
+ bciPtr->width = 0;
+
+ ciPtr = &bciPtr->ci;
+ } else {
+ bciPtr = baseCharChunkPtr->clientData;
+ ciPtr = ckalloc(sizeof(CharInfo));
+ baseString = &bciPtr->baseChars;
+ }
+
+ lineOffset = Tcl_DStringLength(baseString);
+ line = Tcl_DStringAppend(baseString,p,maxBytes);
+
+ chunkPtr->clientData = ciPtr;
+ ciPtr->baseChunkPtr = baseCharChunkPtr;
+ ciPtr->baseOffset = lineOffset;
+ ciPtr->chars = NULL;
+ ciPtr->numBytes = 0;
+
+ bytesThatFit = CharChunkMeasureChars(chunkPtr, line,
+ lineOffset + maxBytes, lineOffset, -1, chunkPtr->x, maxX,
+ TK_ISOLATE_END, &nextX);
+#else /* !TK_LAYOUT_WITH_BASE_CHUNKS */
+ bytesThatFit = CharChunkMeasureChars(chunkPtr, p, maxBytes, 0, -1,
+ chunkPtr->x, maxX, TK_ISOLATE_END, &nextX);
+#endif /* TK_LAYOUT_WITH_BASE_CHUNKS */
+
+ if (bytesThatFit < maxBytes) {
+ if ((bytesThatFit == 0) && noCharsYet) {
+ Tcl_UniChar ch;
+ int chLen = Tcl_UtfToUniChar(p, &ch);
+
+#if TK_LAYOUT_WITH_BASE_CHUNKS
+ bytesThatFit = CharChunkMeasureChars(chunkPtr, line,
+ lineOffset+chLen, lineOffset, -1, chunkPtr->x, -1, 0,
+ &nextX);
+#else /* !TK_LAYOUT_WITH_BASE_CHUNKS */
+ bytesThatFit = CharChunkMeasureChars(chunkPtr, p, chLen, 0, -1,
+ chunkPtr->x, -1, 0, &nextX);
+#endif /* TK_LAYOUT_WITH_BASE_CHUNKS */
+ }
+ if ((nextX < maxX) && ((p[bytesThatFit] == ' ')
+ || (p[bytesThatFit] == '\t'))) {
+ /*
+ * Space characters are funny, in that they are considered to fit
+ * if there is at least one pixel of space left on the line. Just
+ * give the space character whatever space is left.
+ */
+
+ nextX = maxX;
+ bytesThatFit++;
+ }
+ if (p[bytesThatFit] == '\n') {
+ /*
+ * A newline character takes up no space, so if the previous
+ * character fits then so does the newline.
+ */
+
+ bytesThatFit++;
+ }
+ if (bytesThatFit == 0) {
+#if TK_LAYOUT_WITH_BASE_CHUNKS
+ chunkPtr->clientData = NULL;
+ if (chunkPtr == baseCharChunkPtr) {
+ baseCharChunkPtr = NULL;
+ Tcl_DStringFree(baseString);
+ } else {
+ Tcl_DStringSetLength(baseString,lineOffset);
+ }
+ ckfree(ciPtr);
+#endif /* TK_LAYOUT_WITH_BASE_CHUNKS */
+ return 0;
+ }
+ }
+
+ Tk_GetFontMetrics(tkfont, &fm);
+
+ /*
+ * Fill in the chunk structure and allocate and initialize a CharInfo
+ * structure. If the last character is a newline then don't bother to
+ * display it.
+ */
+
+ chunkPtr->displayProc = CharDisplayProc;
+ chunkPtr->undisplayProc = CharUndisplayProc;
+ chunkPtr->measureProc = CharMeasureProc;
+ chunkPtr->bboxProc = CharBboxProc;
+ chunkPtr->numBytes = bytesThatFit;
+ chunkPtr->minAscent = fm.ascent + chunkPtr->stylePtr->sValuePtr->offset;
+ chunkPtr->minDescent = fm.descent - chunkPtr->stylePtr->sValuePtr->offset;
+ chunkPtr->minHeight = 0;
+ chunkPtr->width = nextX - chunkPtr->x;
+ chunkPtr->breakIndex = -1;
+
+#if !TK_LAYOUT_WITH_BASE_CHUNKS
+ ciPtr = ckalloc((Tk_Offset(CharInfo, chars) + 1) + bytesThatFit);
+ chunkPtr->clientData = ciPtr;
+ memcpy(ciPtr->chars, p, (unsigned) bytesThatFit);
+#endif /* TK_LAYOUT_WITH_BASE_CHUNKS */
+
+ ciPtr->numBytes = bytesThatFit;
+ if (p[bytesThatFit - 1] == '\n') {
+ ciPtr->numBytes--;
+ }
+
+#if TK_LAYOUT_WITH_BASE_CHUNKS
+ /*
+ * Final update for the current base chunk data.
+ */
+
+ Tcl_DStringSetLength(baseString,lineOffset+ciPtr->numBytes);
+ bciPtr->width = nextX - baseCharChunkPtr->x;
+
+ /*
+ * Finalize the base chunk if this chunk ends in a tab, which definitly
+ * breaks the context and needs to be handled on a higher level.
+ */
+
+ if (ciPtr->numBytes > 0 && p[ciPtr->numBytes - 1] == '\t') {
+ FinalizeBaseChunk(chunkPtr);
+ }
+#endif /* TK_LAYOUT_WITH_BASE_CHUNKS */
+
+ /*
+ * Compute a break location. If we're in word wrap mode, a break can occur
+ * after any space character, or at the end of the chunk if the next
+ * segment (ignoring those with zero size) is not a character segment.
+ */
+
+ if (wrapMode != TEXT_WRAPMODE_WORD) {
+ chunkPtr->breakIndex = chunkPtr->numBytes;
+ } else {
+ for (count = bytesThatFit, p += bytesThatFit - 1; count > 0;
+ count--, p--) {
+ /*
+ * Don't use isspace(); effects are unpredictable and can lead to
+ * odd word-wrapping problems on some platforms. Also don't use
+ * Tcl_UniCharIsSpace here either, as it identifies non-breaking
+ * spaces as places to break. What we actually want is only the
+ * ASCII space characters, so use them explicitly...
+ */
+
+ switch (*p) {
+ case '\t': case '\n': case '\v': case '\f': case '\r': case ' ':
+ chunkPtr->breakIndex = count;
+ goto checkForNextChunk;
+ }
+ }
+ checkForNextChunk:
+ if ((bytesThatFit + byteOffset) == segPtr->size) {
+ for (nextPtr = segPtr->nextPtr; nextPtr != NULL;
+ nextPtr = nextPtr->nextPtr) {
+ if (nextPtr->size != 0) {
+ if (nextPtr->typePtr != &tkTextCharType) {
+ chunkPtr->breakIndex = chunkPtr->numBytes;
+ }
+ break;
+ }
+ }
+ }
+ }
+ return 1;
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * CharChunkMeasureChars --
+ *
+ * Determine the number of characters from a char chunk that will fit in
+ * the given horizontal span.
+ *
+ * This is the same as MeasureChars (which see), but in the context of a
+ * char chunk, i.e. on a higher level of abstraction. Use this function
+ * whereever possible instead of plain MeasureChars, so that the right
+ * context is used automatically.
+ *
+ * Results:
+ * The return value is the number of bytes from the range of start to end
+ * in source that fit in the span given by startX and maxX. *nextXPtr is
+ * filled in with the x-coordinate at which the first character that
+ * didn't fit would be drawn, if it were to be drawn.
+ *
+ * Side effects:
+ * None.
+ *--------------------------------------------------------------
+ */
+
+static int
+CharChunkMeasureChars(
+ TkTextDispChunk *chunkPtr, /* Chunk from which to measure. */
+ const char *chars, /* Chars to use, instead of the chunk's own.
+ * Used by the layoutproc during chunk setup.
+ * All other callers use NULL. Not
+ * NUL-terminated. */
+ int charsLen, /* Length of the "chars" parameter. */
+ int start, int end, /* The range of chars to measure inside the
+ * chunk (or inside the additional chars). */
+ int startX, /* Starting x coordinate where the measured
+ * span will begin. */
+ int maxX, /* Maximum pixel width of the span. May be -1
+ * for unlimited. */
+ int flags, /* Flags to pass to MeasureChars. */
+ int *nextXPtr) /* The function puts the newly calculated
+ * right border x-position of the span
+ * here. */
+{
+ Tk_Font tkfont = chunkPtr->stylePtr->sValuePtr->tkfont;
+ CharInfo *ciPtr = chunkPtr->clientData;
+
+#if !TK_LAYOUT_WITH_BASE_CHUNKS
+ if (chars == NULL) {
+ chars = ciPtr->chars;
+ charsLen = ciPtr->numBytes;
+ }
+ if (end == -1) {
+ end = charsLen;
+ }
+
+ return MeasureChars(tkfont, chars, charsLen, start, end-start,
+ startX, maxX, flags, nextXPtr);
+#else /* TK_LAYOUT_WITH_BASE_CHUNKS */
+ {
+ int xDisplacement;
+ int fit, bstart = start, bend = end;
+
+ if (chars == NULL) {
+ Tcl_DString *baseChars = &((BaseCharInfo *)
+ ciPtr->baseChunkPtr->clientData)->baseChars;
+
+ chars = Tcl_DStringValue(baseChars);
+ charsLen = Tcl_DStringLength(baseChars);
+ bstart += ciPtr->baseOffset;
+ if (bend == -1) {
+ bend = ciPtr->baseOffset + ciPtr->numBytes;
+ } else {
+ bend += ciPtr->baseOffset;
+ }
+ } else if (bend == -1) {
+ bend = charsLen;
+ }
+
+ if (bstart == ciPtr->baseOffset) {
+ xDisplacement = startX - chunkPtr->x;
+ } else {
+ int widthUntilStart = 0;
+
+ MeasureChars(tkfont, chars, charsLen, 0, bstart,
+ 0, -1, 0, &widthUntilStart);
+ xDisplacement = startX - widthUntilStart - chunkPtr->x;
+ }
+
+ fit = MeasureChars(tkfont, chars, charsLen, 0, bend,
+ ciPtr->baseChunkPtr->x + xDisplacement, maxX, flags, nextXPtr);
+
+ if (fit < bstart) {
+ return 0;
+ } else {
+ return fit - bstart;
+ }
+ }
+#endif /* TK_LAYOUT_WITH_BASE_CHUNKS */
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * CharDisplayProc --
+ *
+ * This function is called to display a character chunk on the screen or
+ * in an off-screen pixmap.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Graphics are drawn.
+ *
+ *--------------------------------------------------------------
+ */
+
+static void
+CharDisplayProc(
+ TkText *textPtr,
+ TkTextDispChunk *chunkPtr, /* Chunk that is to be drawn. */
+ int x, /* X-position in dst at which to draw this
+ * chunk (may differ from the x-position in
+ * the chunk because of scrolling). */
+ int y, /* Y-position at which to draw this chunk in
+ * dst. */
+ int height, /* Total height of line. */
+ int baseline, /* Offset of baseline from y. */
+ Display *display, /* Display to use for drawing. */
+ Drawable dst, /* Pixmap or window in which to draw chunk. */
+ int screenY) /* Y-coordinate in text window that
+ * corresponds to y. */
+{
+ CharInfo *ciPtr = chunkPtr->clientData;
+ const char *string;
+ TextStyle *stylePtr;
+ StyleValues *sValuePtr;
+ int numBytes, offsetBytes, offsetX;
+#if TK_DRAW_IN_CONTEXT
+ BaseCharInfo *bciPtr;
+#endif /* TK_DRAW_IN_CONTEXT */
+
+ if ((x + chunkPtr->width) <= 0) {
+ /*
+ * The chunk is off-screen.
+ */
+
+ return;
+ }
+
+#if TK_DRAW_IN_CONTEXT
+ bciPtr = ciPtr->baseChunkPtr->clientData;
+ numBytes = Tcl_DStringLength(&bciPtr->baseChars);
+ string = Tcl_DStringValue(&bciPtr->baseChars);
+
+#elif TK_LAYOUT_WITH_BASE_CHUNKS
+ if (ciPtr->baseChunkPtr != chunkPtr) {
+ /*
+ * Without context drawing only base chunks display their foreground.
+ */
+
+ return;
+ }
+
+ numBytes = Tcl_DStringLength(&((BaseCharInfo *) ciPtr)->baseChars);
+ string = ciPtr->chars;
+
+#else /* !TK_LAYOUT_WITH_BASE_CHUNKS */
+ numBytes = ciPtr->numBytes;
+ string = ciPtr->chars;
+#endif /* TK_LAYOUT_WITH_BASE_CHUNKS */
+
+ stylePtr = chunkPtr->stylePtr;
+ sValuePtr = stylePtr->sValuePtr;
+
+ /*
+ * If the text sticks out way to the left of the window, skip over the
+ * characters that aren't in the visible part of the window. This is
+ * essential if x is very negative (such as less than 32K); otherwise
+ * overflow problems will occur in servers that use 16-bit arithmetic,
+ * like X.
+ */
+
+ offsetX = x;
+ offsetBytes = 0;
+ if (x < 0) {
+ offsetBytes = CharChunkMeasureChars(chunkPtr, NULL, 0, 0, -1,
+ x, 0, 0, &offsetX);
+ }
+
+ /*
+ * Draw the text, underline, and overstrike for this chunk.
+ */
+
+ if (!sValuePtr->elide && (numBytes > offsetBytes)
+ && (stylePtr->fgGC != None)) {
+#if TK_DRAW_IN_CONTEXT
+ int start = ciPtr->baseOffset + offsetBytes;
+ int len = ciPtr->numBytes - offsetBytes;
+ int xDisplacement = x - chunkPtr->x;
+
+ if ((len > 0) && (string[start + len - 1] == '\t')) {
+ len--;
+ }
+ if (len <= 0) {
+ return;
+ }
+
+ TkpDrawCharsInContext(display, dst, stylePtr->fgGC, sValuePtr->tkfont,
+ string, numBytes, start, len,
+ ciPtr->baseChunkPtr->x + xDisplacement,
+ y + baseline - sValuePtr->offset);
+
+ if (sValuePtr->underline) {
+ TkUnderlineCharsInContext(display, dst, stylePtr->ulGC,
+ sValuePtr->tkfont, string, numBytes,
+ ciPtr->baseChunkPtr->x + xDisplacement,
+ y + baseline - sValuePtr->offset,
+ start, start+len);
+ }
+ if (sValuePtr->overstrike) {
+ Tk_FontMetrics fm;
+
+ Tk_GetFontMetrics(sValuePtr->tkfont, &fm);
+ TkUnderlineCharsInContext(display, dst, stylePtr->ovGC,
+ sValuePtr->tkfont, string, numBytes,
+ ciPtr->baseChunkPtr->x + xDisplacement,
+ y + baseline - sValuePtr->offset
+ - fm.descent - (fm.ascent * 3) / 10,
+ start, start+len);
+ }
+#else /* !TK_DRAW_IN_CONTEXT */
+ string += offsetBytes;
+ numBytes -= offsetBytes;
+
+ if ((numBytes > 0) && (string[numBytes - 1] == '\t')) {
+ numBytes--;
+ }
+ Tk_DrawChars(display, dst, stylePtr->fgGC, sValuePtr->tkfont, string,
+ numBytes, offsetX, y + baseline - sValuePtr->offset);
+ if (sValuePtr->underline) {
+ Tk_UnderlineChars(display, dst, stylePtr->ulGC, sValuePtr->tkfont,
+ string, offsetX,
+ y + baseline - sValuePtr->offset,
+ 0, numBytes);
+
+ }
+ if (sValuePtr->overstrike) {
+ Tk_FontMetrics fm;
+
+ Tk_GetFontMetrics(sValuePtr->tkfont, &fm);
+ Tk_UnderlineChars(display, dst, stylePtr->ovGC, sValuePtr->tkfont,
+ string, offsetX,
+ y + baseline - sValuePtr->offset
+ - fm.descent - (fm.ascent * 3) / 10,
+ 0, numBytes);
+ }
+#endif /* TK_DRAW_IN_CONTEXT */
+ }
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * CharUndisplayProc --
+ *
+ * This function is called when a character chunk is no longer going to
+ * be displayed. It frees up resources that were allocated to display the
+ * chunk.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Memory and other resources get freed.
+ *
+ *--------------------------------------------------------------
+ */
+
+static void
+CharUndisplayProc(
+ TkText *textPtr, /* Overall information about text widget. */
+ TkTextDispChunk *chunkPtr) /* Chunk that is about to be freed. */
+{
+ CharInfo *ciPtr = chunkPtr->clientData;
+
+ if (ciPtr) {
+#if TK_LAYOUT_WITH_BASE_CHUNKS
+ if (chunkPtr == ciPtr->baseChunkPtr) {
+ /*
+ * Basechunks are undisplayed first, when DLines are freed or
+ * partially freed, so this makes sure we don't access their data
+ * any more.
+ */
+
+ FreeBaseChunk(chunkPtr);
+ } else if (ciPtr->baseChunkPtr != NULL) {
+ /*
+ * When other char chunks are undisplayed, drop their characters
+ * from the base chunk. This usually happens, when they are last
+ * in a line and need to be re-layed out.
+ */
+
+ RemoveFromBaseChunk(chunkPtr);
+ }
+
+ ciPtr->baseChunkPtr = NULL;
+ ciPtr->chars = NULL;
+ ciPtr->numBytes = 0;
+#endif /* TK_LAYOUT_WITH_BASE_CHUNKS */
+
+ ckfree(ciPtr);
+ chunkPtr->clientData = NULL;
+ }
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * CharMeasureProc --
+ *
+ * This function is called to determine which character in a character
+ * chunk lies over a given x-coordinate.
+ *
+ * Results:
+ * The return value is the index *within the chunk* of the character that
+ * covers the position given by "x".
+ *
+ * Side effects:
+ * None.
+ *
+ *--------------------------------------------------------------
+ */
+
+static int
+CharMeasureProc(
+ TkTextDispChunk *chunkPtr, /* Chunk containing desired coord. */
+ int x) /* X-coordinate, in same coordinate system as
+ * chunkPtr->x. */
+{
+ int endX;
+
+ return CharChunkMeasureChars(chunkPtr, NULL, 0, 0, chunkPtr->numBytes-1,
+ chunkPtr->x, x, 0, &endX); /* CHAR OFFSET */
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * CharBboxProc --
+ *
+ * This function is called to compute the bounding box of the area
+ * occupied by a single character.
+ *
+ * Results:
+ * There is no return value. *xPtr and *yPtr are filled in with the
+ * coordinates of the upper left corner of the character, and *widthPtr
+ * and *heightPtr are filled in with the dimensions of the character in
+ * pixels. Note: not all of the returned bbox is necessarily visible on
+ * the screen (the rightmost part might be off-screen to the right, and
+ * the bottommost part might be off-screen to the bottom).
+ *
+ * Side effects:
+ * None.
+ *
+ *--------------------------------------------------------------
+ */
+
+static void
+CharBboxProc(
+ TkText *textPtr,
+ TkTextDispChunk *chunkPtr, /* Chunk containing desired char. */
+ int byteIndex, /* Byte offset of desired character within the
+ * chunk. */
+ int y, /* Topmost pixel in area allocated for this
+ * line. */
+ int lineHeight, /* Height of line, in pixels. */
+ int baseline, /* Location of line's baseline, in pixels
+ * measured down from y. */
+ int *xPtr, int *yPtr, /* Gets filled in with coords of character's
+ * upper-left pixel. X-coord is in same
+ * coordinate system as chunkPtr->x. */
+ int *widthPtr, /* Gets filled in with width of character, in
+ * pixels. */
+ int *heightPtr) /* Gets filled in with height of character, in
+ * pixels. */
+{
+ CharInfo *ciPtr = chunkPtr->clientData;
+ int maxX;
+
+ maxX = chunkPtr->width + chunkPtr->x;
+ CharChunkMeasureChars(chunkPtr, NULL, 0, 0, byteIndex,
+ chunkPtr->x, -1, 0, xPtr);
+
+ if (byteIndex == ciPtr->numBytes) {
+ /*
+ * This situation only happens if the last character in a line is a
+ * space character, in which case it absorbs all of the extra space in
+ * the line (see TkTextCharLayoutProc).
+ */
+
+ *widthPtr = maxX - *xPtr;
+ } else if ((ciPtr->chars[byteIndex] == '\t')
+ && (byteIndex == ciPtr->numBytes - 1)) {
+ /*
+ * The desired character is a tab character that terminates a chunk;
+ * give it all the space left in the chunk.
+ */
+
+ *widthPtr = maxX - *xPtr;
+ } else {
+ CharChunkMeasureChars(chunkPtr, NULL, 0, byteIndex, byteIndex+1,
+ *xPtr, -1, 0, widthPtr);
+ if (*widthPtr > maxX) {
+ *widthPtr = maxX - *xPtr;
+ } else {
+ *widthPtr -= *xPtr;
+ }
+ }
+ *yPtr = y + baseline - chunkPtr->minAscent;
+ *heightPtr = chunkPtr->minAscent + chunkPtr->minDescent;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * AdjustForTab --
+ *
+ * This function is called to move a series of chunks right in order to
+ * align them with a tab stop.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The width of chunkPtr gets adjusted so that it absorbs the extra space
+ * due to the tab. The x locations in all the chunks after chunkPtr are
+ * adjusted rightward to align with the tab stop given by tabArrayPtr and
+ * index.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+AdjustForTab(
+ TkText *textPtr, /* Information about the text widget as a
+ * whole. */
+ TkTextTabArray *tabArrayPtr,/* Information about the tab stops that apply
+ * to this line. May be NULL to indicate
+ * default tabbing (every 8 chars). */
+ int index, /* Index of current tab stop. */
+ TkTextDispChunk *chunkPtr) /* Chunk whose last character is the tab; the
+ * following chunks contain information to be
+ * shifted right. */
+{
+ int x, desired, delta, width, decimal, i, gotDigit;
+ TkTextDispChunk *chunkPtr2, *decimalChunkPtr;
+ CharInfo *ciPtr;
+ int tabX, spaceWidth;
+ const char *p;
+ TkTextTabAlign alignment;
+
+ if (chunkPtr->nextPtr == NULL) {
+ /*
+ * Nothing after the actual tab; just return.
+ */
+
+ return;
+ }
+
+ x = chunkPtr->nextPtr->x;
+
+ /*
+ * If no tab information has been given, assuming tab stops are at 8
+ * average-sized characters. Still ensure we respect the tabular versus
+ * wordprocessor tab style.
+ */
+
+ if ((tabArrayPtr == NULL) || (tabArrayPtr->numTabs == 0)) {
+ /*
+ * No tab information has been given, so use the default
+ * interpretation of tabs.
+ */
+
+ if (textPtr->tabStyle == TK_TEXT_TABSTYLE_TABULAR) {
+ int tabWidth = Tk_TextWidth(textPtr->tkfont, "0", 1) * 8;
+ if (tabWidth == 0) {
+ tabWidth = 1;
+ }
+
+ desired = tabWidth * (index + 1);
+ } else {
+ desired = NextTabStop(textPtr->tkfont, x, 0);
+ }
+
+ goto update;
+ }
+
+ if (index < tabArrayPtr->numTabs) {
+ alignment = tabArrayPtr->tabs[index].alignment;
+ tabX = tabArrayPtr->tabs[index].location;
+ } else {
+ /*
+ * Ran out of tab stops; compute a tab position by extrapolating from
+ * the last two tab positions.
+ */
+
+ tabX = (int) (tabArrayPtr->lastTab +
+ (index + 1 - tabArrayPtr->numTabs)*tabArrayPtr->tabIncrement +
+ 0.5);
+ alignment = tabArrayPtr->tabs[tabArrayPtr->numTabs-1].alignment;
+ }
+
+ if (alignment == LEFT) {
+ desired = tabX;
+ goto update;
+ }
+
+ if ((alignment == CENTER) || (alignment == RIGHT)) {
+ /*
+ * Compute the width of all the information in the tab group, then use
+ * it to pick a desired location.
+ */
+
+ width = 0;
+ for (chunkPtr2 = chunkPtr->nextPtr; chunkPtr2 != NULL;
+ chunkPtr2 = chunkPtr2->nextPtr) {
+ width += chunkPtr2->width;
+ }
+ if (alignment == CENTER) {
+ desired = tabX - width/2;
+ } else {
+ desired = tabX - width;
+ }
+ goto update;
+ }
+
+ /*
+ * Must be numeric alignment. Search through the text to be tabbed,
+ * looking for the last , or . before the first character that isn't a
+ * number, comma, period, or sign.
+ */
+
+ decimalChunkPtr = NULL;
+ decimal = gotDigit = 0;
+ for (chunkPtr2 = chunkPtr->nextPtr; chunkPtr2 != NULL;
+ chunkPtr2 = chunkPtr2->nextPtr) {
+ if (chunkPtr2->displayProc != CharDisplayProc) {
+ continue;
+ }
+ ciPtr = chunkPtr2->clientData;
+ for (p = ciPtr->chars, i = 0; i < ciPtr->numBytes; p++, i++) {
+ if (isdigit(UCHAR(*p))) {
+ gotDigit = 1;
+ } else if ((*p == '.') || (*p == ',')) {
+ decimal = p-ciPtr->chars;
+ decimalChunkPtr = chunkPtr2;
+ } else if (gotDigit) {
+ if (decimalChunkPtr == NULL) {
+ decimal = p-ciPtr->chars;
+ decimalChunkPtr = chunkPtr2;
+ }
+ goto endOfNumber;
+ }
+ }
+ }
+
+ endOfNumber:
+ if (decimalChunkPtr != NULL) {
+ int curX;
+
+ ciPtr = decimalChunkPtr->clientData;
+ CharChunkMeasureChars(decimalChunkPtr, NULL, 0, 0, decimal,
+ decimalChunkPtr->x, -1, 0, &curX);
+ desired = tabX - (curX - x);
+ goto update;
+ }
+
+ /*
+ * There wasn't a decimal point. Right justify the text.
+ */
+
+ width = 0;
+ for (chunkPtr2 = chunkPtr->nextPtr; chunkPtr2 != NULL;
+ chunkPtr2 = chunkPtr2->nextPtr) {
+ width += chunkPtr2->width;
+ }
+ desired = tabX - width;
+
+ /*
+ * Shift all of the chunks to the right so that the left edge is at the
+ * desired location, then expand the chunk containing the tab. Be sure
+ * that the tab occupies at least the width of a space character.
+ */
+
+ update:
+ delta = desired - x;
+ MeasureChars(textPtr->tkfont, " ", 1, 0, 1, 0, -1, 0, &spaceWidth);
+ if (delta < spaceWidth) {
+ delta = spaceWidth;
+ }
+ for (chunkPtr2 = chunkPtr->nextPtr; chunkPtr2 != NULL;
+ chunkPtr2 = chunkPtr2->nextPtr) {
+ chunkPtr2->x += delta;
+ }
+ chunkPtr->width += delta;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * SizeOfTab --
+ *
+ * This returns an estimate of the amount of white space that will be
+ * consumed by a tab.
+ *
+ * Results:
+ * The return value is the minimum number of pixels that will be occupied
+ * by the next tab of tabArrayPtr, assuming that the current position on
+ * the line is x and the end of the line is maxX. The 'next tab' is
+ * determined by a combination of the current position (x) which it must
+ * be equal to or beyond, and the tab count in indexPtr.
+ *
+ * For numeric tabs, this is a conservative estimate. The return value is
+ * always >= 0.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+SizeOfTab(
+ TkText *textPtr, /* Information about the text widget as a
+ * whole. */
+ int tabStyle, /* One of TK_TEXT_TABSTYLE_TABULAR
+ * or TK_TEXT_TABSTYLE_WORDPROCESSOR. */
+ TkTextTabArray *tabArrayPtr,/* Information about the tab stops that apply
+ * to this line. NULL means use default
+ * tabbing (every 8 chars.) */
+ int *indexPtr, /* Contains index of previous tab stop, will
+ * be updated to reflect the number of stops
+ * used. */
+ int x, /* Current x-location in line. */
+ int maxX) /* X-location of pixel just past the right
+ * edge of the line. */
+{
+ int tabX, result, index, spaceWidth, tabWidth;
+ TkTextTabAlign alignment;
+
+ index = *indexPtr;
+
+ if ((tabArrayPtr == NULL) || (tabArrayPtr->numTabs == 0)) {
+ /*
+ * We're using a default tab spacing of 8 characters.
+ */
+
+ tabWidth = Tk_TextWidth(textPtr->tkfont, "0", 1) * 8;
+ if (tabWidth == 0) {
+ tabWidth = 1;
+ }
+ } else {
+ tabWidth = 0; /* Avoid compiler error. */
+ }
+
+ do {
+ /*
+ * We were given the count before this tab, so increment it first.
+ */
+
+ index++;
+
+ if ((tabArrayPtr == NULL) || (tabArrayPtr->numTabs == 0)) {
+ /*
+ * We're using a default tab spacing calculated above.
+ */
+
+ tabX = tabWidth * (index + 1);
+ alignment = LEFT;
+ } else if (index < tabArrayPtr->numTabs) {
+ tabX = tabArrayPtr->tabs[index].location;
+ alignment = tabArrayPtr->tabs[index].alignment;
+ } else {
+ /*
+ * Ran out of tab stops; compute a tab position by extrapolating.
+ */
+
+ tabX = (int) (tabArrayPtr->lastTab
+ + (index + 1 - tabArrayPtr->numTabs)
+ * tabArrayPtr->tabIncrement + 0.5);
+ alignment = tabArrayPtr->tabs[tabArrayPtr->numTabs-1].alignment;
+ }
+
+ /*
+ * If this tab stop is before the current x position, then we have two
+ * cases:
+ *
+ * With 'wordprocessor' style tabs, we must obviously continue until
+ * we reach the text tab stop.
+ *
+ * With 'tabular' style tabs, we always use the index'th tab stop.
+ */
+ } while (tabX <= x && (tabStyle == TK_TEXT_TABSTYLE_WORDPROCESSOR));
+
+ /*
+ * Inform our caller of how many tab stops we've used up.
+ */
+
+ *indexPtr = index;
+
+ if (alignment == CENTER) {
+ /*
+ * Be very careful in the arithmetic below, because maxX may be the
+ * largest positive number: watch out for integer overflow.
+ */
+
+ if ((maxX-tabX) < (tabX - x)) {
+ result = (maxX - x) - 2*(maxX - tabX);
+ } else {
+ result = 0;
+ }
+ goto done;
+ }
+ if (alignment == RIGHT) {
+ result = 0;
+ goto done;
+ }
+
+ /*
+ * Note: this treats NUMERIC alignment the same as LEFT alignment, which
+ * is somewhat conservative. However, it's pretty tricky at this point to
+ * figure out exactly where the damn decimal point will be.
+ */
+
+ if (tabX > x) {
+ result = tabX - x;
+ } else {
+ result = 0;
+ }
+
+ done:
+ MeasureChars(textPtr->tkfont, " ", 1, 0, 1, 0, -1, 0, &spaceWidth);
+ if (result < spaceWidth) {
+ result = spaceWidth;
+ }
+ return result;
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * NextTabStop --
+ *
+ * Given the current position, determine where the next default tab stop
+ * would be located. This function is called when the current chunk in
+ * the text has no tabs defined and so the default tab spacing for the
+ * font should be used, provided we are using wordprocessor style tabs.
+ *
+ * Results:
+ * The location in pixels of the next tab stop.
+ *
+ * Side effects:
+ * None.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+static int
+NextTabStop(
+ Tk_Font tkfont, /* Font in which chunk that contains tab stop
+ * will be drawn. */
+ int x, /* X-position in pixels where last character
+ * was drawn. The next tab stop occurs
+ * somewhere after this location. */
+ int tabOrigin) /* The origin for tab stops. May be non-zero
+ * if text has been scrolled. */
+{
+ int tabWidth, rem;
+
+ tabWidth = Tk_TextWidth(tkfont, "0", 1) * 8;
+ if (tabWidth == 0) {
+ tabWidth = 1;
+ }
+
+ x += tabWidth;
+ rem = (x - tabOrigin) % tabWidth;
+ if (rem < 0) {
+ rem += tabWidth;
+ }
+ x -= rem;
+ return x;
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * MeasureChars --
+ *
+ * Determine the number of characters from the string that will fit in
+ * the given horizontal span. The measurement is done under the
+ * assumption that Tk_DrawChars will be used to actually display the
+ * characters.
+ *
+ * If tabs are encountered in the string, they will be ignored (they
+ * should only occur as last character of the string anyway).
+ *
+ * If a newline is encountered in the string, the line will be broken at
+ * that point.
+ *
+ * Results:
+ * The return value is the number of bytes from the range of start to end
+ * in source that fit in the span given by startX and maxX. *nextXPtr is
+ * filled in with the x-coordinate at which the first character that
+ * didn't fit would be drawn, if it were to be drawn.
+ *
+ * Side effects:
+ * None.
+ *
+ *--------------------------------------------------------------
+ */
+
+static int
+MeasureChars(
+ Tk_Font tkfont, /* Font in which to draw characters. */
+ const char *source, /* Characters to be displayed. Need not be
+ * NULL-terminated. */
+ int maxBytes, /* Maximum # of bytes to consider from
+ * source. */
+ int rangeStart, int rangeLength,
+ /* Range of bytes to consider in source.*/
+ int startX, /* X-position at which first character will be
+ * drawn. */
+ int maxX, /* Don't consider any character that would
+ * cross this x-position. */
+ int flags, /* Flags to pass to Tk_MeasureChars. */
+ int *nextXPtr) /* Return x-position of terminating character
+ * here. */
+{
+ int curX, width, ch;
+ const char *special, *end, *start;
+
+ ch = 0; /* lint. */
+ curX = startX;
+ start = source + rangeStart;
+ end = start + rangeLength;
+ special = start;
+ while (start < end) {
+ if (start >= special) {
+ /*
+ * Find the next special character in the string.
+ */
+
+ for (special = start; special < end; special++) {
+ ch = *special;
+ if ((ch == '\t') || (ch == '\n')) {
+ break;
+ }
+ }
+ }
+
+ /*
+ * Special points at the next special character (or the end of the
+ * string). Process characters between start and special.
+ */
+
+ if ((maxX >= 0) && (curX >= maxX)) {
+ break;
+ }
+#if TK_DRAW_IN_CONTEXT
+ start += TkpMeasureCharsInContext(tkfont, source, maxBytes,
+ start - source, special - start,
+ maxX >= 0 ? maxX - curX : -1, flags, &width);
+#else
+ (void) maxBytes;
+ start += Tk_MeasureChars(tkfont, start, special - start,
+ maxX >= 0 ? maxX - curX : -1, flags, &width);
+#endif /* TK_DRAW_IN_CONTEXT */
+ curX += width;
+ if (start < special) {
+ /*
+ * No more chars fit in line.
+ */
+
+ break;
+ }
+ if (special < end) {
+ if (ch != '\t') {
+ break;
+ }
+ start++;
+ }
+ }
+
+ *nextXPtr = curX;
+ return start - (source+rangeStart);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TextGetScrollInfoObj --
+ *
+ * This function is invoked to parse "xview" and "yview" scrolling
+ * commands for text widgets using the new scrolling command syntax
+ * ("moveto" or "scroll" options). It extends the public
+ * Tk_GetScrollInfoObj function with the addition of "pixels" as a valid
+ * unit alongside "pages" and "units". It is a shame the core API isn't
+ * more flexible in this regard.
+ *
+ * Results:
+ * The return value is either TKTEXT_SCROLL_MOVETO, TKTEXT_SCROLL_PAGES,
+ * TKTEXT_SCROLL_UNITS, TKTEXT_SCROLL_PIXELS or TKTEXT_SCROLL_ERROR. This
+ * indicates whether the command was successfully parsed and what form
+ * the command took. If TKTEXT_SCROLL_MOVETO, *dblPtr is filled in with
+ * the desired position; if TKTEXT_SCROLL_PAGES, TKTEXT_SCROLL_PIXELS or
+ * TKTEXT_SCROLL_UNITS, *intPtr is filled in with the number of
+ * pages/pixels/lines to move (may be negative); if TKTEXT_SCROLL_ERROR,
+ * the interp's result contains an error message.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+TextGetScrollInfoObj(
+ Tcl_Interp *interp, /* Used for error reporting. */
+ TkText *textPtr, /* Information about the text widget. */
+ 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 or
+ * pixels to scroll, if any. */
+{
+ static const char *const subcommands[] = {
+ "moveto", "scroll", NULL
+ };
+ enum viewSubcmds {
+ VIEW_MOVETO, VIEW_SCROLL
+ };
+ static const char *const units[] = {
+ "units", "pages", "pixels", NULL
+ };
+ enum viewUnits {
+ VIEW_SCROLL_UNITS, VIEW_SCROLL_PAGES, VIEW_SCROLL_PIXELS
+ };
+ int index;
+
+ if (Tcl_GetIndexFromObjStruct(interp, objv[2], subcommands,
+ sizeof(char *), "option", 0, &index) != TCL_OK) {
+ return TKTEXT_SCROLL_ERROR;
+ }
+
+ switch ((enum viewSubcmds) index) {
+ case VIEW_MOVETO:
+ if (objc != 4) {
+ Tcl_WrongNumArgs(interp, 3, objv, "fraction");
+ return TKTEXT_SCROLL_ERROR;
+ }
+ if (Tcl_GetDoubleFromObj(interp, objv[3], dblPtr) != TCL_OK) {
+ return TKTEXT_SCROLL_ERROR;
+ }
+ return TKTEXT_SCROLL_MOVETO;
+ case VIEW_SCROLL:
+ if (objc != 5) {
+ Tcl_WrongNumArgs(interp, 3, objv, "number units|pages|pixels");
+ return TKTEXT_SCROLL_ERROR;
+ }
+ if (Tcl_GetIndexFromObjStruct(interp, objv[4], units,
+ sizeof(char *), "argument", 0, &index) != TCL_OK) {
+ return TKTEXT_SCROLL_ERROR;
+ }
+ switch ((enum viewUnits) index) {
+ case VIEW_SCROLL_PAGES:
+ if (Tcl_GetIntFromObj(interp, objv[3], intPtr) != TCL_OK) {
+ return TKTEXT_SCROLL_ERROR;
+ }
+ return TKTEXT_SCROLL_PAGES;
+ case VIEW_SCROLL_PIXELS:
+ if (Tk_GetPixelsFromObj(interp, textPtr->tkwin, objv[3],
+ intPtr) != TCL_OK) {
+ return TKTEXT_SCROLL_ERROR;
+ }
+ return TKTEXT_SCROLL_PIXELS;
+ case VIEW_SCROLL_UNITS:
+ if (Tcl_GetIntFromObj(interp, objv[3], intPtr) != TCL_OK) {
+ return TKTEXT_SCROLL_ERROR;
+ }
+ return TKTEXT_SCROLL_UNITS;
+ }
+ }
+ Tcl_Panic("unexpected switch fallthrough");
+ return TKTEXT_SCROLL_ERROR;
+}
+
+#if TK_LAYOUT_WITH_BASE_CHUNKS
+/*
+ *----------------------------------------------------------------------
+ *
+ * FinalizeBaseChunk --
+ *
+ * This procedure makes sure that all the chunks of the stretch are
+ * up-to-date. It is invoked when the LayoutProc has been called for all
+ * chunks and the base chunk is stable.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The CharInfo.chars of all dependent chunks point into
+ * BaseCharInfo.baseChars for easy access (and compatibility).
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+FinalizeBaseChunk(
+ TkTextDispChunk *addChunkPtr)
+ /* An additional chunk to add to the stretch,
+ * even though it may not be in the linked
+ * list yet. Used by the LayoutProc, otherwise
+ * NULL. */
+{
+ const char *baseChars;
+ TkTextDispChunk *chunkPtr;
+ CharInfo *ciPtr;
+#if TK_DRAW_IN_CONTEXT
+ int widthAdjust = 0;
+ int newwidth;
+#endif /* TK_DRAW_IN_CONTEXT */
+
+ if (baseCharChunkPtr == NULL) {
+ return;
+ }
+
+ baseChars = Tcl_DStringValue(
+ &((BaseCharInfo *) baseCharChunkPtr->clientData)->baseChars);
+
+ for (chunkPtr = baseCharChunkPtr; chunkPtr != NULL;
+ chunkPtr = chunkPtr->nextPtr) {
+#if TK_DRAW_IN_CONTEXT
+ chunkPtr->x += widthAdjust;
+#endif /* TK_DRAW_IN_CONTEXT */
+
+ if (chunkPtr->displayProc != CharDisplayProc) {
+ continue;
+ }
+ ciPtr = chunkPtr->clientData;
+ if (ciPtr->baseChunkPtr != baseCharChunkPtr) {
+ break;
+ }
+ ciPtr->chars = baseChars + ciPtr->baseOffset;
+
+#if TK_DRAW_IN_CONTEXT
+ newwidth = 0;
+ CharChunkMeasureChars(chunkPtr, NULL, 0, 0, -1, 0, -1, 0, &newwidth);
+ if (newwidth != chunkPtr->width) {
+ widthAdjust += newwidth - chunkPtr->width;
+ chunkPtr->width = newwidth;
+ }
+#endif /* TK_DRAW_IN_CONTEXT */
+ }
+
+ if (addChunkPtr != NULL) {
+ ciPtr = addChunkPtr->clientData;
+ ciPtr->chars = baseChars + ciPtr->baseOffset;
+
+#if TK_DRAW_IN_CONTEXT
+ addChunkPtr->x += widthAdjust;
+ CharChunkMeasureChars(addChunkPtr, NULL, 0, 0, -1, 0, -1, 0,
+ &addChunkPtr->width);
+#endif /* TK_DRAW_IN_CONTEXT */
+ }
+
+ baseCharChunkPtr = NULL;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * FreeBaseChunk --
+ *
+ * This procedure makes sure that all the chunks of the stretch are
+ * disconnected from the base chunk and the base chunk specific data is
+ * freed. It is invoked from the UndisplayProc. The procedure doesn't
+ * ckfree the base chunk clientData itself, that's up to the main
+ * UndisplayProc.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The CharInfo.chars of all dependent chunks are set to NULL. Memory
+ * that belongs specifically to the base chunk is freed.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+FreeBaseChunk(
+ TkTextDispChunk *baseChunkPtr)
+ /* The base chunk of the stretch and head of
+ * the linked list. */
+{
+ TkTextDispChunk *chunkPtr;
+ CharInfo *ciPtr;
+
+ if (baseCharChunkPtr == baseChunkPtr) {
+ baseCharChunkPtr = NULL;
+ }
+
+ for (chunkPtr=baseChunkPtr; chunkPtr!=NULL; chunkPtr=chunkPtr->nextPtr) {
+ if (chunkPtr->undisplayProc != CharUndisplayProc) {
+ continue;
+ }
+ ciPtr = chunkPtr->clientData;
+ if (ciPtr->baseChunkPtr != baseChunkPtr) {
+ break;
+ }
+
+ ciPtr->baseChunkPtr = NULL;
+ ciPtr->chars = NULL;
+ }
+
+ if (baseChunkPtr) {
+ Tcl_DStringFree(&((BaseCharInfo *) baseChunkPtr->clientData)->baseChars);
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * IsSameFGStyle --
+ *
+ * Compare the foreground attributes of two styles. Specifically must
+ * consider: foreground color, font, font style and font decorations,
+ * elide, "offset" and foreground stipple. Do *not* consider: background
+ * color, border, relief or background stipple.
+ *
+ * If we use TkpDrawCharsInContext(), we also don't need to check
+ * foreground color, font decorations, elide, offset and foreground
+ * stipple, so all that is left is font (including font size and font
+ * style) and "offset".
+ *
+ * Results:
+ * 1 if the two styles match, 0 otherwise.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+IsSameFGStyle(
+ TextStyle *style1,
+ TextStyle *style2)
+{
+ StyleValues *sv1;
+ StyleValues *sv2;
+
+ if (style1 == style2) {
+ return 1;
+ }
+
+#if !TK_DRAW_IN_CONTEXT
+ if (
+#ifdef MAC_OSX_TK
+ !TkMacOSXCompareColors(style1->fgGC->foreground,
+ style2->fgGC->foreground)
+#else
+ style1->fgGC->foreground != style2->fgGC->foreground
+#endif
+ ) {
+ return 0;
+ }
+#endif /* !TK_DRAW_IN_CONTEXT */
+
+ sv1 = style1->sValuePtr;
+ sv2 = style2->sValuePtr;
+
+#if TK_DRAW_IN_CONTEXT
+ return sv1->tkfont == sv2->tkfont && sv1->offset == sv2->offset;
+#else
+ return sv1->tkfont == sv2->tkfont
+ && sv1->underline == sv2->underline
+ && sv1->overstrike == sv2->overstrike
+ && sv1->elide == sv2->elide
+ && sv1->offset == sv2->offset
+ && sv1->fgStipple == sv1->fgStipple;
+#endif /* TK_DRAW_IN_CONTEXT */
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * RemoveFromBaseChunk --
+ *
+ * This procedure removes a chunk from the stretch as a result of
+ * UndisplayProc. The chunk in question should be the last in a stretch.
+ * This happens during re-layouting of the break position.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The characters that belong to this chunk are removed from the base
+ * chunk. It is assumed that LayoutProc and FinalizeBaseChunk are called
+ * next to repair any damage that this causes to the integrity of the
+ * stretch and the other chunks. For that reason the base chunk is also
+ * put into baseCharChunkPtr automatically, so that LayoutProc can resume
+ * correctly.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+RemoveFromBaseChunk(
+ TkTextDispChunk *chunkPtr) /* The chunk to remove from the end of the
+ * stretch. */
+{
+ CharInfo *ciPtr;
+ BaseCharInfo *bciPtr;
+
+ if (chunkPtr->displayProc != CharDisplayProc) {
+#ifdef DEBUG_LAYOUT_WITH_BASE_CHUNKS
+ fprintf(stderr,"RemoveFromBaseChunk called with wrong chunk type\n");
+#endif
+ return;
+ }
+
+ /*
+ * Reinstitute this base chunk for re-layout.
+ */
+
+ ciPtr = chunkPtr->clientData;
+ baseCharChunkPtr = ciPtr->baseChunkPtr;
+
+ /*
+ * Remove the chunk data from the base chunk data.
+ */
+
+ bciPtr = baseCharChunkPtr->clientData;
+
+ if ((ciPtr->baseOffset + ciPtr->numBytes)
+ != Tcl_DStringLength(&bciPtr->baseChars)) {
+#ifdef DEBUG_LAYOUT_WITH_BASE_CHUNKS
+ fprintf(stderr,"RemoveFromBaseChunk called with wrong chunk "
+ "(not last)\n");
+#endif
+ }
+
+ Tcl_DStringSetLength(&bciPtr->baseChars, ciPtr->baseOffset);
+
+ /*
+ * Invalidate the stored pixel width of the base chunk.
+ */
+
+ bciPtr->width = -1;
+}
+#endif /* TK_LAYOUT_WITH_BASE_CHUNKS */
+
+/*
+ * Local Variables:
+ * mode: c
+ * c-basic-offset: 4
+ * fill-column: 78
+ * End:
+ */
diff --git a/tk8.6/generic/tkTextImage.c b/tk8.6/generic/tkTextImage.c
new file mode 100644
index 0000000..41dd448
--- /dev/null
+++ b/tk8.6/generic/tkTextImage.c
@@ -0,0 +1,855 @@
+/*
+ * tkImage.c --
+ *
+ * This file contains code that allows images to be nested inside text
+ * widgets. It also implements the "image" widget command for texts.
+ *
+ * Copyright (c) 1997 Sun Microsystems, Inc.
+ *
+ * See the file "license.terms" for information on usage and redistribution of
+ * this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ */
+
+#include "tkPort.h"
+#include "tkText.h"
+
+/*
+ * Macro that determines the size of an embedded image segment:
+ */
+
+#define EI_SEG_SIZE \
+ ((unsigned) (Tk_Offset(TkTextSegment, body) + sizeof(TkTextEmbImage)))
+
+/*
+ * Prototypes for functions defined in this file:
+ */
+
+static TkTextSegment * EmbImageCleanupProc(TkTextSegment *segPtr,
+ TkTextLine *linePtr);
+static void EmbImageCheckProc(TkTextSegment *segPtr,
+ TkTextLine *linePtr);
+static void EmbImageBboxProc(TkText *textPtr,
+ TkTextDispChunk *chunkPtr, int index, int y,
+ int lineHeight, int baseline, int *xPtr, int *yPtr,
+ int *widthPtr, int *heightPtr);
+static int EmbImageConfigure(TkText *textPtr,
+ TkTextSegment *eiPtr, int objc,
+ Tcl_Obj *const objv[]);
+static int EmbImageDeleteProc(TkTextSegment *segPtr,
+ TkTextLine *linePtr, int treeGone);
+static void EmbImageDisplayProc(TkText *textPtr,
+ TkTextDispChunk *chunkPtr, int x, int y,
+ int lineHeight, int baseline, Display *display,
+ Drawable dst, int screenY);
+static int EmbImageLayoutProc(TkText *textPtr,
+ TkTextIndex *indexPtr, TkTextSegment *segPtr,
+ int offset, int maxX, int maxChars,
+ int noCharsYet, TkWrapMode wrapMode,
+ TkTextDispChunk *chunkPtr);
+static void EmbImageProc(ClientData clientData, int x, int y,
+ int width, int height, int imageWidth,
+ int imageHeight);
+
+/*
+ * The following structure declares the "embedded image" segment type.
+ */
+
+const Tk_SegType tkTextEmbImageType = {
+ "image", /* name */
+ 0, /* leftGravity */
+ NULL, /* splitProc */
+ EmbImageDeleteProc, /* deleteProc */
+ EmbImageCleanupProc, /* cleanupProc */
+ NULL, /* lineChangeProc */
+ EmbImageLayoutProc, /* layoutProc */
+ EmbImageCheckProc /* checkProc */
+};
+
+/*
+ * Definitions for alignment values:
+ */
+
+static const char *const alignStrings[] = {
+ "baseline", "bottom", "center", "top", NULL
+};
+
+typedef enum {
+ ALIGN_BASELINE, ALIGN_BOTTOM, ALIGN_CENTER, ALIGN_TOP
+} alignMode;
+
+/*
+ * Information used for parsing image configuration options:
+ */
+
+static const Tk_OptionSpec optionSpecs[] = {
+ {TK_OPTION_STRING_TABLE, "-align", NULL, NULL,
+ "center", -1, Tk_Offset(TkTextEmbImage, align),
+ 0, alignStrings, 0},
+ {TK_OPTION_PIXELS, "-padx", NULL, NULL,
+ "0", -1, Tk_Offset(TkTextEmbImage, padX), 0, 0, 0},
+ {TK_OPTION_PIXELS, "-pady", NULL, NULL,
+ "0", -1, Tk_Offset(TkTextEmbImage, padY), 0, 0, 0},
+ {TK_OPTION_STRING, "-image", NULL, NULL,
+ NULL, -1, Tk_Offset(TkTextEmbImage, imageString),
+ TK_OPTION_NULL_OK, 0, 0},
+ {TK_OPTION_STRING, "-name", NULL, NULL,
+ NULL, -1, Tk_Offset(TkTextEmbImage, imageName),
+ TK_OPTION_NULL_OK, 0, 0},
+ {TK_OPTION_END, NULL, NULL, NULL, NULL, 0, 0, 0, 0, 0}
+};
+
+/*
+ *--------------------------------------------------------------
+ *
+ * TkTextImageCmd --
+ *
+ * This function implements the "image" widget command for text widgets.
+ * See the user documentation for details on what it does.
+ *
+ * Results:
+ * A standard Tcl result or error.
+ *
+ * Side effects:
+ * See the user documentation.
+ *
+ *--------------------------------------------------------------
+ */
+
+int
+TkTextImageCmd(
+ register TkText *textPtr, /* Information about text widget. */
+ Tcl_Interp *interp, /* Current interpreter. */
+ int objc, /* Number of arguments. */
+ Tcl_Obj *const objv[]) /* Argument objects. Someone else has already
+ * parsed this command enough to know that
+ * objv[1] is "image". */
+{
+ int idx;
+ register TkTextSegment *eiPtr;
+ TkTextIndex index;
+ static const char *const optionStrings[] = {
+ "cget", "configure", "create", "names", NULL
+ };
+ enum opts {
+ CMD_CGET, CMD_CONF, CMD_CREATE, CMD_NAMES
+ };
+
+ if (objc < 3) {
+ Tcl_WrongNumArgs(interp, 2, objv, "option ?arg ...?");
+ return TCL_ERROR;
+ }
+ if (Tcl_GetIndexFromObjStruct(interp, objv[2], optionStrings,
+ sizeof(char *), "option", 0, &idx) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ switch ((enum opts) idx) {
+ case CMD_CGET: {
+ Tcl_Obj *objPtr;
+
+ if (objc != 5) {
+ Tcl_WrongNumArgs(interp, 3, objv, "index option");
+ return TCL_ERROR;
+ }
+ if (TkTextGetObjIndex(interp, textPtr, objv[3], &index) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ eiPtr = TkTextIndexToSeg(&index, NULL);
+ if (eiPtr->typePtr != &tkTextEmbImageType) {
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "no embedded image at index \"%s\"",
+ Tcl_GetString(objv[3])));
+ Tcl_SetErrorCode(interp, "TK", "TEXT", "NO_IMAGE", NULL);
+ return TCL_ERROR;
+ }
+ objPtr = Tk_GetOptionValue(interp, (char *) &eiPtr->body.ei,
+ eiPtr->body.ei.optionTable, objv[4], textPtr->tkwin);
+ if (objPtr == NULL) {
+ return TCL_ERROR;
+ } else {
+ Tcl_SetObjResult(interp, objPtr);
+ return TCL_OK;
+ }
+ }
+ case CMD_CONF:
+ if (objc < 4) {
+ Tcl_WrongNumArgs(interp, 3, objv, "index ?-option value ...?");
+ return TCL_ERROR;
+ }
+ if (TkTextGetObjIndex(interp, textPtr, objv[3], &index) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ eiPtr = TkTextIndexToSeg(&index, NULL);
+ if (eiPtr->typePtr != &tkTextEmbImageType) {
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "no embedded image at index \"%s\"",
+ Tcl_GetString(objv[3])));
+ Tcl_SetErrorCode(interp, "TK", "TEXT", "NO_IMAGE", NULL);
+ return TCL_ERROR;
+ }
+ if (objc <= 5) {
+ Tcl_Obj *objPtr = Tk_GetOptionInfo(interp,
+ (char *) &eiPtr->body.ei, eiPtr->body.ei.optionTable,
+ (objc == 5) ? objv[4] : NULL, textPtr->tkwin);
+
+ if (objPtr == NULL) {
+ return TCL_ERROR;
+ } else {
+ Tcl_SetObjResult(interp, objPtr);
+ return TCL_OK;
+ }
+ } else {
+ TkTextChanged(textPtr->sharedTextPtr, NULL, &index, &index);
+
+ /*
+ * It's probably not true that all window configuration can change
+ * the line height, so we could be more efficient here and only
+ * call this when necessary.
+ */
+
+ TkTextInvalidateLineMetrics(textPtr->sharedTextPtr, NULL,
+ index.linePtr, 0, TK_TEXT_INVALIDATE_ONLY);
+ return EmbImageConfigure(textPtr, eiPtr, objc-4, objv+4);
+ }
+ case CMD_CREATE: {
+ int lineIndex;
+
+ /*
+ * Add a new image. Find where to put the new image, and mark that
+ * position for redisplay.
+ */
+
+ if (objc < 4) {
+ Tcl_WrongNumArgs(interp, 3, objv, "index ?-option value ...?");
+ return TCL_ERROR;
+ }
+ if (TkTextGetObjIndex(interp, textPtr, objv[3], &index) != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ /*
+ * Don't allow insertions on the last (dummy) line of the text.
+ */
+
+ lineIndex = TkBTreeLinesTo(textPtr, index.linePtr);
+ if (lineIndex == TkBTreeNumLines(textPtr->sharedTextPtr->tree,
+ textPtr)) {
+ lineIndex--;
+ TkTextMakeByteIndex(textPtr->sharedTextPtr->tree, textPtr,
+ lineIndex, 1000000, &index);
+ }
+
+ /*
+ * Create the new image segment and initialize it.
+ */
+
+ eiPtr = ckalloc(EI_SEG_SIZE);
+ eiPtr->typePtr = &tkTextEmbImageType;
+ eiPtr->size = 1;
+ eiPtr->body.ei.sharedTextPtr = textPtr->sharedTextPtr;
+ eiPtr->body.ei.linePtr = NULL;
+ eiPtr->body.ei.imageName = NULL;
+ eiPtr->body.ei.imageString = NULL;
+ eiPtr->body.ei.name = NULL;
+ eiPtr->body.ei.image = NULL;
+ eiPtr->body.ei.align = ALIGN_CENTER;
+ eiPtr->body.ei.padX = eiPtr->body.ei.padY = 0;
+ eiPtr->body.ei.chunkCount = 0;
+ eiPtr->body.ei.optionTable = Tk_CreateOptionTable(interp, optionSpecs);
+
+ /*
+ * Link the segment into the text widget, then configure it (delete it
+ * again if the configuration fails).
+ */
+
+ TkTextChanged(textPtr->sharedTextPtr, NULL, &index, &index);
+ TkBTreeLinkSegment(eiPtr, &index);
+ if (EmbImageConfigure(textPtr, eiPtr, objc-4, objv+4) != TCL_OK) {
+ TkTextIndex index2;
+
+ TkTextIndexForwChars(NULL, &index, 1, &index2, COUNT_INDICES);
+ TkBTreeDeleteIndexRange(textPtr->sharedTextPtr->tree, &index, &index2);
+ return TCL_ERROR;
+ }
+ TkTextInvalidateLineMetrics(textPtr->sharedTextPtr, NULL,
+ index.linePtr, 0, TK_TEXT_INVALIDATE_ONLY);
+ return TCL_OK;
+ }
+ case CMD_NAMES: {
+ Tcl_HashSearch search;
+ Tcl_HashEntry *hPtr;
+ Tcl_Obj *resultObj;
+
+ if (objc != 3) {
+ Tcl_WrongNumArgs(interp, 3, objv, NULL);
+ return TCL_ERROR;
+ }
+ resultObj = Tcl_NewObj();
+ for (hPtr = Tcl_FirstHashEntry(&textPtr->sharedTextPtr->imageTable,
+ &search); hPtr != NULL; hPtr = Tcl_NextHashEntry(&search)) {
+ Tcl_ListObjAppendElement(NULL, resultObj, Tcl_NewStringObj(
+ Tcl_GetHashKey(&textPtr->sharedTextPtr->markTable, hPtr),
+ -1));
+ }
+ Tcl_SetObjResult(interp, resultObj);
+ return TCL_OK;
+ }
+ default:
+ Tcl_Panic("unexpected switch fallthrough");
+ }
+ return TCL_ERROR;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * EmbImageConfigure --
+ *
+ * This function is called to handle configuration options for an
+ * embedded image, using an objc/objv list.
+ *
+ * Results:
+ * The return value is a standard Tcl result. If TCL_ERROR is returned,
+ * then the interp's result contains an error message..
+ *
+ * Side effects:
+ * Configuration information for the embedded image changes, such as
+ * alignment, or name of the image.
+ *
+ *--------------------------------------------------------------
+ */
+
+static int
+EmbImageConfigure(
+ TkText *textPtr, /* Information about text widget that contains
+ * embedded image. */
+ TkTextSegment *eiPtr, /* Embedded image to be configured. */
+ int objc, /* Number of strings in objv. */
+ Tcl_Obj *const objv[]) /* Array of strings describing configuration
+ * options. */
+{
+ Tk_Image image;
+ Tcl_DString newName;
+ Tcl_HashEntry *hPtr;
+ Tcl_HashSearch search;
+ char *name;
+ int dummy;
+ int count = 0; /* The counter for picking a unique name */
+ int conflict = 0; /* True if we have a name conflict */
+ size_t len; /* length of image name */
+
+ if (Tk_SetOptions(textPtr->interp, (char *) &eiPtr->body.ei,
+ eiPtr->body.ei.optionTable,
+ objc, objv, textPtr->tkwin, NULL, NULL) != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ /*
+ * Create the image. Save the old image around and don't free it until
+ * after the new one is allocated. This keeps the reference count from
+ * going to zero so the image doesn't have to be recreated if it hasn't
+ * changed.
+ */
+
+ if (eiPtr->body.ei.imageString != NULL) {
+ image = Tk_GetImage(textPtr->interp, textPtr->tkwin,
+ eiPtr->body.ei.imageString, EmbImageProc, eiPtr);
+ if (image == NULL) {
+ return TCL_ERROR;
+ }
+ } else {
+ image = NULL;
+ }
+ if (eiPtr->body.ei.image != NULL) {
+ Tk_FreeImage(eiPtr->body.ei.image);
+ }
+ eiPtr->body.ei.image = image;
+
+ if (eiPtr->body.ei.name != NULL) {
+ return TCL_OK;
+ }
+
+ /*
+ * Find a unique name for this image. Use imageName (or imageString) if
+ * available, otherwise tack on a #nn and use it. If a name is already
+ * associated with this image, delete the name.
+ */
+
+ name = eiPtr->body.ei.imageName;
+ if (name == NULL) {
+ name = eiPtr->body.ei.imageString;
+ }
+ if (name == NULL) {
+ Tcl_SetObjResult(textPtr->interp, Tcl_NewStringObj(
+ "Either a \"-name\" or a \"-image\" argument must be"
+ " provided to the \"image create\" subcommand", -1));
+ Tcl_SetErrorCode(textPtr->interp, "TK", "TEXT", "IMAGE_CREATE_USAGE",
+ NULL);
+ return TCL_ERROR;
+ }
+ len = strlen(name);
+ for (hPtr = Tcl_FirstHashEntry(&textPtr->sharedTextPtr->imageTable,
+ &search); hPtr != NULL; hPtr = Tcl_NextHashEntry(&search)) {
+ char *haveName =
+ Tcl_GetHashKey(&textPtr->sharedTextPtr->imageTable, hPtr);
+
+ if (strncmp(name, haveName, len) == 0) {
+ int newVal = 0;
+
+ sscanf(haveName+len, "#%d", &newVal);
+ if (newVal > count) {
+ count = newVal;
+ }
+ if (len == strlen(haveName)) {
+ conflict = 1;
+ }
+ }
+ }
+
+ Tcl_DStringInit(&newName);
+ Tcl_DStringAppend(&newName, name, -1);
+
+ if (conflict) {
+ char buf[4 + TCL_INTEGER_SPACE];
+
+ sprintf(buf, "#%d", count+1);
+ Tcl_DStringAppend(&newName, buf, -1);
+ }
+ name = Tcl_DStringValue(&newName);
+ hPtr = Tcl_CreateHashEntry(&textPtr->sharedTextPtr->imageTable, name,
+ &dummy);
+ Tcl_SetHashValue(hPtr, eiPtr);
+ Tcl_SetObjResult(textPtr->interp, Tcl_NewStringObj(name, -1));
+ eiPtr->body.ei.name = ckalloc(Tcl_DStringLength(&newName) + 1);
+ strcpy(eiPtr->body.ei.name, name);
+ Tcl_DStringFree(&newName);
+
+ return TCL_OK;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * EmbImageDeleteProc --
+ *
+ * This function is invoked by the text B-tree code whenever an embedded
+ * image lies in a range of characters being deleted.
+ *
+ * Results:
+ * Returns 0 to indicate that the deletion has been accepted.
+ *
+ * Side effects:
+ * The embedded image is deleted, if it exists, and any resources
+ * associated with it are released.
+ *
+ *--------------------------------------------------------------
+ */
+
+ /* ARGSUSED */
+static int
+EmbImageDeleteProc(
+ TkTextSegment *eiPtr, /* Segment being deleted. */
+ TkTextLine *linePtr, /* Line containing segment. */
+ int treeGone) /* Non-zero means the entire tree is being
+ * deleted, so everything must get cleaned
+ * up. */
+{
+ Tcl_HashEntry *hPtr;
+
+ if (eiPtr->body.ei.image != NULL) {
+ hPtr = Tcl_FindHashEntry(&eiPtr->body.ei.sharedTextPtr->imageTable,
+ eiPtr->body.ei.name);
+ if (hPtr != NULL) {
+ /*
+ * (It's possible for there to be no hash table entry for this
+ * image, if an error occurred while creating the image segment
+ * but before the image got added to the table)
+ */
+
+ Tcl_DeleteHashEntry(hPtr);
+ }
+ Tk_FreeImage(eiPtr->body.ei.image);
+ }
+
+ /*
+ * No need to supply a tkwin argument, since we have no window-specific
+ * options.
+ */
+
+ Tk_FreeConfigOptions((char *) &eiPtr->body.ei, eiPtr->body.ei.optionTable,
+ NULL);
+ if (eiPtr->body.ei.name) {
+ ckfree(eiPtr->body.ei.name);
+ }
+ ckfree(eiPtr);
+ return 0;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * EmbImageCleanupProc --
+ *
+ * This function is invoked by the B-tree code whenever a segment
+ * containing an embedded image is moved from one line to another.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The linePtr field of the segment gets updated.
+ *
+ *--------------------------------------------------------------
+ */
+
+static TkTextSegment *
+EmbImageCleanupProc(
+ TkTextSegment *eiPtr, /* Mark segment that's being moved. */
+ TkTextLine *linePtr) /* Line that now contains segment. */
+{
+ eiPtr->body.ei.linePtr = linePtr;
+ return eiPtr;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * EmbImageLayoutProc --
+ *
+ * This function is the "layoutProc" for embedded image segments.
+ *
+ * Results:
+ * 1 is returned to indicate that the segment should be displayed. The
+ * chunkPtr structure is filled in.
+ *
+ * Side effects:
+ * None, except for filling in chunkPtr.
+ *
+ *--------------------------------------------------------------
+ */
+
+ /*ARGSUSED*/
+static int
+EmbImageLayoutProc(
+ TkText *textPtr, /* Text widget being layed out. */
+ TkTextIndex *indexPtr, /* Identifies first character in chunk. */
+ TkTextSegment *eiPtr, /* Segment corresponding to indexPtr. */
+ int offset, /* Offset within segPtr corresponding to
+ * indexPtr (always 0). */
+ int maxX, /* Chunk must not occupy pixels at this
+ * position or higher. */
+ int maxChars, /* Chunk must not include more than this many
+ * characters. */
+ int noCharsYet, /* Non-zero means no characters have been
+ * assigned to this line yet. */
+ TkWrapMode wrapMode, /* Wrap mode to use for line:
+ * TEXT_WRAPMODE_CHAR, TEXT_WRAPMODE_NONE, or
+ * TEXT_WRAPMODE_WORD. */
+ register TkTextDispChunk *chunkPtr)
+ /* Structure to fill in with information about
+ * this chunk. The x field has already been
+ * set by the caller. */
+{
+ int width, height;
+
+ if (offset != 0) {
+ Tcl_Panic("Non-zero offset in EmbImageLayoutProc");
+ }
+
+ /*
+ * See if there's room for this image on this line.
+ */
+
+ if (eiPtr->body.ei.image == NULL) {
+ width = 0;
+ height = 0;
+ } else {
+ Tk_SizeOfImage(eiPtr->body.ei.image, &width, &height);
+ width += 2*eiPtr->body.ei.padX;
+ height += 2*eiPtr->body.ei.padY;
+ }
+ if ((width > (maxX - chunkPtr->x))
+ && !noCharsYet && (textPtr->wrapMode != TEXT_WRAPMODE_NONE)) {
+ return 0;
+ }
+
+ /*
+ * Fill in the chunk structure.
+ */
+
+ chunkPtr->displayProc = EmbImageDisplayProc;
+ chunkPtr->undisplayProc = NULL;
+ chunkPtr->measureProc = NULL;
+ chunkPtr->bboxProc = EmbImageBboxProc;
+ chunkPtr->numBytes = 1;
+ if (eiPtr->body.ei.align == ALIGN_BASELINE) {
+ chunkPtr->minAscent = height - eiPtr->body.ei.padY;
+ chunkPtr->minDescent = eiPtr->body.ei.padY;
+ chunkPtr->minHeight = 0;
+ } else {
+ chunkPtr->minAscent = 0;
+ chunkPtr->minDescent = 0;
+ chunkPtr->minHeight = height;
+ }
+ chunkPtr->width = width;
+ chunkPtr->breakIndex = -1;
+ chunkPtr->breakIndex = 1;
+ chunkPtr->clientData = eiPtr;
+ eiPtr->body.ei.chunkCount += 1;
+ return 1;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * EmbImageCheckProc --
+ *
+ * This function is invoked by the B-tree code to perform consistency
+ * checks on embedded images.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The function panics if it detects anything wrong with the embedded
+ * image.
+ *
+ *--------------------------------------------------------------
+ */
+
+static void
+EmbImageCheckProc(
+ TkTextSegment *eiPtr, /* Segment to check. */
+ TkTextLine *linePtr) /* Line containing segment. */
+{
+ if (eiPtr->nextPtr == NULL) {
+ Tcl_Panic("EmbImageCheckProc: embedded image is last segment in line");
+ }
+ if (eiPtr->size != 1) {
+ Tcl_Panic("EmbImageCheckProc: embedded image has size %d",
+ eiPtr->size);
+ }
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * EmbImageDisplayProc --
+ *
+ * This function is invoked by the text displaying code when it is time
+ * to actually draw an embedded image chunk on the screen.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The embedded image gets moved to the correct location and drawn onto
+ * the display.
+ *
+ *--------------------------------------------------------------
+ */
+
+static void
+EmbImageDisplayProc(
+ TkText *textPtr,
+ TkTextDispChunk *chunkPtr, /* Chunk that is to be drawn. */
+ int x, /* X-position in dst at which to draw this
+ * chunk (differs from the x-position in the
+ * chunk because of scrolling). */
+ int y, /* Top of rectangular bounding box for line:
+ * tells where to draw this chunk in dst
+ * (x-position is in the chunk itself). */
+ int lineHeight, /* Total height of line. */
+ int baseline, /* Offset of baseline from y. */
+ Display *display, /* Display to use for drawing. */
+ Drawable dst, /* Pixmap or window in which to draw */
+ int screenY) /* Y-coordinate in text window that
+ * corresponds to y. */
+{
+ TkTextSegment *eiPtr = chunkPtr->clientData;
+ int lineX, imageX, imageY, width, height;
+ Tk_Image image;
+
+ image = eiPtr->body.ei.image;
+ if (image == NULL) {
+ return;
+ }
+ if ((x + chunkPtr->width) <= 0) {
+ return;
+ }
+
+ /*
+ * Compute the image's location and size in the text widget, taking into
+ * account the align value for the image.
+ */
+
+ EmbImageBboxProc(textPtr, chunkPtr, 0, y, lineHeight, baseline, &lineX,
+ &imageY, &width, &height);
+ imageX = lineX - chunkPtr->x + x;
+
+ Tk_RedrawImage(image, 0, 0, width, height, dst, imageX, imageY);
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * EmbImageBboxProc --
+ *
+ * This function is called to compute the bounding box of the area
+ * occupied by an embedded image.
+ *
+ * Results:
+ * There is no return value. *xPtr and *yPtr are filled in with the
+ * coordinates of the upper left corner of the image, and *widthPtr and
+ * *heightPtr are filled in with the dimensions of the image in pixels.
+ * Note: not all of the returned bbox is necessarily visible on the
+ * screen (the rightmost part might be off-screen to the right, and the
+ * bottommost part might be off-screen to the bottom).
+ *
+ * Side effects:
+ * None.
+ *
+ *--------------------------------------------------------------
+ */
+
+static void
+EmbImageBboxProc(
+ TkText *textPtr,
+ TkTextDispChunk *chunkPtr, /* Chunk containing desired char. */
+ int index, /* Index of desired character within the
+ * chunk. */
+ int y, /* Topmost pixel in area allocated for this
+ * line. */
+ int lineHeight, /* Total height of line. */
+ int baseline, /* Location of line's baseline, in pixels
+ * measured down from y. */
+ int *xPtr, int *yPtr, /* Gets filled in with coords of character's
+ * upper-left pixel. */
+ int *widthPtr, /* Gets filled in with width of image, in
+ * pixels. */
+ int *heightPtr) /* Gets filled in with height of image, in
+ * pixels. */
+{
+ TkTextSegment *eiPtr = chunkPtr->clientData;
+ Tk_Image image;
+
+ image = eiPtr->body.ei.image;
+ if (image != NULL) {
+ Tk_SizeOfImage(image, widthPtr, heightPtr);
+ } else {
+ *widthPtr = 0;
+ *heightPtr = 0;
+ }
+
+ *xPtr = chunkPtr->x + eiPtr->body.ei.padX;
+
+ switch (eiPtr->body.ei.align) {
+ case ALIGN_BOTTOM:
+ *yPtr = y + (lineHeight - *heightPtr - eiPtr->body.ei.padY);
+ break;
+ case ALIGN_CENTER:
+ *yPtr = y + (lineHeight - *heightPtr)/2;
+ break;
+ case ALIGN_TOP:
+ *yPtr = y + eiPtr->body.ei.padY;
+ break;
+ case ALIGN_BASELINE:
+ *yPtr = y + (baseline - *heightPtr);
+ break;
+ }
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * TkTextImageIndex --
+ *
+ * Given the name of an embedded image within a text widget, returns an
+ * index corresponding to the image's position in the text.
+ *
+ * Results:
+ * The return value is 1 if there is an embedded image by the given name
+ * in the text widget, 0 otherwise. If the image exists, *indexPtr is
+ * filled in with its index.
+ *
+ * Side effects:
+ * None.
+ *
+ *--------------------------------------------------------------
+ */
+
+int
+TkTextImageIndex(
+ TkText *textPtr, /* Text widget containing image. */
+ const char *name, /* Name of image. */
+ TkTextIndex *indexPtr) /* Index information gets stored here. */
+{
+ Tcl_HashEntry *hPtr;
+ TkTextSegment *eiPtr;
+
+ if (textPtr == NULL) {
+ return 0;
+ }
+
+ hPtr = Tcl_FindHashEntry(&textPtr->sharedTextPtr->imageTable, name);
+ if (hPtr == NULL) {
+ return 0;
+ }
+ eiPtr = Tcl_GetHashValue(hPtr);
+ indexPtr->tree = textPtr->sharedTextPtr->tree;
+ indexPtr->linePtr = eiPtr->body.ei.linePtr;
+ indexPtr->byteIndex = TkTextSegToOffset(eiPtr, indexPtr->linePtr);
+ return 1;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * EmbImageProc --
+ *
+ * This function is called by the image code whenever an image or its
+ * contents changes.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The image will be redisplayed.
+ *
+ *--------------------------------------------------------------
+ */
+
+static void
+EmbImageProc(
+ ClientData clientData, /* Pointer to widget record. */
+ int x, int y, /* Upper left pixel (within image) that must
+ * be redisplayed. */
+ int width, int height, /* Dimensions of area to redisplay (may be
+ * <= 0). */
+ int imgWidth, int imgHeight)/* New dimensions of image. */
+
+{
+ TkTextSegment *eiPtr = clientData;
+ TkTextIndex index;
+
+ index.tree = eiPtr->body.ei.sharedTextPtr->tree;
+ index.linePtr = eiPtr->body.ei.linePtr;
+ index.byteIndex = TkTextSegToOffset(eiPtr, eiPtr->body.ei.linePtr);
+ TkTextChanged(eiPtr->body.ei.sharedTextPtr, NULL, &index, &index);
+
+ /*
+ * It's probably not true that all image changes can change the line
+ * height, so we could be more efficient here and only call this when
+ * necessary.
+ */
+
+ TkTextInvalidateLineMetrics(eiPtr->body.ei.sharedTextPtr, NULL,
+ index.linePtr, 0, TK_TEXT_INVALIDATE_ONLY);
+}
+
+/*
+ * Local Variables:
+ * mode: c
+ * c-basic-offset: 4
+ * fill-column: 78
+ * End:
+ */
diff --git a/tk8.6/generic/tkTextIndex.c b/tk8.6/generic/tkTextIndex.c
new file mode 100644
index 0000000..8820191
--- /dev/null
+++ b/tk8.6/generic/tkTextIndex.c
@@ -0,0 +1,2402 @@
+/*
+ * tkTextIndex.c --
+ *
+ * This module provides functions that manipulate indices for text
+ * widgets.
+ *
+ * Copyright (c) 1992-1994 The Regents of the University of California.
+ * Copyright (c) 1994-1997 Sun Microsystems, Inc.
+ *
+ * See the file "license.terms" for information on usage and redistribution of
+ * this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ */
+
+#include "default.h"
+#include "tkInt.h"
+#include "tkText.h"
+
+/*
+ * Index to use to select last character in line (very large integer):
+ */
+
+#define LAST_CHAR 1000000
+
+/*
+ * Modifiers for index parsing: 'display', 'any' or nothing.
+ */
+
+#define TKINDEX_NONE 0
+#define TKINDEX_DISPLAY 1
+#define TKINDEX_ANY 2
+
+/*
+ * Forward declarations for functions defined later in this file:
+ */
+
+static const char * ForwBack(TkText *textPtr, const char *string,
+ TkTextIndex *indexPtr);
+static const char * StartEnd(TkText *textPtr, const char *string,
+ TkTextIndex *indexPtr);
+static int GetIndex(Tcl_Interp *interp, TkSharedText *sharedPtr,
+ TkText *textPtr, const char *string,
+ TkTextIndex *indexPtr, int *canCachePtr);
+static int IndexCountBytesOrdered(CONST TkText *textPtr,
+ CONST TkTextIndex *indexPtr1,
+ CONST TkTextIndex *indexPtr2);
+
+/*
+ * The "textindex" Tcl_Obj definition:
+ */
+
+static void DupTextIndexInternalRep(Tcl_Obj *srcPtr,
+ Tcl_Obj *copyPtr);
+static void FreeTextIndexInternalRep(Tcl_Obj *listPtr);
+static void UpdateStringOfTextIndex(Tcl_Obj *objPtr);
+
+/*
+ * Accessor macros for the "textindex" type.
+ */
+
+#define GET_TEXTINDEX(objPtr) \
+ ((TkTextIndex *) (objPtr)->internalRep.twoPtrValue.ptr1)
+#define GET_INDEXEPOCH(objPtr) \
+ (PTR2INT((objPtr)->internalRep.twoPtrValue.ptr2))
+#define SET_TEXTINDEX(objPtr, indexPtr) \
+ ((objPtr)->internalRep.twoPtrValue.ptr1 = (void *) (indexPtr))
+#define SET_INDEXEPOCH(objPtr, epoch) \
+ ((objPtr)->internalRep.twoPtrValue.ptr2 = INT2PTR(epoch))
+
+/*
+ * Define the 'textindex' object type, which Tk uses to represent indices in
+ * text widgets internally.
+ */
+
+const Tcl_ObjType tkTextIndexType = {
+ "textindex", /* name */
+ FreeTextIndexInternalRep, /* freeIntRepProc */
+ DupTextIndexInternalRep, /* dupIntRepProc */
+ NULL, /* updateStringProc */
+ NULL /* setFromAnyProc */
+};
+
+static void
+FreeTextIndexInternalRep(
+ Tcl_Obj *indexObjPtr) /* TextIndex object with internal rep to
+ * free. */
+{
+ TkTextIndex *indexPtr = GET_TEXTINDEX(indexObjPtr);
+
+ if (indexPtr->textPtr != NULL) {
+ if (--indexPtr->textPtr->refCount == 0) {
+ /*
+ * The text widget has been deleted and we need to free it now.
+ */
+
+ ckfree(indexPtr->textPtr);
+ }
+ }
+ ckfree(indexPtr);
+ indexObjPtr->typePtr = NULL;
+}
+
+static void
+DupTextIndexInternalRep(
+ Tcl_Obj *srcPtr, /* TextIndex obj with internal rep to copy. */
+ Tcl_Obj *copyPtr) /* TextIndex obj with internal rep to set. */
+{
+ int epoch;
+ TkTextIndex *dupIndexPtr, *indexPtr;
+
+ dupIndexPtr = ckalloc(sizeof(TkTextIndex));
+ indexPtr = GET_TEXTINDEX(srcPtr);
+ epoch = GET_INDEXEPOCH(srcPtr);
+
+ dupIndexPtr->tree = indexPtr->tree;
+ dupIndexPtr->linePtr = indexPtr->linePtr;
+ dupIndexPtr->byteIndex = indexPtr->byteIndex;
+ dupIndexPtr->textPtr = indexPtr->textPtr;
+ if (dupIndexPtr->textPtr != NULL) {
+ dupIndexPtr->textPtr->refCount++;
+ }
+ SET_TEXTINDEX(copyPtr, dupIndexPtr);
+ SET_INDEXEPOCH(copyPtr, epoch);
+ copyPtr->typePtr = &tkTextIndexType;
+}
+
+/*
+ * This will not be called except by TkTextNewIndexObj below. This is because
+ * if a TkTextIndex is no longer valid, it is not possible to regenerate the
+ * string representation.
+ */
+
+static void
+UpdateStringOfTextIndex(
+ Tcl_Obj *objPtr)
+{
+ char buffer[TK_POS_CHARS];
+ register int len;
+ const TkTextIndex *indexPtr = GET_TEXTINDEX(objPtr);
+
+ len = TkTextPrintIndex(indexPtr->textPtr, indexPtr, buffer);
+
+ objPtr->bytes = ckalloc(len + 1);
+ strcpy(objPtr->bytes, buffer);
+ objPtr->length = len;
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * MakeObjIndex --
+ *
+ * This function generates a Tcl_Obj description of an index, suitable
+ * for reading in again later. If the 'textPtr' is NULL then we still
+ * generate an index object, but it's internal description is deemed
+ * non-cacheable, and therefore effectively useless (apart from as a
+ * temporary memory storage). This is used for indices whose meaning is
+ * very temporary (like @0,0 or the name of a mark or tag). The mapping
+ * from such strings/objects to actual TkTextIndex pointers is not stable
+ * to minor text widget changes which we do not track (we track
+ * insertions and deletions).
+ *
+ * Results:
+ * A pointer to an allocated TkTextIndex which will be freed
+ * automatically when the Tcl_Obj is used for other purposes.
+ *
+ * Side effects:
+ * A small amount of memory is allocated.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+static TkTextIndex *
+MakeObjIndex(
+ TkText *textPtr, /* Information about text widget. */
+ Tcl_Obj *objPtr, /* Object containing description of
+ * position. */
+ const TkTextIndex *origPtr) /* Pointer to index. */
+{
+ TkTextIndex *indexPtr = ckalloc(sizeof(TkTextIndex));
+
+ indexPtr->tree = origPtr->tree;
+ indexPtr->linePtr = origPtr->linePtr;
+ indexPtr->byteIndex = origPtr->byteIndex;
+ SET_TEXTINDEX(objPtr, indexPtr);
+ objPtr->typePtr = &tkTextIndexType;
+ indexPtr->textPtr = textPtr;
+
+ if (textPtr != NULL) {
+ textPtr->refCount++;
+ SET_INDEXEPOCH(objPtr, textPtr->sharedTextPtr->stateEpoch);
+ } else {
+ SET_INDEXEPOCH(objPtr, 0);
+ }
+ return indexPtr;
+}
+
+const TkTextIndex *
+TkTextGetIndexFromObj(
+ Tcl_Interp *interp, /* Use this for error reporting. */
+ TkText *textPtr, /* Information about text widget. */
+ Tcl_Obj *objPtr) /* Object containing description of
+ * position. */
+{
+ TkTextIndex index;
+ TkTextIndex *indexPtr = NULL;
+ int cache;
+
+ if (objPtr->typePtr == &tkTextIndexType) {
+ int epoch;
+
+ indexPtr = GET_TEXTINDEX(objPtr);
+ epoch = GET_INDEXEPOCH(objPtr);
+
+ if (epoch == textPtr->sharedTextPtr->stateEpoch) {
+ if (indexPtr->textPtr == textPtr) {
+ return indexPtr;
+ }
+ }
+ }
+
+ /*
+ * The object is either not an index type or referred to a different text
+ * widget, or referred to the correct widget, but it is out of date (text
+ * has been added/deleted since).
+ */
+
+ if (GetIndex(interp, NULL, textPtr, Tcl_GetString(objPtr), &index,
+ &cache) != TCL_OK) {
+ return NULL;
+ }
+
+ if (objPtr->typePtr != NULL) {
+ if (objPtr->bytes == NULL) {
+ objPtr->typePtr->updateStringProc(objPtr);
+ }
+ if (objPtr->typePtr->freeIntRepProc != NULL) {
+ objPtr->typePtr->freeIntRepProc(objPtr);
+ }
+ }
+
+ return MakeObjIndex((cache ? textPtr : NULL), objPtr, &index);
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * TkTextNewIndexObj --
+ *
+ * This function generates a Tcl_Obj description of an index, suitable
+ * for reading in again later. The index generated is effectively stable
+ * to all except insertion/deletion operations on the widget.
+ *
+ * Results:
+ * A new Tcl_Obj with refCount zero.
+ *
+ * Side effects:
+ * A small amount of memory is allocated.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+Tcl_Obj *
+TkTextNewIndexObj(
+ TkText *textPtr, /* Text widget for this index */
+ const TkTextIndex *indexPtr)/* Pointer to index. */
+{
+ Tcl_Obj *retVal;
+
+ retVal = Tcl_NewObj();
+ retVal->bytes = NULL;
+
+ /*
+ * Assumption that the above call returns an object with:
+ * retVal->typePtr == NULL
+ */
+
+ MakeObjIndex(textPtr, retVal, indexPtr);
+
+ /*
+ * Unfortunately, it isn't possible for us to regenerate the string
+ * representation so we have to create it here, while we can be sure the
+ * contents of the index are still valid.
+ */
+
+ UpdateStringOfTextIndex(retVal);
+ return retVal;
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * TkTextMakePixelIndex --
+ *
+ * Given a pixel index and a byte index, look things up in the B-tree and
+ * fill in a TkTextIndex structure.
+ *
+ * The valid input range for pixelIndex is from 0 to the number of pixels
+ * in the widget-1. Anything outside that range will be rounded to the
+ * closest acceptable value.
+ *
+ * Results:
+ *
+ * The structure at *indexPtr is filled in with information about the
+ * character at pixelIndex (or the closest existing character, if the
+ * specified one doesn't exist), and the number of excess pixels is
+ * returned as a result. This means if the given pixel index is exactly
+ * correct for the top-edge of the indexPtr, then zero will be returned,
+ * and otherwise we will return the calculation 'desired pixelIndex' -
+ * 'actual pixel index of indexPtr'.
+ *
+ * Side effects:
+ * None.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+int
+TkTextMakePixelIndex(
+ TkText *textPtr, /* The Text Widget */
+ int pixelIndex, /* Pixel-index of desired line (0 means first
+ * pixel of first line of text). */
+ TkTextIndex *indexPtr) /* Structure to fill in. */
+{
+ int pixelOffset = 0;
+
+ indexPtr->tree = textPtr->sharedTextPtr->tree;
+ indexPtr->textPtr = textPtr;
+
+ if (pixelIndex < 0) {
+ pixelIndex = 0;
+ }
+ indexPtr->linePtr = TkBTreeFindPixelLine(textPtr->sharedTextPtr->tree,
+ textPtr, pixelIndex, &pixelOffset);
+
+ /*
+ * 'pixelIndex' was too large, so we try again, just to find the last
+ * pixel in the window.
+ */
+
+ if (indexPtr->linePtr == NULL) {
+ int lastMinusOne = TkBTreeNumPixels(textPtr->sharedTextPtr->tree,
+ textPtr)-1;
+
+ indexPtr->linePtr = TkBTreeFindPixelLine(textPtr->sharedTextPtr->tree,
+ textPtr, lastMinusOne, &pixelOffset);
+ indexPtr->byteIndex = 0;
+ return pixelOffset;
+ }
+ indexPtr->byteIndex = 0;
+
+ if (pixelOffset <= 0) {
+ return 0;
+ }
+ return TkTextMeasureDown(textPtr, indexPtr, pixelOffset);
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * TkTextMakeByteIndex --
+ *
+ * Given a line index and a byte index, look things up in the B-tree and
+ * fill in a TkTextIndex structure.
+ *
+ * Results:
+ * The structure at *indexPtr is filled in with information about the
+ * character at lineIndex and byteIndex (or the closest existing
+ * character, if the specified one doesn't exist), and indexPtr is
+ * returned as result.
+ *
+ * Side effects:
+ * None.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+TkTextIndex *
+TkTextMakeByteIndex(
+ TkTextBTree tree, /* Tree that lineIndex and byteIndex refer
+ * to. */
+ const TkText *textPtr,
+ int lineIndex, /* Index of desired line (0 means first line
+ * of text). */
+ int byteIndex, /* Byte index of desired character. */
+ TkTextIndex *indexPtr) /* Structure to fill in. */
+{
+ TkTextSegment *segPtr;
+ int index;
+ const char *p, *start;
+ Tcl_UniChar ch;
+
+ indexPtr->tree = tree;
+ if (lineIndex < 0) {
+ lineIndex = 0;
+ byteIndex = 0;
+ }
+ if (byteIndex < 0) {
+ byteIndex = 0;
+ }
+ indexPtr->linePtr = TkBTreeFindLine(tree, textPtr, lineIndex);
+ if (indexPtr->linePtr == NULL) {
+ indexPtr->linePtr = TkBTreeFindLine(tree, textPtr,
+ TkBTreeNumLines(tree, textPtr));
+ 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 the 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(
+ TkTextBTree tree, /* Tree that lineIndex and charIndex refer
+ * to. */
+ TkText *textPtr,
+ int lineIndex, /* Index of desired line (0 means first line
+ * of text). */
+ int charIndex, /* Index of desired character. */
+ TkTextIndex *indexPtr) /* Structure to fill in. */
+{
+ register TkTextSegment *segPtr;
+ char *p, *start, *end;
+ int index, offset;
+ Tcl_UniChar ch;
+
+ indexPtr->tree = tree;
+ if (lineIndex < 0) {
+ lineIndex = 0;
+ charIndex = 0;
+ }
+ if (charIndex < 0) {
+ charIndex = 0;
+ }
+ indexPtr->linePtr = TkBTreeFindLine(tree, textPtr, lineIndex);
+ if (indexPtr->linePtr == NULL) {
+ indexPtr->linePtr = TkBTreeFindLine(tree, textPtr,
+ TkBTreeNumLines(tree, textPtr));
+ charIndex = 0;
+ }
+
+ /*
+ * Verify that the index is within the range of the line. If not, just use
+ * the index of the last character in the line.
+ */
+
+ index = 0;
+ for (segPtr = indexPtr->linePtr->segPtr; ; segPtr = segPtr->nextPtr) {
+ if (segPtr == NULL) {
+ /*
+ * Use the index of the last character in the line. Since the last
+ * character on the line is guaranteed to be a '\n', we can back
+ * up a constant sizeof(char) bytes.
+ */
+
+ indexPtr->byteIndex = index - sizeof(char);
+ break;
+ }
+ if (segPtr->typePtr == &tkTextCharType) {
+ /*
+ * Turn character offset into a byte offset.
+ */
+
+ start = segPtr->body.chars;
+ end = start + segPtr->size;
+ for (p = start; p < end; p += offset) {
+ if (charIndex == 0) {
+ indexPtr->byteIndex = index;
+ return indexPtr;
+ }
+ charIndex--;
+ offset = Tcl_UtfToUniChar(p, &ch);
+ index += offset;
+ }
+ } else {
+ if (charIndex < segPtr->size) {
+ indexPtr->byteIndex = index;
+ break;
+ }
+ charIndex -= segPtr->size;
+ index += segPtr->size;
+ }
+ }
+ return indexPtr;
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * TkTextIndexToSeg --
+ *
+ * Given an index, this function returns the segment and offset within
+ * segment for the index.
+ *
+ * Results:
+ * The return value is a pointer to the segment referred to by indexPtr;
+ * this will always be a segment with non-zero size. The variable at
+ * *offsetPtr is set to hold the integer offset within the segment of the
+ * character given by indexPtr.
+ *
+ * Side effects:
+ * None.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+TkTextSegment *
+TkTextIndexToSeg(
+ const TkTextIndex *indexPtr,/* Text index. */
+ int *offsetPtr) /* Where to store offset within segment, or
+ * NULL if offset isn't wanted. */
+{
+ TkTextSegment *segPtr;
+ int offset;
+
+ for (offset = indexPtr->byteIndex, segPtr = indexPtr->linePtr->segPtr;
+ offset >= segPtr->size;
+ offset -= segPtr->size, segPtr = segPtr->nextPtr) {
+ /* Empty loop body. */
+ }
+ if (offsetPtr != NULL) {
+ *offsetPtr = offset;
+ }
+ return segPtr;
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * TkTextSegToOffset --
+ *
+ * Given a segment pointer and the line containing it, this function
+ * returns the offset of the segment within its line.
+ *
+ * Results:
+ * The return value is the offset (within its line) of the first
+ * character in segPtr.
+ *
+ * Side effects:
+ * None.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+int
+TkTextSegToOffset(
+ const TkTextSegment *segPtr,/* Segment whose offset is desired. */
+ const TkTextLine *linePtr) /* Line containing segPtr. */
+{
+ const TkTextSegment *segPtr2;
+ int offset = 0;
+
+ for (segPtr2 = linePtr->segPtr; segPtr2 != segPtr;
+ segPtr2 = segPtr2->nextPtr) {
+ offset += segPtr2->size;
+ }
+ return offset;
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * TkTextGetObjIndex --
+ *
+ * Simpler wrapper around the string based function, but could be
+ * enhanced with a new object type in the future.
+ *
+ * Results:
+ * see TkTextGetIndex
+ *
+ * Side effects:
+ * None.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+int
+TkTextGetObjIndex(
+ Tcl_Interp *interp, /* Use this for error reporting. */
+ TkText *textPtr, /* Information about text widget. */
+ Tcl_Obj *idxObj, /* Object containing textual description of
+ * position. */
+ TkTextIndex *indexPtr) /* Index structure to fill in. */
+{
+ return GetIndex(interp, NULL, textPtr, Tcl_GetString(idxObj), indexPtr,
+ NULL);
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * TkTextSharedGetObjIndex --
+ *
+ * Simpler wrapper around the string based function, but could be
+ * enhanced with a new object type in the future.
+ *
+ * Results:
+ * see TkTextGetIndex
+ *
+ * Side effects:
+ * None.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+int
+TkTextSharedGetObjIndex(
+ Tcl_Interp *interp, /* Use this for error reporting. */
+ TkSharedText *sharedTextPtr,/* Information about text widget. */
+ Tcl_Obj *idxObj, /* Object containing textual description of
+ * position. */
+ TkTextIndex *indexPtr) /* Index structure to fill in. */
+{
+ return GetIndex(interp, sharedTextPtr, NULL, Tcl_GetString(idxObj),
+ indexPtr, NULL);
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * TkTextGetIndex --
+ *
+ * Given a string, return the index that is described.
+ *
+ * Results:
+ * The return value is a standard Tcl return result. If TCL_OK is
+ * returned, then everything went well and the index at *indexPtr is
+ * filled in; otherwise TCL_ERROR is returned and an error message is
+ * left in the interp's result.
+ *
+ * Side effects:
+ * None.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+int
+TkTextGetIndex(
+ Tcl_Interp *interp, /* Use this for error reporting. */
+ TkText *textPtr, /* Information about text widget. */
+ const char *string, /* Textual description of position. */
+ TkTextIndex *indexPtr) /* Index structure to fill in. */
+{
+ return GetIndex(interp, NULL, textPtr, string, indexPtr, NULL);
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * GetIndex --
+ *
+ * Given a string, return the index that is described.
+ *
+ * Results:
+ * The return value is a standard Tcl return result. If TCL_OK is
+ * returned, then everything went well and the index at *indexPtr is
+ * filled in; otherwise TCL_ERROR is returned and an error message is
+ * left in the interp's result.
+ *
+ * If *canCachePtr is non-NULL, and everything went well, the integer it
+ * points to is set to 1 if the indexPtr is something which can be
+ * cached, and zero otherwise.
+ *
+ * Side effects:
+ * None.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+static int
+GetIndex(
+ Tcl_Interp *interp, /* Use this for error reporting. */
+ TkSharedText *sharedPtr,
+ TkText *textPtr, /* Information about text widget. */
+ const char *string, /* Textual description of position. */
+ TkTextIndex *indexPtr, /* Index structure to fill in. */
+ int *canCachePtr) /* Pointer to integer to store whether we can
+ * cache the index (or NULL). */
+{
+ char *p, *end, *endOfBase;
+ TkTextIndex first, last;
+ int wantLast, result;
+ char c;
+ const char *cp;
+ Tcl_DString copy;
+ int canCache = 0;
+
+ if (sharedPtr == NULL) {
+ sharedPtr = textPtr->sharedTextPtr;
+ }
+
+ /*
+ *---------------------------------------------------------------------
+ * Stage 1: check to see if the index consists of nothing but a mark
+ * name, an embedded window or an embedded image. We do this check
+ * now even though it's also done later, in order to allow mark names,
+ * embedded window names or image names that include funny characters
+ * such as spaces or "+1c".
+ *---------------------------------------------------------------------
+ */
+
+ if (TkTextMarkNameToIndex(textPtr, string, indexPtr) == TCL_OK) {
+ goto done;
+ }
+
+ if (TkTextWindowIndex(textPtr, string, indexPtr) != 0) {
+ goto done;
+ }
+
+ if (TkTextImageIndex(textPtr, string, indexPtr) != 0) {
+ goto done;
+ }
+
+ /*
+ *------------------------------------------------
+ * Stage 2: start again by parsing the base index.
+ *------------------------------------------------
+ */
+
+ indexPtr->tree = sharedPtr->tree;
+
+ /*
+ * First look for the form "tag.first" or "tag.last" where "tag" is the
+ * name of a valid tag. Try to use up as much as possible of the string in
+ * this check (strrchr instead of strchr below). Doing the check now, and
+ * in this way, allows tag names to include funny characters like "@" or
+ * "+1c".
+ */
+
+ Tcl_DStringInit(&copy);
+ p = strrchr(Tcl_DStringAppend(&copy, string, -1), '.');
+ if (p != NULL) {
+ TkTextSearch search;
+ TkTextTag *tagPtr;
+ Tcl_HashEntry *hPtr = NULL;
+ const char *tagName;
+
+ if ((p[1] == 'f') && (strncmp(p+1, "first", 5) == 0)) {
+ wantLast = 0;
+ endOfBase = p+6;
+ } else if ((p[1] == 'l') && (strncmp(p+1, "last", 4) == 0)) {
+ wantLast = 1;
+ endOfBase = p+5;
+ } else {
+ goto tryxy;
+ }
+
+ tagPtr = NULL;
+ tagName = Tcl_DStringValue(&copy);
+ if (((p - tagName) == 3) && !strncmp(tagName, "sel", 3)) {
+ /*
+ * Special case for sel tag which is not stored in the hash table.
+ */
+
+ tagPtr = textPtr->selTagPtr;
+ } else {
+ *p = 0;
+ hPtr = Tcl_FindHashEntry(&sharedPtr->tagTable, tagName);
+ *p = '.';
+ if (hPtr != NULL) {
+ tagPtr = Tcl_GetHashValue(hPtr);
+ }
+ }
+
+ if (tagPtr == NULL) {
+ goto tryxy;
+ }
+
+ TkTextMakeByteIndex(sharedPtr->tree, textPtr, 0, 0, &first);
+ TkTextMakeByteIndex(sharedPtr->tree, textPtr,
+ TkBTreeNumLines(sharedPtr->tree, textPtr), 0, &last);
+ TkBTreeStartSearch(&first, &last, tagPtr, &search);
+ if (!TkBTreeCharTagged(&first, tagPtr) && !TkBTreeNextTag(&search)) {
+ if (tagPtr == textPtr->selTagPtr) {
+ tagName = "sel";
+ } else if (hPtr != NULL) {
+ tagName = Tcl_GetHashKey(&sharedPtr->tagTable, hPtr);
+ }
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "text doesn't contain any characters tagged with \"%s\"",
+ tagName));
+ Tcl_SetErrorCode(interp, "TK", "LOOKUP", "TEXT_INDEX", tagName,
+ NULL);
+ Tcl_DStringFree(&copy);
+ return TCL_ERROR;
+ }
+ *indexPtr = search.curIndex;
+ if (wantLast) {
+ while (TkBTreeNextTag(&search)) {
+ *indexPtr = search.curIndex;
+ }
+ }
+ goto gotBase;
+ }
+
+ tryxy:
+ if (string[0] == '@') {
+ /*
+ * Find character at a given x,y location in the window.
+ */
+
+ int x, y;
+
+ cp = string+1;
+ x = strtol(cp, &end, 0);
+ if ((end == cp) || (*end != ',')) {
+ goto error;
+ }
+ cp = end+1;
+ y = strtol(cp, &end, 0);
+ if (end == cp) {
+ goto error;
+ }
+ TkTextPixelIndex(textPtr, x, y, indexPtr, NULL);
+ endOfBase = end;
+ goto gotBase;
+ }
+
+ if (isdigit(UCHAR(string[0])) || (string[0] == '-')) {
+ int lineIndex, charIndex;
+
+ /*
+ * Base is identified with line and character indices.
+ */
+
+ lineIndex = strtol(string, &end, 0) - 1;
+ if ((end == string) || (*end != '.')) {
+ goto error;
+ }
+ p = end+1;
+ if ((*p == 'e') && (strncmp(p, "end", 3) == 0)) {
+ charIndex = LAST_CHAR;
+ endOfBase = p+3;
+ } else {
+ charIndex = strtol(p, &end, 0);
+ if (end == p) {
+ goto error;
+ }
+ endOfBase = end;
+ }
+ TkTextMakeCharIndex(sharedPtr->tree, textPtr, lineIndex, charIndex,
+ indexPtr);
+ canCache = 1;
+ goto gotBase;
+ }
+
+ for (p = Tcl_DStringValue(&copy); *p != 0; p++) {
+ if (isspace(UCHAR(*p)) || (*p == '+') || (*p == '-')) {
+ break;
+ }
+ }
+ endOfBase = p;
+ if (string[0] == '.') {
+ /*
+ * See if the base position is the name of an embedded window.
+ */
+
+ c = *endOfBase;
+ *endOfBase = 0;
+ result = TkTextWindowIndex(textPtr, Tcl_DStringValue(&copy), indexPtr);
+ *endOfBase = c;
+ if (result != 0) {
+ goto gotBase;
+ }
+ }
+ if ((string[0] == 'e')
+ && (strncmp(string, "end",
+ (size_t) (endOfBase-Tcl_DStringValue(&copy))) == 0)) {
+ /*
+ * Base position is end of text.
+ */
+
+ TkTextMakeByteIndex(sharedPtr->tree, textPtr,
+ TkBTreeNumLines(sharedPtr->tree, textPtr), 0, indexPtr);
+ canCache = 1;
+ goto gotBase;
+ } else {
+ /*
+ * See if the base position is the name of a mark.
+ */
+
+ c = *endOfBase;
+ *endOfBase = 0;
+ result = TkTextMarkNameToIndex(textPtr, Tcl_DStringValue(&copy),
+ indexPtr);
+ *endOfBase = c;
+ if (result == TCL_OK) {
+ goto gotBase;
+ }
+
+ /*
+ * See if the base position is the name of an embedded image.
+ */
+
+ c = *endOfBase;
+ *endOfBase = 0;
+ result = TkTextImageIndex(textPtr, Tcl_DStringValue(&copy), indexPtr);
+ *endOfBase = c;
+ if (result != 0) {
+ goto gotBase;
+ }
+ }
+ goto error;
+
+ /*
+ *-------------------------------------------------------------------
+ * Stage 3: process zero or more modifiers. Each modifier is either a
+ * keyword like "wordend" or "linestart", or it has the form "op count
+ * units" where op is + or -, count is a number, and units is "chars" or
+ * "lines".
+ *-------------------------------------------------------------------
+ */
+
+ gotBase:
+ cp = endOfBase;
+ while (1) {
+ while (isspace(UCHAR(*cp))) {
+ cp++;
+ }
+ if (*cp == 0) {
+ break;
+ }
+
+ if ((*cp == '+') || (*cp == '-')) {
+ cp = ForwBack(textPtr, cp, indexPtr);
+ } else {
+ cp = StartEnd(textPtr, cp, indexPtr);
+ }
+ if (cp == NULL) {
+ goto error;
+ }
+ }
+ Tcl_DStringFree(&copy);
+
+ done:
+ if (canCachePtr != NULL) {
+ *canCachePtr = canCache;
+ }
+ if (indexPtr->linePtr == NULL) {
+ Tcl_Panic("Bad index created");
+ }
+ return TCL_OK;
+
+ error:
+ Tcl_DStringFree(&copy);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf("bad text index \"%s\"", string));
+ Tcl_SetErrorCode(interp, "TK", "TEXT", "BAD_INDEX", NULL);
+ return TCL_ERROR;
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * TkTextPrintIndex --
+ *
+ * This function generates a string description of an index, suitable for
+ * reading in again later.
+ *
+ * Results:
+ * The characters pointed to by string are modified. Returns the number
+ * of characters in the string.
+ *
+ * Side effects:
+ * None.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+int
+TkTextPrintIndex(
+ const TkText *textPtr,
+ const TkTextIndex *indexPtr,/* Pointer to index. */
+ char *string) /* Place to store the position. Must have at
+ * least TK_POS_CHARS characters. */
+{
+ TkTextSegment *segPtr;
+ TkTextLine *linePtr;
+ int numBytes, charIndex;
+
+ numBytes = indexPtr->byteIndex;
+ charIndex = 0;
+ linePtr = indexPtr->linePtr;
+
+ for (segPtr = linePtr->segPtr; ; segPtr = segPtr->nextPtr) {
+ if (segPtr == NULL) {
+ /*
+ * Two logical lines merged into one display line through eliding
+ * of a newline.
+ */
+
+ linePtr = TkBTreeNextLine(NULL, linePtr);
+ segPtr = linePtr->segPtr;
+ }
+ 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;
+ }
+
+ return sprintf(string, "%d.%d",
+ TkBTreeLinesTo(textPtr, indexPtr->linePtr) + 1, charIndex);
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * TkTextIndexCmp --
+ *
+ * Compare two indices to see which one is earlier in the text.
+ *
+ * Results:
+ * The return value is 0 if index1Ptr and index2Ptr refer to the same
+ * position in the file, -1 if index1Ptr refers to an earlier position
+ * than index2Ptr, and 1 otherwise.
+ *
+ * Side effects:
+ * None.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+int
+TkTextIndexCmp(
+ const TkTextIndex*index1Ptr,/* First index. */
+ const TkTextIndex*index2Ptr)/* Second index. */
+{
+ int line1, line2;
+
+ if (index1Ptr->linePtr == index2Ptr->linePtr) {
+ if (index1Ptr->byteIndex < index2Ptr->byteIndex) {
+ return -1;
+ } else if (index1Ptr->byteIndex > index2Ptr->byteIndex) {
+ return 1;
+ } else {
+ return 0;
+ }
+ }
+
+ /*
+ * Assumption here that it is ok for comparisons to reflect the full
+ * B-tree and not just the portion that is available to any client. This
+ * should be true because the only indexPtr's we should be given are ones
+ * which are valid for the current client.
+ */
+
+ line1 = TkBTreeLinesTo(NULL, index1Ptr->linePtr);
+ line2 = TkBTreeLinesTo(NULL, index2Ptr->linePtr);
+ if (line1 < line2) {
+ return -1;
+ }
+ if (line1 > line2) {
+ return 1;
+ }
+ return 0;
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * ForwBack --
+ *
+ * This function handles +/- modifiers for indices to adjust the index
+ * forwards or backwards.
+ *
+ * Results:
+ * If the modifier in string is successfully parsed then the return value
+ * is the address of the first character after the modifier, and
+ * *indexPtr is updated to reflect the modifier. If there is a syntax
+ * error in the modifier then NULL is returned.
+ *
+ * Side effects:
+ * None.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+static const char *
+ForwBack(
+ TkText *textPtr, /* Information about text widget. */
+ const char *string, /* String to parse for additional info about
+ * modifier (count and units). Points to "+"
+ * or "-" that starts modifier. */
+ TkTextIndex *indexPtr) /* Index to update as specified in string. */
+{
+ register const char *p, *units;
+ char *end;
+ int count, lineIndex, modifier;
+ size_t length;
+
+ /*
+ * Get the count (how many units forward or backward).
+ */
+
+ p = string+1;
+ while (isspace(UCHAR(*p))) {
+ p++;
+ }
+ count = strtol(p, &end, 0);
+ if (end == p) {
+ return NULL;
+ }
+ p = end;
+ while (isspace(UCHAR(*p))) {
+ p++;
+ }
+
+ /*
+ * Find the end of this modifier (next space or + or - character), then
+ * check if there is a textual 'display' or 'any' modifier. These
+ * modifiers can be their own word (in which case they can be abbreviated)
+ * or they can follow on to the actual unit in a single word (in which
+ * case no abbreviation is allowed). So, 'display lines', 'd lines',
+ * 'displaylin' are all ok, but 'dline' is not.
+ */
+
+ units = p;
+ while ((*p != '\0') && !isspace(UCHAR(*p)) && (*p != '+') && (*p != '-')) {
+ p++;
+ }
+ length = p - units;
+ if ((*units == 'd') &&
+ (strncmp(units, "display", (length > 7 ? 7 : length)) == 0)) {
+ modifier = TKINDEX_DISPLAY;
+ if (length > 7) {
+ p -= (length - 7);
+ }
+ } else if ((*units == 'a') &&
+ (strncmp(units, "any", (length > 3 ? 3 : length)) == 0)) {
+ modifier = TKINDEX_ANY;
+ if (length > 3) {
+ p -= (length - 3);
+ }
+ } else {
+ modifier = TKINDEX_NONE;
+ }
+
+ /*
+ * If we had a modifier, which we interpreted ok, so now forward to the
+ * actual units.
+ */
+
+ if (modifier != TKINDEX_NONE) {
+ while (isspace(UCHAR(*p))) {
+ p++;
+ }
+ units = p;
+ while (*p!='\0' && !isspace(UCHAR(*p)) && *p!='+' && *p!='-') {
+ p++;
+ }
+ length = p - units;
+ }
+
+ /*
+ * Finally parse the units.
+ */
+
+ if ((*units == 'c') && (strncmp(units, "chars", length) == 0)) {
+ TkTextCountType type;
+
+ if (modifier == TKINDEX_NONE) {
+ type = COUNT_INDICES;
+ } else if (modifier == TKINDEX_ANY) {
+ type = COUNT_CHARS;
+ } else {
+ type = COUNT_DISPLAY_CHARS;
+ }
+
+ if (*string == '+') {
+ TkTextIndexForwChars(textPtr, indexPtr, count, indexPtr, type);
+ } else {
+ TkTextIndexBackChars(textPtr, indexPtr, count, indexPtr, type);
+ }
+ } else if ((*units == 'i') && (strncmp(units, "indices", length) == 0)) {
+ TkTextCountType type;
+
+ if (modifier == TKINDEX_DISPLAY) {
+ type = COUNT_DISPLAY_INDICES;
+ } else {
+ type = COUNT_INDICES;
+ }
+
+ if (*string == '+') {
+ TkTextIndexForwChars(textPtr, indexPtr, count, indexPtr, type);
+ } else {
+ TkTextIndexBackChars(textPtr, indexPtr, count, indexPtr, type);
+ }
+ } else if ((*units == 'l') && (strncmp(units, "lines", length) == 0)) {
+ if (modifier == TKINDEX_DISPLAY) {
+ /*
+ * Find the appropriate pixel offset of the current position
+ * within its display line. This also has the side-effect of
+ * moving indexPtr, but that doesn't matter since we will do it
+ * again below.
+ *
+ * Then find the right display line, and finally calculated the
+ * index we want in that display line, based on the original pixel
+ * offset.
+ */
+
+ int xOffset, forward;
+
+ if (TkTextIsElided(textPtr, indexPtr, NULL)) {
+ /*
+ * Go forward to the first non-elided index.
+ */
+
+ TkTextIndexForwChars(textPtr, indexPtr, 0, indexPtr,
+ COUNT_DISPLAY_INDICES);
+ }
+
+ /*
+ * Unlike the Forw/BackChars code, the display line code is
+ * sensitive to whether we are genuinely going forwards or
+ * backwards. So, we need to determine that. This is important in
+ * the case where we have "+ -3 displaylines", for example.
+ */
+
+ if ((count < 0) ^ (*string == '-')) {
+ forward = 0;
+ } else {
+ forward = 1;
+ }
+
+ count = abs(count);
+ if (count == 0) {
+ return p;
+ }
+
+ if (forward) {
+ TkTextFindDisplayLineEnd(textPtr, indexPtr, 1, &xOffset);
+ while (count-- > 0) {
+ /*
+ * Go to the end of the line, then forward one char/byte
+ * to get to the beginning of the next line.
+ */
+
+ TkTextFindDisplayLineEnd(textPtr, indexPtr, 1, NULL);
+ TkTextIndexForwChars(textPtr, indexPtr, 1, indexPtr,
+ COUNT_DISPLAY_INDICES);
+ }
+ } else {
+ TkTextFindDisplayLineEnd(textPtr, indexPtr, 0, &xOffset);
+ while (count-- > 0) {
+ /*
+ * Go to the beginning of the line, then backward one
+ * char/byte to get to the end of the previous line.
+ */
+
+ TkTextFindDisplayLineEnd(textPtr, indexPtr, 0, NULL);
+ TkTextIndexBackChars(textPtr, indexPtr, 1, indexPtr,
+ COUNT_DISPLAY_INDICES);
+ }
+ TkTextFindDisplayLineEnd(textPtr, indexPtr, 0, NULL);
+ }
+
+ /*
+ * This call assumes indexPtr is the beginning of a display line
+ * and moves it to the 'xOffset' position of that line, which is
+ * just what we want.
+ */
+
+ TkTextIndexOfX(textPtr, xOffset, indexPtr);
+ } else {
+ lineIndex = TkBTreeLinesTo(textPtr, indexPtr->linePtr);
+ if (*string == '+') {
+ lineIndex += count;
+ } else {
+ lineIndex -= count;
+
+ /*
+ * The check below retains the character position, even if the
+ * line runs off the start of the file. Without it, the
+ * character position will get reset to 0 by TkTextMakeIndex.
+ */
+
+ if (lineIndex < 0) {
+ lineIndex = 0;
+ }
+ }
+
+ /*
+ * This doesn't work quite right if using a proportional font or
+ * UTF-8 characters with varying numbers of bytes, or if there are
+ * embedded windows, images, etc. 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, textPtr, lineIndex,
+ indexPtr->byteIndex, indexPtr);
+ }
+ } else {
+ return NULL;
+ }
+ return p;
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * TkTextIndexForwBytes --
+ *
+ * Given an index for a text widget, this function creates a new index
+ * that points "count" bytes ahead of the source index.
+ *
+ * Results:
+ * *dstPtr is modified to refer to the character "count" bytes after
+ * srcPtr, or to the last character in the TkText if there aren't "count"
+ * bytes left.
+ *
+ * In this latter case, the function returns '1' to indicate that not all
+ * of 'byteCount' could be used.
+ *
+ * Side effects:
+ * None.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+int
+TkTextIndexForwBytes(
+ const TkText *textPtr,
+ const TkTextIndex *srcPtr, /* Source index. */
+ int byteCount, /* How many bytes forward to move. May be
+ * negative. */
+ TkTextIndex *dstPtr) /* Destination index: gets modified. */
+{
+ TkTextLine *linePtr;
+ TkTextSegment *segPtr;
+ int lineLength;
+
+ if (byteCount < 0) {
+ TkTextIndexBackBytes(textPtr, srcPtr, -byteCount, dstPtr);
+ return 0;
+ }
+
+ *dstPtr = *srcPtr;
+ dstPtr->byteIndex += byteCount;
+ while (1) {
+ /*
+ * Compute the length of the current line.
+ */
+
+ lineLength = 0;
+ for (segPtr = dstPtr->linePtr->segPtr; segPtr != NULL;
+ segPtr = segPtr->nextPtr) {
+ lineLength += segPtr->size;
+ }
+
+ /*
+ * If the new index is in the same line then we're done. Otherwise go
+ * on to the next line.
+ */
+
+ if (dstPtr->byteIndex < lineLength) {
+ return 0;
+ }
+ dstPtr->byteIndex -= lineLength;
+ linePtr = TkBTreeNextLine(textPtr, dstPtr->linePtr);
+ if (linePtr == NULL) {
+ dstPtr->byteIndex = lineLength - 1;
+ return 1;
+ }
+ dstPtr->linePtr = linePtr;
+ }
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * TkTextIndexForwChars --
+ *
+ * Given an index for a text widget, this function creates a new index
+ * that points "count" items of type given by "type" ahead of the source
+ * index. "count" can be zero, which is useful in the case where one
+ * wishes to move forward by display (non-elided) chars or indices or one
+ * wishes to move forward by chars, skipping any intervening indices. In
+ * this case dstPtr will point to the first acceptable index which is
+ * encountered.
+ *
+ * Results:
+ * *dstPtr is modified to refer to the character "count" items after
+ * srcPtr, or to the last character in the TkText if there aren't
+ * sufficient items left in the widget.
+ *
+ * Side effects:
+ * None.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+void
+TkTextIndexForwChars(
+ const TkText *textPtr, /* Overall information about text widget. */
+ const TkTextIndex *srcPtr, /* Source index. */
+ int charCount, /* How many characters forward to move. May
+ * be negative. */
+ TkTextIndex *dstPtr, /* Destination index: gets modified. */
+ TkTextCountType type) /* The type of item to count */
+{
+ TkTextLine *linePtr;
+ TkTextSegment *segPtr;
+ TkTextElideInfo *infoPtr = NULL;
+ int byteOffset;
+ char *start, *end, *p;
+ Tcl_UniChar ch;
+ int elide = 0;
+ int checkElided = (type & COUNT_DISPLAY);
+
+ if (charCount < 0) {
+ TkTextIndexBackChars(textPtr, srcPtr, -charCount, dstPtr, type);
+ return;
+ }
+ if (checkElided) {
+ infoPtr = ckalloc(sizeof(TkTextElideInfo));
+ elide = TkTextIsElided(textPtr, srcPtr, infoPtr);
+ }
+
+ *dstPtr = *srcPtr;
+
+ /*
+ * Find seg that contains src byteIndex. Move forward specified number of
+ * chars.
+ */
+
+ if (checkElided) {
+ /*
+ * In this case we have already calculated the information we need, so
+ * no need to use TkTextIndexToSeg()
+ */
+
+ segPtr = infoPtr->segPtr;
+ byteOffset = dstPtr->byteIndex - infoPtr->segOffset;
+ } else {
+ segPtr = TkTextIndexToSeg(dstPtr, &byteOffset);
+ }
+
+ while (1) {
+ /*
+ * Go through each segment in line looking for specified character
+ * index.
+ */
+
+ for ( ; segPtr != NULL; segPtr = segPtr->nextPtr) {
+ /*
+ * If we do need to pay attention to the visibility of
+ * characters/indices, check that first. If the current segment
+ * isn't visible, then we simply continue the loop.
+ */
+
+ if (checkElided && ((segPtr->typePtr == &tkTextToggleOffType)
+ || (segPtr->typePtr == &tkTextToggleOnType))) {
+ TkTextTag *tagPtr = segPtr->body.toggle.tagPtr;
+
+ /*
+ * The elide state only changes if this tag is either the
+ * current highest priority tag (and is therefore being
+ * toggled off), or it's a new tag with higher priority.
+ */
+
+ if (tagPtr->elideString != NULL) {
+ infoPtr->tagCnts[tagPtr->priority]++;
+ if (infoPtr->tagCnts[tagPtr->priority] & 1) {
+ infoPtr->tagPtrs[tagPtr->priority] = tagPtr;
+ }
+
+ if (tagPtr->priority >= infoPtr->elidePriority) {
+ if (segPtr->typePtr == &tkTextToggleOffType) {
+ /*
+ * If it is being toggled off, and it has an elide
+ * string, it must actually be the current highest
+ * priority tag, so this check is redundant:
+ */
+
+ if (tagPtr->priority != infoPtr->elidePriority) {
+ Tcl_Panic("Bad tag priority being toggled off");
+ }
+
+ /*
+ * Find previous elide tag, if any (if not then
+ * elide will be zero, of course).
+ */
+
+ elide = 0;
+ while (--infoPtr->elidePriority > 0) {
+ if (infoPtr->tagCnts[infoPtr->elidePriority]
+ & 1) {
+ elide = infoPtr->tagPtrs
+ [infoPtr->elidePriority]->elide;
+ break;
+ }
+ }
+ } else {
+ elide = tagPtr->elide;
+ infoPtr->elidePriority = tagPtr->priority;
+ }
+ }
+ }
+ }
+
+ if (!elide) {
+ 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);
+ goto forwardCharDone;
+ }
+ charCount--;
+ }
+ } else if (type & COUNT_INDICES) {
+ if (charCount < segPtr->size - byteOffset) {
+ dstPtr->byteIndex += charCount;
+ goto forwardCharDone;
+ }
+ 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(textPtr, dstPtr->linePtr);
+ if (linePtr == NULL) {
+ dstPtr->byteIndex -= sizeof(char);
+ goto forwardCharDone;
+ }
+ dstPtr->linePtr = linePtr;
+ dstPtr->byteIndex = 0;
+ segPtr = dstPtr->linePtr->segPtr;
+ }
+
+ forwardCharDone:
+ if (infoPtr != NULL) {
+ TkTextFreeElideInfo(infoPtr);
+ ckfree(infoPtr);
+ }
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * TkTextIndexCountBytes --
+ *
+ * Given a pair of indices in a text widget, this function counts how
+ * many bytes are between the two indices. The two indices do not need
+ * to be ordered.
+ *
+ * Results:
+ * The number of bytes in the given range.
+ *
+ * Side effects:
+ * None.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+int
+TkTextIndexCountBytes(
+ CONST TkText *textPtr,
+ CONST TkTextIndex *indexPtr1, /* Index describing one location. */
+ CONST TkTextIndex *indexPtr2) /* Index describing second location. */
+{
+ int compare = TkTextIndexCmp(indexPtr1, indexPtr2);
+
+ if (compare == 0) {
+ return 0;
+ } else if (compare > 0) {
+ return IndexCountBytesOrdered(textPtr, indexPtr2, indexPtr1);
+ } else {
+ return IndexCountBytesOrdered(textPtr, indexPtr1, indexPtr2);
+ }
+}
+
+static int
+IndexCountBytesOrdered(
+ CONST TkText *textPtr,
+ CONST TkTextIndex *indexPtr1,
+ /* Index describing location of character from
+ * which to count. */
+ CONST TkTextIndex *indexPtr2)
+ /* Index describing location of last character
+ * at which to stop the count. */
+{
+ int byteCount, offset;
+ TkTextSegment *segPtr, *segPtr1;
+ TkTextLine *linePtr;
+
+ if (indexPtr1->linePtr == indexPtr2->linePtr) {
+ return indexPtr2->byteIndex - indexPtr1->byteIndex;
+ }
+
+ /*
+ * indexPtr2 is on a line strictly after the line containing indexPtr1.
+ * Add up:
+ * bytes between indexPtr1 and end of its line
+ * bytes in lines strictly between indexPtr1 and indexPtr2
+ * bytes between start of the indexPtr2 line and indexPtr2
+ */
+
+ segPtr1 = TkTextIndexToSeg(indexPtr1, &offset);
+ byteCount = -offset;
+ for (segPtr = segPtr1; segPtr != NULL; segPtr = segPtr->nextPtr) {
+ byteCount += segPtr->size;
+ }
+
+ linePtr = TkBTreeNextLine(textPtr, indexPtr1->linePtr);
+ while (linePtr != indexPtr2->linePtr) {
+ for (segPtr = linePtr->segPtr; segPtr != NULL;
+ segPtr = segPtr->nextPtr) {
+ byteCount += segPtr->size;
+ }
+ linePtr = TkBTreeNextLine(textPtr, linePtr);
+ if (linePtr == NULL) {
+ Tcl_Panic("TextIndexCountBytesOrdered ran out of lines");
+ }
+ }
+
+ byteCount += indexPtr2->byteIndex;
+
+ return byteCount;
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * TkTextIndexCount --
+ *
+ * Given an ordered pair of indices in a text widget, this function
+ * counts how many characters (not bytes) are between the two indices.
+ *
+ * It is illegal to call this function with unordered indices.
+ *
+ * Note that 'textPtr' is only used if we need to check for elided
+ * attributes, i.e. if type is COUNT_DISPLAY_INDICES or
+ * COUNT_DISPLAY_CHARS.
+ *
+ * Results:
+ * The number of characters in the given range, which meet the
+ * appropriate 'type' attributes.
+ *
+ * Side effects:
+ * None.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+int
+TkTextIndexCount(
+ const TkText *textPtr, /* Overall information about text widget. */
+ const TkTextIndex *indexPtr1,
+ /* Index describing location of character from
+ * which to count. */
+ const TkTextIndex *indexPtr2,
+ /* Index describing location of last character
+ * at which to stop the count. */
+ TkTextCountType type) /* The kind of indices to count. */
+{
+ TkTextLine *linePtr1;
+ TkTextSegment *segPtr, *seg2Ptr = NULL;
+ TkTextElideInfo *infoPtr = NULL;
+ int byteOffset, maxBytes, count = 0, elide = 0;
+ int checkElided = (type & COUNT_DISPLAY);
+
+ /*
+ * Find seg that contains src index, and remember how many bytes not to
+ * count in the given segment.
+ */
+
+ segPtr = TkTextIndexToSeg(indexPtr1, &byteOffset);
+ linePtr1 = indexPtr1->linePtr;
+
+ seg2Ptr = TkTextIndexToSeg(indexPtr2, &maxBytes);
+
+ if (checkElided) {
+ infoPtr = ckalloc(sizeof(TkTextElideInfo));
+ elide = TkTextIsElided(textPtr, indexPtr1, infoPtr);
+ }
+
+ while (1) {
+ /*
+ * Go through each segment in line adding up the number of characters.
+ */
+
+ for ( ; segPtr != NULL; segPtr = segPtr->nextPtr) {
+ /*
+ * If we do need to pay attention to the visibility of
+ * characters/indices, check that first. If the current segment
+ * isn't visible, then we simply continue the loop.
+ */
+
+ if (checkElided) {
+ if ((segPtr->typePtr == &tkTextToggleOffType)
+ || (segPtr->typePtr == &tkTextToggleOnType)) {
+ TkTextTag *tagPtr = segPtr->body.toggle.tagPtr;
+
+ /*
+ * The elide state only changes if this tag is either the
+ * current highest priority tag (and is therefore being
+ * toggled off), or it's a new tag with higher priority.
+ */
+
+ if (tagPtr->elideString != NULL) {
+ infoPtr->tagCnts[tagPtr->priority]++;
+ if (infoPtr->tagCnts[tagPtr->priority] & 1) {
+ infoPtr->tagPtrs[tagPtr->priority] = tagPtr;
+ }
+ if (tagPtr->priority >= infoPtr->elidePriority) {
+ if (segPtr->typePtr == &tkTextToggleOffType) {
+ /*
+ * If it is being toggled off, and it has an
+ * elide string, it must actually be the
+ * current highest priority tag, so this check
+ * is redundant:
+ */
+
+ if (tagPtr->priority!=infoPtr->elidePriority) {
+ Tcl_Panic("Bad tag priority being toggled off");
+ }
+
+ /*
+ * Find previous elide tag, if any (if not
+ * then elide will be zero, of course).
+ */
+
+ elide = 0;
+ while (--infoPtr->elidePriority > 0) {
+ if (infoPtr->tagCnts[
+ infoPtr->elidePriority] & 1) {
+ elide = infoPtr->tagPtrs[
+ infoPtr->elidePriority]->elide;
+ break;
+ }
+ }
+ } else {
+ elide = tagPtr->elide;
+ infoPtr->elidePriority = tagPtr->priority;
+ }
+ }
+ }
+ }
+ if (elide) {
+ if (segPtr == seg2Ptr) {
+ goto countDone;
+ }
+ byteOffset = 0;
+ continue;
+ }
+ }
+
+ if (segPtr->typePtr == &tkTextCharType) {
+ int byteLen = segPtr->size - byteOffset;
+ register unsigned char *str = (unsigned char *)
+ segPtr->body.chars + byteOffset;
+ register int i;
+
+ if (segPtr == seg2Ptr) {
+ if (byteLen > (maxBytes - byteOffset)) {
+ byteLen = maxBytes - byteOffset;
+ }
+ }
+ i = byteLen;
+
+ /*
+ * This is a speed sensitive function, so run specially over
+ * the string to count continuous ascii characters before
+ * resorting to the Tcl_NumUtfChars call. This is a long form
+ * of:
+ *
+ * stringPtr->numChars =
+ * Tcl_NumUtfChars(objPtr->bytes, objPtr->length);
+ */
+
+ while (i && (*str < 0xC0)) {
+ i--;
+ str++;
+ }
+ count += byteLen - i;
+ if (i) {
+ count += Tcl_NumUtfChars(segPtr->body.chars + byteOffset
+ + (byteLen - i), i);
+ }
+ } else {
+ if (type & COUNT_INDICES) {
+ int byteLen = segPtr->size - byteOffset;
+
+ if (segPtr == seg2Ptr) {
+ if (byteLen > (maxBytes - byteOffset)) {
+ byteLen = maxBytes - byteOffset;
+ }
+ }
+ count += byteLen;
+ }
+ }
+ if (segPtr == seg2Ptr) {
+ goto countDone;
+ }
+ 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.
+ */
+
+ linePtr1 = TkBTreeNextLine(textPtr, linePtr1);
+ if (linePtr1 == NULL) {
+ Tcl_Panic("Reached end of text widget when counting characters");
+ }
+ segPtr = linePtr1->segPtr;
+ }
+
+ countDone:
+ if (infoPtr != NULL) {
+ TkTextFreeElideInfo(infoPtr);
+ ckfree(infoPtr);
+ }
+ return count;
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * TkTextIndexBackBytes --
+ *
+ * Given an index for a text widget, this function 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.
+ *
+ * Returns 1 if we couldn't use all of 'byteCount' because we have run
+ * into the beginning or end of the text, and zero otherwise.
+ *
+ * Side effects:
+ * None.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+int
+TkTextIndexBackBytes(
+ const TkText *textPtr,
+ const TkTextIndex *srcPtr, /* Source index. */
+ int byteCount, /* How many bytes backward to move. May be
+ * negative. */
+ TkTextIndex *dstPtr) /* Destination index: gets modified. */
+{
+ TkTextSegment *segPtr;
+ int lineIndex;
+
+ if (byteCount < 0) {
+ return TkTextIndexForwBytes(textPtr, srcPtr, -byteCount, dstPtr);
+ }
+
+ *dstPtr = *srcPtr;
+ dstPtr->byteIndex -= byteCount;
+ lineIndex = -1;
+ while (dstPtr->byteIndex < 0) {
+ /*
+ * Move back one line in the text. If we run off the beginning of the
+ * file then just return the first character in the text.
+ */
+
+ if (lineIndex < 0) {
+ lineIndex = TkBTreeLinesTo(textPtr, dstPtr->linePtr);
+ }
+ if (lineIndex == 0) {
+ dstPtr->byteIndex = 0;
+ return 1;
+ }
+ lineIndex--;
+ dstPtr->linePtr = TkBTreeFindLine(dstPtr->tree, textPtr, lineIndex);
+
+ /*
+ * Compute the length of the line and add that to dstPtr->charIndex.
+ */
+
+ for (segPtr = dstPtr->linePtr->segPtr; segPtr != NULL;
+ segPtr = segPtr->nextPtr) {
+ dstPtr->byteIndex += segPtr->size;
+ }
+ }
+ return 0;
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * TkTextIndexBackChars --
+ *
+ * Given an index for a text widget, this function creates a new index
+ * that points "count" items of type given by "type" earlier than the
+ * source index. "count" can be zero, which is useful in the case where
+ * one wishes to move backward by display (non-elided) chars or indices
+ * or one wishes to move backward by chars, skipping any intervening
+ * indices. In this case the returned index *dstPtr will point just
+ * _after_ the first acceptable index which is encountered.
+ *
+ * Results:
+ * *dstPtr is modified to refer to the character "count" items before
+ * srcPtr, or to the first index in the window if there aren't sufficient
+ * items earlier than srcPtr.
+ *
+ * Side effects:
+ * None.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+void
+TkTextIndexBackChars(
+ const TkText *textPtr, /* Overall information about text widget. */
+ const TkTextIndex *srcPtr, /* Source index. */
+ int charCount, /* How many characters backward to move. May
+ * be negative. */
+ TkTextIndex *dstPtr, /* Destination index: gets modified. */
+ TkTextCountType type) /* The type of item to count */
+{
+ TkTextSegment *segPtr, *oldPtr;
+ TkTextElideInfo *infoPtr = NULL;
+ int lineIndex, segSize;
+ const char *p, *start, *end;
+ int elide = 0;
+ int checkElided = (type & COUNT_DISPLAY);
+
+ if (charCount < 0) {
+ TkTextIndexForwChars(textPtr, srcPtr, -charCount, dstPtr, type);
+ return;
+ }
+ if (checkElided) {
+ infoPtr = ckalloc(sizeof(TkTextElideInfo));
+ elide = TkTextIsElided(textPtr, srcPtr, infoPtr);
+ }
+
+ *dstPtr = *srcPtr;
+
+ /*
+ * Find offset within seg that contains byteIndex. Move backward specified
+ * number of chars.
+ */
+
+ lineIndex = -1;
+
+ segSize = dstPtr->byteIndex;
+
+ if (checkElided) {
+ segPtr = infoPtr->segPtr;
+ segSize -= infoPtr->segOffset;
+ } else {
+ TkTextLine *linePtr = dstPtr->linePtr;
+ for (segPtr = linePtr->segPtr; ; segPtr = segPtr->nextPtr) {
+ if (segPtr == NULL) {
+ /*
+ * Two logical lines merged into one display line through
+ * eliding of a newline.
+ */
+
+ linePtr = TkBTreeNextLine(NULL, linePtr);
+ segPtr = linePtr->segPtr;
+ }
+ if (segSize <= segPtr->size) {
+ break;
+ }
+ segSize -= segPtr->size;
+ }
+ }
+
+ /*
+ * Now segPtr points to the segment containing the starting index.
+ */
+
+ while (1) {
+ /*
+ * If we do need to pay attention to the visibility of
+ * characters/indices, check that first. If the current segment isn't
+ * visible, then we simply continue the loop.
+ */
+
+ if (checkElided && ((segPtr->typePtr == &tkTextToggleOffType)
+ || (segPtr->typePtr == &tkTextToggleOnType))) {
+ TkTextTag *tagPtr = segPtr->body.toggle.tagPtr;
+
+ /*
+ * The elide state only changes if this tag is either the current
+ * highest priority tag (and is therefore being toggled off), or
+ * it's a new tag with higher priority.
+ */
+
+ if (tagPtr->elideString != NULL) {
+ infoPtr->tagCnts[tagPtr->priority]++;
+ if (infoPtr->tagCnts[tagPtr->priority] & 1) {
+ infoPtr->tagPtrs[tagPtr->priority] = tagPtr;
+ }
+ if (tagPtr->priority >= infoPtr->elidePriority) {
+ if (segPtr->typePtr == &tkTextToggleOnType) {
+ /*
+ * If it is being toggled on, and it has an elide
+ * string, it must actually be the current highest
+ * priority tag, so this check is redundant:
+ */
+
+ if (tagPtr->priority != infoPtr->elidePriority) {
+ Tcl_Panic("Bad tag priority being toggled on");
+ }
+
+ /*
+ * Find previous elide tag, if any (if not then elide
+ * will be zero, of course).
+ */
+
+ elide = 0;
+ while (--infoPtr->elidePriority > 0) {
+ if (infoPtr->tagCnts[infoPtr->elidePriority] & 1) {
+ elide = infoPtr->tagPtrs[
+ infoPtr->elidePriority]->elide;
+ break;
+ }
+ }
+ } else {
+ elide = tagPtr->elide;
+ infoPtr->elidePriority = tagPtr->priority;
+ }
+ }
+ }
+ }
+
+ if (!elide) {
+ 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);
+ goto backwardCharDone;
+ }
+ if (p == start) {
+ break;
+ }
+ charCount--;
+ }
+ } else {
+ if (type & COUNT_INDICES) {
+ if (charCount <= segSize) {
+ dstPtr->byteIndex -= charCount;
+ goto backwardCharDone;
+ }
+ 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 = TkBTreeLinesTo(textPtr, dstPtr->linePtr);
+ }
+ if (lineIndex == 0) {
+ dstPtr->byteIndex = 0;
+ goto backwardCharDone;
+ }
+ lineIndex--;
+ dstPtr->linePtr = TkBTreeFindLine(dstPtr->tree, textPtr, 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;
+ }
+
+ backwardCharDone:
+ if (infoPtr != NULL) {
+ TkTextFreeElideInfo(infoPtr);
+ ckfree(infoPtr);
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * StartEnd --
+ *
+ * This function handles modifiers like "wordstart" and "lineend" to
+ * adjust indices forwards or backwards.
+ *
+ * Results:
+ * If the modifier is successfully parsed then the return value is the
+ * address of the first character after the modifier, and *indexPtr is
+ * updated to reflect the modifier. If there is a syntax error in the
+ * modifier then NULL is returned.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static const char *
+StartEnd(
+ TkText *textPtr, /* Information about text widget. */
+ const char *string, /* String to parse for additional info about
+ * modifier (count and units). Points to first
+ * character of modifier word. */
+ TkTextIndex *indexPtr) /* Index to modify based on string. */
+{
+ const char *p;
+ size_t length;
+ register TkTextSegment *segPtr;
+ int modifier;
+
+ /*
+ * Find the end of the modifier word.
+ */
+
+ for (p = string; isalnum(UCHAR(*p)); p++) {
+ /* Empty loop body. */
+ }
+
+ length = p-string;
+ if ((*string == 'd') &&
+ (strncmp(string, "display", (length > 7 ? 7 : length)) == 0)) {
+ modifier = TKINDEX_DISPLAY;
+ if (length > 7) {
+ p -= (length - 7);
+ }
+ } else if ((*string == 'a') &&
+ (strncmp(string, "any", (length > 3 ? 3 : length)) == 0)) {
+ modifier = TKINDEX_ANY;
+ if (length > 3) {
+ p -= (length - 3);
+ }
+ } else {
+ modifier = TKINDEX_NONE;
+ }
+
+ /*
+ * If we had a modifier, which we interpreted ok, so now forward to the
+ * actual units.
+ */
+
+ if (modifier != TKINDEX_NONE) {
+ while (isspace(UCHAR(*p))) {
+ p++;
+ }
+ string = p;
+ while ((*p!='\0') && !isspace(UCHAR(*p)) && (*p!='+') && (*p!='-')) {
+ p++;
+ }
+ length = p - string;
+ }
+
+ if ((*string == 'l') && (strncmp(string, "lineend", length) == 0)
+ && (length >= 5)) {
+ if (modifier == TKINDEX_DISPLAY) {
+ TkTextFindDisplayLineEnd(textPtr, indexPtr, 1, NULL);
+ } else {
+ indexPtr->byteIndex = 0;
+ for (segPtr = indexPtr->linePtr->segPtr; segPtr != NULL;
+ segPtr = segPtr->nextPtr) {
+ indexPtr->byteIndex += segPtr->size;
+ }
+
+ /*
+ * We know '\n' is encoded with a single byte index.
+ */
+
+ indexPtr->byteIndex -= sizeof(char);
+ }
+ } else if ((*string == 'l') && (strncmp(string, "linestart", length) == 0)
+ && (length >= 5)) {
+ if (modifier == TKINDEX_DISPLAY) {
+ TkTextFindDisplayLineEnd(textPtr, indexPtr, 0, NULL);
+ } else {
+ indexPtr->byteIndex = 0;
+ }
+ } else if ((*string == 'w') && (strncmp(string, "wordend", length) == 0)
+ && (length >= 5)) {
+ int firstChar = 1;
+ int offset;
+
+ /*
+ * If the current character isn't part of a word then just move
+ * forward one character. Otherwise move forward until finding a
+ * character that isn't part of a word and stop there.
+ */
+
+ if (modifier == TKINDEX_DISPLAY) {
+ TkTextIndexForwChars(textPtr, indexPtr, 0, indexPtr,
+ COUNT_DISPLAY_INDICES);
+ }
+ segPtr = TkTextIndexToSeg(indexPtr, &offset);
+ while (1) {
+ int chSize = 1;
+
+ if (segPtr->typePtr == &tkTextCharType) {
+ Tcl_UniChar ch;
+
+ chSize = Tcl_UtfToUniChar(segPtr->body.chars + offset, &ch);
+ if (!Tcl_UniCharIsWordChar(ch)) {
+ break;
+ }
+ firstChar = 0;
+ }
+ offset += chSize;
+ indexPtr->byteIndex += chSize;
+ if (offset >= segPtr->size) {
+ segPtr = TkTextIndexToSeg(indexPtr, &offset);
+ }
+ }
+ if (firstChar) {
+ if (modifier == TKINDEX_DISPLAY) {
+ TkTextIndexForwChars(textPtr, indexPtr, 1, indexPtr,
+ COUNT_DISPLAY_INDICES);
+ } else {
+ TkTextIndexForwChars(NULL, indexPtr, 1, indexPtr,
+ COUNT_INDICES);
+ }
+ }
+ } else if ((*string == 'w') && (strncmp(string, "wordstart", length) == 0)
+ && (length >= 5)) {
+ int firstChar = 1;
+ int offset;
+
+ if (modifier == TKINDEX_DISPLAY) {
+ TkTextIndexForwChars(textPtr, indexPtr, 0, indexPtr,
+ COUNT_DISPLAY_INDICES);
+ }
+
+ /*
+ * Starting with the current character, look for one that's not part
+ * of a word and keep moving backward until you find one. Then if the
+ * character found wasn't the first one, move forward again one
+ * position.
+ */
+
+ segPtr = TkTextIndexToSeg(indexPtr, &offset);
+ while (1) {
+ int chSize = 1;
+
+ if (segPtr->typePtr == &tkTextCharType) {
+ Tcl_UniChar ch;
+
+ Tcl_UtfToUniChar(segPtr->body.chars + offset, &ch);
+ if (!Tcl_UniCharIsWordChar(ch)) {
+ break;
+ }
+ if (offset > 0) {
+ chSize = (segPtr->body.chars + offset
+ - Tcl_UtfPrev(segPtr->body.chars + offset,
+ segPtr->body.chars));
+ }
+ firstChar = 0;
+ }
+ if (offset == 0) {
+ if (modifier == TKINDEX_DISPLAY) {
+ TkTextIndexBackChars(textPtr, indexPtr, 1, indexPtr,
+ COUNT_DISPLAY_INDICES);
+ } else {
+ TkTextIndexBackChars(NULL, indexPtr, 1, indexPtr,
+ COUNT_INDICES);
+ }
+ } else {
+ indexPtr->byteIndex -= chSize;
+ }
+ offset -= chSize;
+ if (offset < 0) {
+ if (indexPtr->byteIndex == 0) {
+ goto done;
+ }
+ segPtr = TkTextIndexToSeg(indexPtr, &offset);
+ }
+ }
+
+ if (!firstChar) {
+ if (modifier == TKINDEX_DISPLAY) {
+ TkTextIndexForwChars(textPtr, indexPtr, 1, indexPtr,
+ COUNT_DISPLAY_INDICES);
+ } else {
+ TkTextIndexForwChars(NULL, indexPtr, 1, indexPtr,
+ COUNT_INDICES);
+ }
+ }
+ } else {
+ return NULL;
+ }
+
+ done:
+ return p;
+}
+
+/*
+ * Local Variables:
+ * mode: c
+ * c-basic-offset: 4
+ * fill-column: 78
+ * End:
+ */
diff --git a/tk8.6/generic/tkTextMark.c b/tk8.6/generic/tkTextMark.c
new file mode 100644
index 0000000..6a41c77
--- /dev/null
+++ b/tk8.6/generic/tkTextMark.c
@@ -0,0 +1,1027 @@
+/*
+ * tkTextMark.c --
+ *
+ * This file contains the functions that implement marks for text
+ * widgets.
+ *
+ * Copyright (c) 1994 The Regents of the University of California.
+ * Copyright (c) 1994-1997 Sun Microsystems, Inc.
+ *
+ * See the file "license.terms" for information on usage and redistribution of
+ * this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ */
+
+#include "tkInt.h"
+#include "tkText.h"
+#include "tk3d.h"
+
+/*
+ * Macro that determines the size of a mark segment:
+ */
+
+#define MSEG_SIZE ((unsigned) (Tk_Offset(TkTextSegment, body) \
+ + sizeof(TkTextMark)))
+
+/*
+ * Forward references for functions defined in this file:
+ */
+
+static Tcl_Obj * GetMarkName(TkText *textPtr, TkTextSegment *segPtr);
+static void InsertUndisplayProc(TkText *textPtr,
+ TkTextDispChunk *chunkPtr);
+static int MarkDeleteProc(TkTextSegment *segPtr,
+ TkTextLine *linePtr, int treeGone);
+static TkTextSegment * MarkCleanupProc(TkTextSegment *segPtr,
+ TkTextLine *linePtr);
+static void MarkCheckProc(TkTextSegment *segPtr,
+ TkTextLine *linePtr);
+static int MarkLayoutProc(TkText *textPtr, TkTextIndex *indexPtr,
+ TkTextSegment *segPtr, int offset, int maxX,
+ int maxChars, int noCharsYet, TkWrapMode wrapMode,
+ TkTextDispChunk *chunkPtr);
+static int MarkFindNext(Tcl_Interp *interp,
+ TkText *textPtr, Tcl_Obj *markName);
+static int MarkFindPrev(Tcl_Interp *interp,
+ TkText *textPtr, Tcl_Obj *markName);
+
+
+/*
+ * The following structures declare the "mark" segment types. There are
+ * actually two types for marks, one with left gravity and one with right
+ * gravity. They are identical except for their gravity property.
+ */
+
+const Tk_SegType tkTextRightMarkType = {
+ "mark", /* name */
+ 0, /* leftGravity */
+ NULL, /* splitProc */
+ MarkDeleteProc, /* deleteProc */
+ MarkCleanupProc, /* cleanupProc */
+ NULL, /* lineChangeProc */
+ MarkLayoutProc, /* layoutProc */
+ MarkCheckProc /* checkProc */
+};
+
+const Tk_SegType tkTextLeftMarkType = {
+ "mark", /* name */
+ 1, /* leftGravity */
+ NULL, /* splitProc */
+ MarkDeleteProc, /* deleteProc */
+ MarkCleanupProc, /* cleanupProc */
+ NULL, /* lineChangeProc */
+ MarkLayoutProc, /* layoutProc */
+ MarkCheckProc /* checkProc */
+};
+
+/*
+ *--------------------------------------------------------------
+ *
+ * TkTextMarkCmd --
+ *
+ * This function is invoked to process the "mark" options of the widget
+ * command for text widgets. See the user documentation for details on
+ * what it does.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * See the user documentation.
+ *
+ *--------------------------------------------------------------
+ */
+
+int
+TkTextMarkCmd(
+ register TkText *textPtr, /* Information about text widget. */
+ Tcl_Interp *interp, /* Current interpreter. */
+ int objc, /* Number of arguments. */
+ Tcl_Obj *const objv[]) /* Argument objects. Someone else has already
+ * parsed this command enough to know that
+ * objv[1] is "mark". */
+{
+ Tcl_HashEntry *hPtr;
+ TkTextSegment *markPtr;
+ Tcl_HashSearch search;
+ TkTextIndex index;
+ const Tk_SegType *newTypePtr;
+ int optionIndex;
+ static const char *const markOptionStrings[] = {
+ "gravity", "names", "next", "previous", "set", "unset", NULL
+ };
+ enum markOptions {
+ MARK_GRAVITY, MARK_NAMES, MARK_NEXT, MARK_PREVIOUS, MARK_SET,
+ MARK_UNSET
+ };
+
+ if (objc < 3) {
+ Tcl_WrongNumArgs(interp, 2, objv, "option ?arg ...?");
+ return TCL_ERROR;
+ }
+ if (Tcl_GetIndexFromObjStruct(interp, objv[2], markOptionStrings,
+ sizeof(char *), "mark option", 0, &optionIndex) != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ switch ((enum markOptions) optionIndex) {
+ case MARK_GRAVITY: {
+ char c;
+ int length;
+ const char *str;
+
+ if (objc < 4 || objc > 5) {
+ Tcl_WrongNumArgs(interp, 3, objv, "markName ?gravity?");
+ return TCL_ERROR;
+ }
+ str = Tcl_GetStringFromObj(objv[3], &length);
+ if (length == 6 && !strcmp(str, "insert")) {
+ markPtr = textPtr->insertMarkPtr;
+ } else if (length == 7 && !strcmp(str, "current")) {
+ markPtr = textPtr->currentMarkPtr;
+ } else {
+ hPtr = Tcl_FindHashEntry(&textPtr->sharedTextPtr->markTable, str);
+ if (hPtr == NULL) {
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "there is no mark named \"%s\"", str));
+ Tcl_SetErrorCode(interp, "TK", "LOOKUP", "TEXT_MARK", str,
+ NULL);
+ return TCL_ERROR;
+ }
+ markPtr = Tcl_GetHashValue(hPtr);
+ }
+ if (objc == 4) {
+ const char *typeStr;
+
+ if (markPtr->typePtr == &tkTextRightMarkType) {
+ typeStr = "right";
+ } else {
+ typeStr = "left";
+ }
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(typeStr, -1));
+ return TCL_OK;
+ }
+ str = Tcl_GetStringFromObj(objv[4],&length);
+ c = str[0];
+ if ((c == 'l') && (strncmp(str, "left", (unsigned) length) == 0)) {
+ newTypePtr = &tkTextLeftMarkType;
+ } else if ((c == 'r') &&
+ (strncmp(str, "right", (unsigned) length) == 0)) {
+ newTypePtr = &tkTextRightMarkType;
+ } else {
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "bad mark gravity \"%s\": must be left or right", str));
+ Tcl_SetErrorCode(interp, "TK", "VALUE", "MARK_GRAVITY", NULL);
+ return TCL_ERROR;
+ }
+ TkTextMarkSegToIndex(textPtr, markPtr, &index);
+ TkBTreeUnlinkSegment(markPtr, markPtr->body.mark.linePtr);
+ markPtr->typePtr = newTypePtr;
+ TkBTreeLinkSegment(markPtr, &index);
+ break;
+ }
+ case MARK_NAMES: {
+ Tcl_Obj *resultObj;
+
+ if (objc != 3) {
+ Tcl_WrongNumArgs(interp, 3, objv, NULL);
+ return TCL_ERROR;
+ }
+ resultObj = Tcl_NewObj();
+ Tcl_ListObjAppendElement(NULL, resultObj, Tcl_NewStringObj(
+ "insert", -1));
+ Tcl_ListObjAppendElement(NULL, resultObj, Tcl_NewStringObj(
+ "current", -1));
+ for (hPtr = Tcl_FirstHashEntry(&textPtr->sharedTextPtr->markTable,
+ &search); hPtr != NULL; hPtr = Tcl_NextHashEntry(&search)) {
+ Tcl_ListObjAppendElement(NULL, resultObj, Tcl_NewStringObj(
+ Tcl_GetHashKey(&textPtr->sharedTextPtr->markTable, hPtr),
+ -1));
+ }
+ Tcl_SetObjResult(interp, resultObj);
+ break;
+ }
+ case MARK_NEXT:
+ if (objc != 4) {
+ Tcl_WrongNumArgs(interp, 3, objv, "index");
+ return TCL_ERROR;
+ }
+ return MarkFindNext(interp, textPtr, objv[3]);
+ case MARK_PREVIOUS:
+ if (objc != 4) {
+ Tcl_WrongNumArgs(interp, 3, objv, "index");
+ return TCL_ERROR;
+ }
+ return MarkFindPrev(interp, textPtr, objv[3]);
+ case MARK_SET:
+ if (objc != 5) {
+ Tcl_WrongNumArgs(interp, 3, objv, "markName index");
+ return TCL_ERROR;
+ }
+ if (TkTextGetObjIndex(interp, textPtr, objv[4], &index) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ TkTextSetMark(textPtr, Tcl_GetString(objv[3]), &index);
+ return TCL_OK;
+ case MARK_UNSET: {
+ int i;
+
+ for (i = 3; i < objc; i++) {
+ hPtr = Tcl_FindHashEntry(&textPtr->sharedTextPtr->markTable,
+ Tcl_GetString(objv[i]));
+ if (hPtr != NULL) {
+ markPtr = Tcl_GetHashValue(hPtr);
+
+ /*
+ * Special case not needed with peer widgets.
+ */
+
+ if ((markPtr == textPtr->insertMarkPtr)
+ || (markPtr == textPtr->currentMarkPtr)) {
+ continue;
+ }
+ TkBTreeUnlinkSegment(markPtr, markPtr->body.mark.linePtr);
+ Tcl_DeleteHashEntry(hPtr);
+ ckfree(markPtr);
+ }
+ }
+ break;
+ }
+ }
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkTextSetMark --
+ *
+ * Set a mark to a particular position, creating a new mark if one
+ * doesn't already exist.
+ *
+ * Results:
+ * The return value is a pointer to the mark that was just set.
+ *
+ * Side effects:
+ * A new mark is created, or an existing mark is moved.
+ *
+ *----------------------------------------------------------------------
+ */
+
+TkTextSegment *
+TkTextSetMark(
+ TkText *textPtr, /* Text widget in which to create mark. */
+ const char *name, /* Name of mark to set. */
+ TkTextIndex *indexPtr) /* Where to set mark. */
+{
+ Tcl_HashEntry *hPtr = NULL;
+ TkTextSegment *markPtr;
+ TkTextIndex insertIndex;
+ int isNew, widgetSpecific;
+
+ if (!strcmp(name, "insert")) {
+ widgetSpecific = 1;
+ markPtr = textPtr->insertMarkPtr;
+ isNew = (markPtr == NULL ? 1 : 0);
+ } else if (!strcmp(name, "current")) {
+ widgetSpecific = 2;
+ markPtr = textPtr->currentMarkPtr;
+ isNew = (markPtr == NULL ? 1 : 0);
+ } else {
+ widgetSpecific = 0;
+ hPtr = Tcl_CreateHashEntry(&textPtr->sharedTextPtr->markTable, name,
+ &isNew);
+ markPtr = Tcl_GetHashValue(hPtr);
+ }
+ if (!isNew) {
+ /*
+ * If this is the insertion point that's being moved, be sure to force
+ * a display update at the old position. Also, don't let the insertion
+ * cursor be after the final newline of the file.
+ */
+
+ if (markPtr == textPtr->insertMarkPtr) {
+ TkTextIndex index, index2;
+ int nblines;
+
+ TkTextMarkSegToIndex(textPtr, textPtr->insertMarkPtr, &index);
+ TkTextIndexForwChars(NULL, &index, 1, &index2, COUNT_INDICES);
+
+ /*
+ * While we wish to redisplay, no heights have changed, so no need
+ * to call TkTextInvalidateLineMetrics.
+ */
+
+ TkTextChanged(NULL, textPtr, &index, &index2);
+
+ /*
+ * The number of lines in the widget is zero if and only if it is
+ * a partial peer with -startline == -endline, i.e. an empty
+ * peer. In this case the mark shall be set exactly at the given
+ * index, and not one character backwards (bug 3487407).
+ */
+
+ nblines = TkBTreeNumLines(textPtr->sharedTextPtr->tree, textPtr);
+ if ((TkBTreeLinesTo(textPtr, indexPtr->linePtr) == nblines)
+ && (nblines > 0)) {
+ TkTextIndexBackChars(NULL,indexPtr, 1, &insertIndex,
+ COUNT_INDICES);
+ indexPtr = &insertIndex;
+ }
+ }
+ TkBTreeUnlinkSegment(markPtr, markPtr->body.mark.linePtr);
+ } else {
+ markPtr = ckalloc(MSEG_SIZE);
+ markPtr->typePtr = &tkTextRightMarkType;
+ markPtr->size = 0;
+ markPtr->body.mark.textPtr = textPtr;
+ markPtr->body.mark.linePtr = indexPtr->linePtr;
+ markPtr->body.mark.hPtr = hPtr;
+ if (widgetSpecific == 0) {
+ Tcl_SetHashValue(hPtr, markPtr);
+ } else if (widgetSpecific == 1) {
+ textPtr->insertMarkPtr = markPtr;
+ } else {
+ textPtr->currentMarkPtr = markPtr;
+ }
+ }
+ TkBTreeLinkSegment(markPtr, indexPtr);
+
+ /*
+ * If the mark is the insertion cursor, then update the screen at the
+ * mark's new location.
+ */
+
+ if (markPtr == textPtr->insertMarkPtr) {
+ TkTextIndex index2;
+
+ TkTextIndexForwChars(NULL, indexPtr, 1, &index2, COUNT_INDICES);
+
+ /*
+ * While we wish to redisplay, no heights have changed, so no need to
+ * call TkTextInvalidateLineMetrics
+ */
+
+ TkTextChanged(NULL, textPtr, indexPtr, &index2);
+ }
+ return markPtr;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * TkTextMarkSegToIndex --
+ *
+ * Given a segment that is a mark, create an index that refers to the
+ * next text character (or other text segment with non-zero size) after
+ * the mark.
+ *
+ * Results:
+ * *IndexPtr is filled in with index information.
+ *
+ * Side effects:
+ * None.
+ *
+ *--------------------------------------------------------------
+ */
+
+void
+TkTextMarkSegToIndex(
+ TkText *textPtr, /* Text widget containing mark. */
+ TkTextSegment *markPtr, /* Mark segment. */
+ TkTextIndex *indexPtr) /* Index information gets stored here. */
+{
+ TkTextSegment *segPtr;
+
+ indexPtr->tree = textPtr->sharedTextPtr->tree;
+ indexPtr->linePtr = markPtr->body.mark.linePtr;
+ indexPtr->byteIndex = 0;
+ for (segPtr = indexPtr->linePtr->segPtr; segPtr != markPtr;
+ segPtr = segPtr->nextPtr) {
+ indexPtr->byteIndex += segPtr->size;
+ }
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * TkTextMarkNameToIndex --
+ *
+ * Given the name of a mark, return an index corresponding to the mark
+ * name.
+ *
+ * Results:
+ * The return value is TCL_OK if "name" exists as a mark in the text
+ * widget and is located within its -starline/-endline range. In this
+ * case *indexPtr is filled in with the next segment who is after the
+ * mark whose size is non-zero. TCL_ERROR is returned if the mark
+ * doesn't exist in the text widget, or if it is out of its -starline/
+ * -endline range. In this latter case *indexPtr still contains valid
+ * information, in particular TkTextMarkNameToIndex called with the
+ * "insert" or "current" mark name may return TCL_ERROR, but *indexPtr
+ * contains the correct index of this mark before -startline or after
+ * -endline.
+ *
+ * Side effects:
+ * None.
+ *
+ *--------------------------------------------------------------
+ */
+
+int
+TkTextMarkNameToIndex(
+ TkText *textPtr, /* Text widget containing mark. */
+ const char *name, /* Name of mark. */
+ TkTextIndex *indexPtr) /* Index information gets stored here. */
+{
+ TkTextSegment *segPtr;
+ TkTextIndex index;
+ int start, end;
+
+ if (textPtr == NULL) {
+ return TCL_ERROR;
+ }
+
+ if (!strcmp(name, "insert")) {
+ segPtr = textPtr->insertMarkPtr;
+ } else if (!strcmp(name, "current")) {
+ segPtr = textPtr->currentMarkPtr;
+ } else {
+ Tcl_HashEntry *hPtr =
+ Tcl_FindHashEntry(&textPtr->sharedTextPtr->markTable, name);
+
+ if (hPtr == NULL) {
+ return TCL_ERROR;
+ }
+ segPtr = Tcl_GetHashValue(hPtr);
+ }
+ TkTextMarkSegToIndex(textPtr, segPtr, indexPtr);
+
+ /* If indexPtr refers to somewhere outside the -startline/-endline
+ * range limits of the widget, error out since the mark indeed is not
+ * reachable from this text widget (it may be reachable from a peer)
+ * (bug 1630271).
+ */
+
+ if (textPtr->start != NULL) {
+ start = TkBTreeLinesTo(NULL, textPtr->start);
+ TkTextMakeByteIndex(textPtr->sharedTextPtr->tree, NULL, start, 0,
+ &index);
+ if (TkTextIndexCmp(indexPtr, &index) < 0) {
+ return TCL_ERROR;
+ }
+ }
+ if (textPtr->end != NULL) {
+ end = TkBTreeLinesTo(NULL, textPtr->end);
+ TkTextMakeByteIndex(textPtr->sharedTextPtr->tree, NULL, end, 0,
+ &index);
+ if (TkTextIndexCmp(indexPtr, &index) > 0) {
+ return TCL_ERROR;
+ }
+ }
+ return TCL_OK;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * MarkDeleteProc --
+ *
+ * This function is invoked by the text B-tree code whenever a mark lies
+ * in a range of characters being deleted.
+ *
+ * Results:
+ * Returns 1 to indicate that deletion has been rejected.
+ *
+ * Side effects:
+ * None (even if the whole tree is being deleted we don't free up the
+ * mark; it will be done elsewhere).
+ *
+ *--------------------------------------------------------------
+ */
+
+ /* ARGSUSED */
+static int
+MarkDeleteProc(
+ TkTextSegment *segPtr, /* Segment being deleted. */
+ TkTextLine *linePtr, /* Line containing segment. */
+ int treeGone) /* Non-zero means the entire tree is being
+ * deleted, so everything must get cleaned
+ * up. */
+{
+ return 1;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * MarkCleanupProc --
+ *
+ * This function is invoked by the B-tree code whenever a mark segment is
+ * moved from one line to another.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The linePtr field of the segment gets updated.
+ *
+ *--------------------------------------------------------------
+ */
+
+static TkTextSegment *
+MarkCleanupProc(
+ TkTextSegment *markPtr, /* Mark segment that's being moved. */
+ TkTextLine *linePtr) /* Line that now contains segment. */
+{
+ markPtr->body.mark.linePtr = linePtr;
+ return markPtr;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * MarkLayoutProc --
+ *
+ * This function is the "layoutProc" for mark segments.
+ *
+ * Results:
+ * If the mark isn't the insertion cursor then the return value is -1 to
+ * indicate that this segment shouldn't be displayed. If the mark is the
+ * insertion character then 1 is returned and the chunkPtr structure is
+ * filled in.
+ *
+ * Side effects:
+ * None, except for filling in chunkPtr.
+ *
+ *--------------------------------------------------------------
+ */
+
+static int
+MarkLayoutProc(
+ TkText *textPtr, /* Text widget being layed out. */
+ TkTextIndex *indexPtr, /* Identifies first character in chunk. */
+ TkTextSegment *segPtr, /* Segment corresponding to indexPtr. */
+ int offset, /* Offset within segPtr corresponding to
+ * indexPtr (always 0). */
+ int maxX, /* Chunk must not occupy pixels at this
+ * position or higher. */
+ int maxChars, /* Chunk must not include more than this many
+ * characters. */
+ int noCharsYet, /* Non-zero means no characters have been
+ * assigned to this line yet. */
+ TkWrapMode wrapMode, /* Not used. */
+ register TkTextDispChunk *chunkPtr)
+ /* Structure to fill in with information about
+ * this chunk. The x field has already been
+ * set by the caller. */
+{
+ if (segPtr != textPtr->insertMarkPtr) {
+ return -1;
+ }
+
+ chunkPtr->displayProc = TkTextInsertDisplayProc;
+ chunkPtr->undisplayProc = InsertUndisplayProc;
+ chunkPtr->measureProc = NULL;
+ chunkPtr->bboxProc = NULL;
+ chunkPtr->numBytes = 0;
+ chunkPtr->minAscent = 0;
+ chunkPtr->minDescent = 0;
+ chunkPtr->minHeight = 0;
+ chunkPtr->width = 0;
+
+ /*
+ * Note: can't break a line after the insertion cursor: this prevents the
+ * insertion cursor from being stranded at the end of a line.
+ */
+
+ chunkPtr->breakIndex = -1;
+ chunkPtr->clientData = textPtr;
+ return 1;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * TkTextInsertDisplayProc --
+ *
+ * This function is called to display the insertion cursor.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Graphics are drawn.
+ *
+ *--------------------------------------------------------------
+ */
+
+ /* ARGSUSED */
+void
+TkTextInsertDisplayProc(
+ TkText *textPtr, /* The current text widget. */
+ TkTextDispChunk *chunkPtr, /* Chunk that is to be drawn. */
+ int x, /* X-position in dst at which to draw this
+ * chunk (may differ from the x-position in
+ * the chunk because of scrolling). */
+ int y, /* Y-position at which to draw this chunk in
+ * dst (x-position is in the chunk itself). */
+ int height, /* Total height of line. */
+ int baseline, /* Offset of baseline from y. */
+ Display *display, /* Display to use for drawing. */
+ Drawable dst, /* Pixmap or window in which to draw chunk. */
+ int screenY) /* Y-coordinate in text window that
+ * corresponds to y. */
+{
+ /*
+ * We have no need for the clientData.
+ */
+
+ /* TkText *textPtr = chunkPtr->clientData; */
+ TkTextIndex index;
+ int halfWidth = textPtr->insertWidth/2;
+ int rightSideWidth;
+ int ix = 0, iy = 0, iw = 0, ih = 0, charWidth = 0;
+
+ if (textPtr->insertCursorType) {
+ TkTextMarkSegToIndex(textPtr, textPtr->insertMarkPtr, &index);
+ TkTextIndexBbox(textPtr, &index, &ix, &iy, &iw, &ih, &charWidth);
+ rightSideWidth = charWidth + halfWidth;
+ } else {
+ rightSideWidth = halfWidth;
+ }
+
+ if ((x + rightSideWidth) < 0) {
+ /*
+ * The insertion cursor is off-screen. Indicate caret at 0,0 and
+ * return.
+ */
+
+ Tk_SetCaretPos(textPtr->tkwin, 0, 0, height);
+ return;
+ }
+
+ Tk_SetCaretPos(textPtr->tkwin, x - halfWidth, screenY, height);
+
+ /*
+ * As a special hack to keep the cursor visible on mono displays (or
+ * anywhere else that the selection and insertion cursors have the same
+ * color) write the default background in the cursor area (instead of
+ * nothing) when the cursor isn't on. Otherwise the selection might hide
+ * the cursor.
+ */
+
+ if (textPtr->flags & GOT_FOCUS) {
+ if (textPtr->flags & INSERT_ON) {
+ Tk_Fill3DRectangle(textPtr->tkwin, dst, textPtr->insertBorder,
+ x - halfWidth, y, charWidth + textPtr->insertWidth,
+ height, textPtr->insertBorderWidth, TK_RELIEF_RAISED);
+ } else if (textPtr->selBorder == textPtr->insertBorder) {
+ Tk_Fill3DRectangle(textPtr->tkwin, dst, textPtr->border,
+ x - halfWidth, y, charWidth + textPtr->insertWidth,
+ height, 0, TK_RELIEF_FLAT);
+ }
+ } else if (textPtr->insertUnfocussed == TK_TEXT_INSERT_NOFOCUS_HOLLOW) {
+ if (textPtr->insertBorderWidth < 1) {
+ /*
+ * Hack to work around the fact that a "solid" border always
+ * paints in black.
+ */
+
+ TkBorder *borderPtr = (TkBorder *) textPtr->insertBorder;
+
+ XDrawRectangle(Tk_Display(textPtr->tkwin), dst, borderPtr->bgGC,
+ x - halfWidth, y, charWidth + textPtr->insertWidth - 1,
+ height - 1);
+ } else {
+ Tk_Draw3DRectangle(textPtr->tkwin, dst, textPtr->insertBorder,
+ x - halfWidth, y, charWidth + textPtr->insertWidth,
+ height, textPtr->insertBorderWidth, TK_RELIEF_RAISED);
+ }
+ } else if (textPtr->insertUnfocussed == TK_TEXT_INSERT_NOFOCUS_SOLID) {
+ Tk_Fill3DRectangle(textPtr->tkwin, dst, textPtr->insertBorder,
+ x - halfWidth, y, charWidth + textPtr->insertWidth, height,
+ textPtr->insertBorderWidth, TK_RELIEF_RAISED);
+ }
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * InsertUndisplayProc --
+ *
+ * This function is called when the insertion cursor is no longer at a
+ * visible point on the display. It does nothing right now.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * None.
+ *
+ *--------------------------------------------------------------
+ */
+
+ /* ARGSUSED */
+static void
+InsertUndisplayProc(
+ TkText *textPtr, /* Overall information about text widget. */
+ TkTextDispChunk *chunkPtr) /* Chunk that is about to be freed. */
+{
+ return;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * MarkCheckProc --
+ *
+ * This function is invoked by the B-tree code to perform consistency
+ * checks on mark segments.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The function panics if it detects anything wrong with
+ * the mark.
+ *
+ *--------------------------------------------------------------
+ */
+
+static void
+MarkCheckProc(
+ TkTextSegment *markPtr, /* Segment to check. */
+ TkTextLine *linePtr) /* Line containing segment. */
+{
+ Tcl_HashSearch search;
+ Tcl_HashEntry *hPtr;
+
+ if (markPtr->body.mark.linePtr != linePtr) {
+ Tcl_Panic("MarkCheckProc: markPtr->body.mark.linePtr bogus");
+ }
+
+ /*
+ * These two marks are not in the hash table
+ */
+
+ if (markPtr->body.mark.textPtr->insertMarkPtr == markPtr) {
+ return;
+ }
+ if (markPtr->body.mark.textPtr->currentMarkPtr == markPtr) {
+ return;
+ }
+
+ /*
+ * Make sure that the mark is still present in the text's mark hash table.
+ */
+
+ for (hPtr = Tcl_FirstHashEntry(
+ &markPtr->body.mark.textPtr->sharedTextPtr->markTable,
+ &search); hPtr != markPtr->body.mark.hPtr;
+ hPtr = Tcl_NextHashEntry(&search)) {
+ if (hPtr == NULL) {
+ Tcl_Panic("MarkCheckProc couldn't find hash table entry for mark");
+ }
+ }
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * MarkFindNext --
+ *
+ * This function searches forward for the next mark.
+ *
+ * Results:
+ * A standard Tcl result, which is a mark name or an empty string.
+ *
+ * Side effects:
+ * None.
+ *
+ *--------------------------------------------------------------
+ */
+
+static int
+MarkFindNext(
+ Tcl_Interp *interp, /* For error reporting */
+ TkText *textPtr, /* The widget */
+ Tcl_Obj *obj) /* The starting index or mark name */
+{
+ TkTextIndex index;
+ Tcl_HashEntry *hPtr;
+ register TkTextSegment *segPtr;
+ int offset;
+ const char *string = Tcl_GetString(obj);
+
+ if (!strcmp(string, "insert")) {
+ segPtr = textPtr->insertMarkPtr;
+ TkTextMarkSegToIndex(textPtr, segPtr, &index);
+ segPtr = segPtr->nextPtr;
+ } else if (!strcmp(string, "current")) {
+ segPtr = textPtr->currentMarkPtr;
+ TkTextMarkSegToIndex(textPtr, segPtr, &index);
+ segPtr = segPtr->nextPtr;
+ } else {
+ hPtr = Tcl_FindHashEntry(&textPtr->sharedTextPtr->markTable, string);
+ if (hPtr != NULL) {
+ /*
+ * If given a mark name, return the next mark in the list of
+ * segments, even if it happens to be at the same character
+ * position.
+ */
+
+ segPtr = Tcl_GetHashValue(hPtr);
+ TkTextMarkSegToIndex(textPtr, segPtr, &index);
+ segPtr = segPtr->nextPtr;
+ } else {
+ /*
+ * For non-mark name indices we want to return any marks that are
+ * right at the index.
+ */
+
+ if (TkTextGetObjIndex(interp, textPtr, obj, &index) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ for (offset = 0, segPtr = index.linePtr->segPtr;
+ segPtr != NULL && offset < index.byteIndex;
+ offset += segPtr->size, segPtr = segPtr->nextPtr) {
+ /* Empty loop body */ ;
+ }
+ }
+ }
+
+ while (1) {
+ /*
+ * segPtr points at the first possible candidate, or NULL if we ran
+ * off the end of the line.
+ */
+
+ for ( ; segPtr != NULL ; segPtr = segPtr->nextPtr) {
+ if (segPtr->typePtr == &tkTextRightMarkType ||
+ segPtr->typePtr == &tkTextLeftMarkType) {
+ Tcl_Obj *markName = GetMarkName(textPtr, segPtr);
+
+ if (markName != NULL) {
+ Tcl_SetObjResult(interp, markName);
+ return TCL_OK;
+ }
+ }
+ }
+ index.linePtr = TkBTreeNextLine(textPtr, index.linePtr);
+ if (index.linePtr == NULL) {
+ return TCL_OK;
+ }
+ index.byteIndex = 0;
+ segPtr = index.linePtr->segPtr;
+ }
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * MarkFindPrev --
+ *
+ * This function searches backwards for the previous mark.
+ *
+ * Results:
+ * A standard Tcl result, which is a mark name or an empty string.
+ *
+ * Side effects:
+ * None.
+ *
+ *--------------------------------------------------------------
+ */
+
+static int
+MarkFindPrev(
+ Tcl_Interp *interp, /* For error reporting */
+ TkText *textPtr, /* The widget */
+ Tcl_Obj *obj) /* The starting index or mark name */
+{
+ TkTextIndex index;
+ Tcl_HashEntry *hPtr;
+ register TkTextSegment *segPtr, *seg2Ptr, *prevPtr;
+ int offset;
+ const char *string = Tcl_GetString(obj);
+
+ if (!strcmp(string, "insert")) {
+ segPtr = textPtr->insertMarkPtr;
+ TkTextMarkSegToIndex(textPtr, segPtr, &index);
+ } else if (!strcmp(string, "current")) {
+ segPtr = textPtr->currentMarkPtr;
+ TkTextMarkSegToIndex(textPtr, segPtr, &index);
+ } else {
+ hPtr = Tcl_FindHashEntry(&textPtr->sharedTextPtr->markTable, string);
+ if (hPtr != NULL) {
+ /*
+ * If given a mark name, return the previous mark in the list of
+ * segments, even if it happens to be at the same character
+ * position.
+ */
+
+ segPtr = Tcl_GetHashValue(hPtr);
+ TkTextMarkSegToIndex(textPtr, segPtr, &index);
+ } else {
+ /*
+ * For non-mark name indices we do not return any marks that are
+ * right at the index.
+ */
+
+ if (TkTextGetObjIndex(interp, textPtr, obj, &index) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ for (offset = 0, segPtr = index.linePtr->segPtr;
+ segPtr != NULL && offset < index.byteIndex;
+ offset += segPtr->size, segPtr = segPtr->nextPtr) {
+ /* Empty loop body */
+ }
+ }
+ }
+
+ while (1) {
+ /*
+ * segPtr points just past the first possible candidate, or at the
+ * beginning of the line.
+ */
+
+ for (prevPtr = NULL, seg2Ptr = index.linePtr->segPtr;
+ seg2Ptr != NULL && seg2Ptr != segPtr;
+ seg2Ptr = seg2Ptr->nextPtr) {
+ if (seg2Ptr->typePtr == &tkTextRightMarkType ||
+ seg2Ptr->typePtr == &tkTextLeftMarkType) {
+ if (seg2Ptr->body.mark.hPtr == NULL) {
+ if (seg2Ptr != textPtr->currentMarkPtr &&
+ seg2Ptr != textPtr->insertMarkPtr) {
+ /*
+ * This is an insert or current mark from a
+ * peer of textPtr.
+ */
+ continue;
+ }
+ }
+ prevPtr = seg2Ptr;
+ }
+ }
+ if (prevPtr != NULL) {
+ Tcl_Obj *markName = GetMarkName(textPtr, prevPtr);
+
+ if (markName != NULL) {
+ Tcl_SetObjResult(interp, markName);
+ return TCL_OK;
+ }
+ }
+ index.linePtr = TkBTreePreviousLine(textPtr, index.linePtr);
+ if (index.linePtr == NULL) {
+ return TCL_OK;
+ }
+ segPtr = NULL;
+ }
+}
+
+/*
+ * ------------------------------------------------------------------------
+ *
+ * GetMarkName --
+ * Returns the name of the mark that is the given text segment, or NULL
+ * if it is unnamed (i.e., a widget-specific mark that isn't "current" or
+ * "insert").
+ *
+ * ------------------------------------------------------------------------
+ */
+
+static Tcl_Obj *
+GetMarkName(
+ TkText *textPtr,
+ TkTextSegment *segPtr)
+{
+ const char *markName;
+
+ if (segPtr == textPtr->currentMarkPtr) {
+ markName = "current";
+ } else if (segPtr == textPtr->insertMarkPtr) {
+ markName = "insert";
+ } else if (segPtr->body.mark.hPtr == NULL) {
+ /*
+ * Ignore widget-specific marks for the other widgets. This is either
+ * an insert or a current mark (markPtr->body.mark.hPtr actually
+ * receives NULL for these marks in TkTextSetMark). The insert and
+ * current marks for textPtr having already been tested above, the
+ * current segment is an insert or current mark from a peer of
+ * textPtr, which we don't want to return.
+ */
+
+ return NULL;
+ } else {
+ markName = Tcl_GetHashKey(&textPtr->sharedTextPtr->markTable,
+ segPtr->body.mark.hPtr);
+ }
+ return Tcl_NewStringObj(markName, -1);
+}
+
+/*
+ * Local Variables:
+ * mode: c
+ * c-basic-offset: 4
+ * fill-column: 78
+ * End:
+ */
diff --git a/tk8.6/generic/tkTextTag.c b/tk8.6/generic/tkTextTag.c
new file mode 100644
index 0000000..a212615
--- /dev/null
+++ b/tk8.6/generic/tkTextTag.c
@@ -0,0 +1,1802 @@
+/*
+ * tkTextTag.c --
+ *
+ * This module implements the "tag" subcommand of the widget command for
+ * text widgets, plus most of the other high-level functions related to
+ * tags.
+ *
+ * Copyright (c) 1992-1994 The Regents of the University of California.
+ * Copyright (c) 1994-1997 Sun Microsystems, Inc.
+ *
+ * See the file "license.terms" for information on usage and redistribution of
+ * this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ */
+
+#include "default.h"
+#include "tkInt.h"
+#include "tkText.h"
+
+/*
+ * The 'TkWrapMode' enum in tkText.h is used to define a type for the -wrap
+ * option of tags in a Text widget. These values are used as indices into the
+ * string table below. Tags are allowed an empty wrap value, but the widget as
+ * a whole is not.
+ */
+
+static const char *const wrapStrings[] = {
+ "char", "none", "word", "", NULL
+};
+
+/*
+ * The 'TkTextTabStyle' enum in tkText.h is used to define a type for the
+ * -tabstyle option of the Text widget. These values are used as indices into
+ * the string table below. Tags are allowed an empty wrap value, but the
+ * widget as a whole is not.
+ */
+
+static const char *const tabStyleStrings[] = {
+ "tabular", "wordprocessor", "", NULL
+};
+
+static const Tk_OptionSpec tagOptionSpecs[] = {
+ {TK_OPTION_BORDER, "-background", NULL, NULL,
+ NULL, -1, Tk_Offset(TkTextTag, border), TK_OPTION_NULL_OK, 0, 0},
+ {TK_OPTION_BITMAP, "-bgstipple", NULL, NULL,
+ NULL, -1, Tk_Offset(TkTextTag, bgStipple), TK_OPTION_NULL_OK, 0, 0},
+ {TK_OPTION_PIXELS, "-borderwidth", NULL, NULL,
+ NULL, Tk_Offset(TkTextTag, borderWidthPtr), Tk_Offset(TkTextTag, borderWidth),
+ TK_OPTION_NULL_OK|TK_OPTION_DONT_SET_DEFAULT, 0, 0},
+ {TK_OPTION_STRING, "-elide", NULL, NULL,
+ NULL, -1, Tk_Offset(TkTextTag, elideString),
+ TK_OPTION_NULL_OK|TK_OPTION_DONT_SET_DEFAULT, 0, 0},
+ {TK_OPTION_BITMAP, "-fgstipple", NULL, NULL,
+ NULL, -1, Tk_Offset(TkTextTag, fgStipple), TK_OPTION_NULL_OK, 0, 0},
+ {TK_OPTION_FONT, "-font", NULL, NULL,
+ NULL, -1, Tk_Offset(TkTextTag, tkfont), TK_OPTION_NULL_OK, 0, 0},
+ {TK_OPTION_COLOR, "-foreground", NULL, NULL,
+ NULL, -1, Tk_Offset(TkTextTag, fgColor), TK_OPTION_NULL_OK, 0, 0},
+ {TK_OPTION_STRING, "-justify", NULL, NULL,
+ NULL, -1, Tk_Offset(TkTextTag, justifyString), TK_OPTION_NULL_OK, 0,0},
+ {TK_OPTION_STRING, "-lmargin1", NULL, NULL,
+ NULL, -1, Tk_Offset(TkTextTag, lMargin1String), TK_OPTION_NULL_OK,0,0},
+ {TK_OPTION_STRING, "-lmargin2", NULL, NULL,
+ NULL, -1, Tk_Offset(TkTextTag, lMargin2String), TK_OPTION_NULL_OK,0,0},
+ {TK_OPTION_BORDER, "-lmargincolor", NULL, NULL,
+ NULL, -1, Tk_Offset(TkTextTag, lMarginColor), TK_OPTION_NULL_OK, 0, 0},
+ {TK_OPTION_STRING, "-offset", NULL, NULL,
+ NULL, -1, Tk_Offset(TkTextTag, offsetString), TK_OPTION_NULL_OK, 0, 0},
+ {TK_OPTION_STRING, "-overstrike", NULL, NULL,
+ NULL, -1, Tk_Offset(TkTextTag, overstrikeString),
+ TK_OPTION_NULL_OK, 0, 0},
+ {TK_OPTION_COLOR, "-overstrikefg", NULL, NULL,
+ NULL, -1, Tk_Offset(TkTextTag, overstrikeColor),
+ TK_OPTION_NULL_OK, 0, 0},
+ {TK_OPTION_STRING, "-relief", NULL, NULL,
+ NULL, -1, Tk_Offset(TkTextTag, reliefString), TK_OPTION_NULL_OK, 0, 0},
+ {TK_OPTION_STRING, "-rmargin", NULL, NULL,
+ NULL, -1, Tk_Offset(TkTextTag, rMarginString), TK_OPTION_NULL_OK, 0,0},
+ {TK_OPTION_BORDER, "-rmargincolor", NULL, NULL,
+ NULL, -1, Tk_Offset(TkTextTag, rMarginColor), TK_OPTION_NULL_OK, 0, 0},
+ {TK_OPTION_BORDER, "-selectbackground", NULL, NULL,
+ NULL, -1, Tk_Offset(TkTextTag, selBorder), TK_OPTION_NULL_OK, 0, 0},
+ {TK_OPTION_COLOR, "-selectforeground", NULL, NULL,
+ NULL, -1, Tk_Offset(TkTextTag, selFgColor), TK_OPTION_NULL_OK, 0, 0},
+ {TK_OPTION_STRING, "-spacing1", NULL, NULL,
+ NULL, -1, Tk_Offset(TkTextTag, spacing1String), TK_OPTION_NULL_OK,0,0},
+ {TK_OPTION_STRING, "-spacing2", NULL, NULL,
+ NULL, -1, Tk_Offset(TkTextTag, spacing2String), TK_OPTION_NULL_OK,0,0},
+ {TK_OPTION_STRING, "-spacing3", NULL, NULL,
+ NULL, -1, Tk_Offset(TkTextTag, spacing3String), TK_OPTION_NULL_OK,0,0},
+ {TK_OPTION_STRING, "-tabs", NULL, NULL,
+ NULL, Tk_Offset(TkTextTag, tabStringPtr), -1, TK_OPTION_NULL_OK, 0, 0},
+ {TK_OPTION_STRING_TABLE, "-tabstyle", NULL, NULL,
+ NULL, -1, Tk_Offset(TkTextTag, tabStyle),
+ TK_OPTION_NULL_OK, tabStyleStrings, 0},
+ {TK_OPTION_STRING, "-underline", NULL, NULL,
+ NULL, -1, Tk_Offset(TkTextTag, underlineString),
+ TK_OPTION_NULL_OK, 0, 0},
+ {TK_OPTION_COLOR, "-underlinefg", NULL, NULL,
+ NULL, -1, Tk_Offset(TkTextTag, underlineColor),
+ TK_OPTION_NULL_OK, 0, 0},
+ {TK_OPTION_STRING_TABLE, "-wrap", NULL, NULL,
+ NULL, -1, Tk_Offset(TkTextTag, wrapMode),
+ TK_OPTION_NULL_OK, wrapStrings, 0},
+ {TK_OPTION_END, NULL, NULL, NULL, NULL, 0, 0, 0, 0, 0}
+};
+
+/*
+ * Forward declarations for functions defined later in this file:
+ */
+
+static void ChangeTagPriority(TkText *textPtr, TkTextTag *tagPtr,
+ int prio);
+static TkTextTag * FindTag(Tcl_Interp *interp, TkText *textPtr,
+ Tcl_Obj *tagName);
+static void SortTags(int numTags, TkTextTag **tagArrayPtr);
+static int TagSortProc(const void *first, const void *second);
+static void TagBindEvent(TkText *textPtr, XEvent *eventPtr,
+ int numTags, TkTextTag **tagArrayPtr);
+
+/*
+ *--------------------------------------------------------------
+ *
+ * TkTextTagCmd --
+ *
+ * This function is invoked to process the "tag" options of the widget
+ * command for text widgets. See the user documentation for details on
+ * what it does.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * See the user documentation.
+ *
+ *--------------------------------------------------------------
+ */
+
+int
+TkTextTagCmd(
+ register TkText *textPtr, /* Information about text widget. */
+ Tcl_Interp *interp, /* Current interpreter. */
+ int objc, /* Number of arguments. */
+ Tcl_Obj *const objv[]) /* Argument objects. Someone else has already
+ * parsed this command enough to know that
+ * objv[1] is "tag". */
+{
+ static const char *const tagOptionStrings[] = {
+ "add", "bind", "cget", "configure", "delete", "lower", "names",
+ "nextrange", "prevrange", "raise", "ranges", "remove", NULL
+ };
+ enum tagOptions {
+ TAG_ADD, TAG_BIND, TAG_CGET, TAG_CONFIGURE, TAG_DELETE, TAG_LOWER,
+ TAG_NAMES, TAG_NEXTRANGE, TAG_PREVRANGE, TAG_RAISE, TAG_RANGES,
+ TAG_REMOVE
+ };
+ int optionIndex, i;
+ register TkTextTag *tagPtr;
+ TkTextIndex index1, index2;
+
+ if (objc < 3) {
+ Tcl_WrongNumArgs(interp, 2, objv, "option ?arg ...?");
+ return TCL_ERROR;
+ }
+
+ if (Tcl_GetIndexFromObjStruct(interp, objv[2], tagOptionStrings,
+ sizeof(char *), "tag option", 0, &optionIndex) != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ switch ((enum tagOptions)optionIndex) {
+ case TAG_ADD:
+ case TAG_REMOVE: {
+ int addTag;
+
+ if (((enum tagOptions)optionIndex) == TAG_ADD) {
+ addTag = 1;
+ } else {
+ addTag = 0;
+ }
+ if (objc < 5) {
+ Tcl_WrongNumArgs(interp, 3, objv,
+ "tagName index1 ?index2 index1 index2 ...?");
+ return TCL_ERROR;
+ }
+ tagPtr = TkTextCreateTag(textPtr, Tcl_GetString(objv[3]), NULL);
+ if (tagPtr->elide) {
+ /*
+ * Indices are potentially obsolete after adding or removing
+ * elided character ranges, especially indices having "display"
+ * or "any" submodifier, therefore increase the epoch.
+ */
+ textPtr->sharedTextPtr->stateEpoch++;
+ }
+ for (i = 4; i < objc; i += 2) {
+ if (TkTextGetObjIndex(interp, textPtr, objv[i],
+ &index1) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (objc > (i+1)) {
+ if (TkTextGetObjIndex(interp, textPtr, objv[i+1],
+ &index2) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (TkTextIndexCmp(&index1, &index2) >= 0) {
+ return TCL_OK;
+ }
+ } else {
+ index2 = index1;
+ TkTextIndexForwChars(NULL,&index2, 1, &index2, COUNT_INDICES);
+ }
+
+ if (tagPtr->affectsDisplay) {
+ TkTextRedrawTag(textPtr->sharedTextPtr, NULL, &index1, &index2,
+ tagPtr, !addTag);
+ } else {
+ /*
+ * Still need to trigger enter/leave events on tags that have
+ * changed.
+ */
+
+ TkTextEventuallyRepick(textPtr);
+ }
+ if (TkBTreeTag(&index1, &index2, tagPtr, addTag)) {
+ /*
+ * If the tag is "sel", and we actually adjusted something
+ * then grab the selection if we're supposed to export it and
+ * don't already have it.
+ *
+ * Also, invalidate partially-completed selection retrievals.
+ * We only need to check whether the tag is "sel" for this
+ * textPtr (not for other peer widget's "sel" tags) because we
+ * cannot reach this code path with a different widget's "sel"
+ * tag.
+ */
+
+ if (tagPtr == textPtr->selTagPtr) {
+ /*
+ * Send an event that the selection changed. This is
+ * equivalent to:
+ * event generate $textWidget <<Selection>>
+ */
+
+ TkTextSelectionEvent(textPtr);
+
+ if (addTag && textPtr->exportSelection
+ && !(textPtr->flags & GOT_SELECTION)) {
+ Tk_OwnSelection(textPtr->tkwin, XA_PRIMARY,
+ TkTextLostSelection, textPtr);
+ textPtr->flags |= GOT_SELECTION;
+ }
+ textPtr->abortSelections = 1;
+ }
+ }
+ }
+ break;
+ }
+ case TAG_BIND:
+ if ((objc < 4) || (objc > 6)) {
+ Tcl_WrongNumArgs(interp, 3, objv, "tagName ?sequence? ?command?");
+ return TCL_ERROR;
+ }
+ tagPtr = TkTextCreateTag(textPtr, Tcl_GetString(objv[3]), NULL);
+
+ /*
+ * Make a binding table if the widget doesn't already have one.
+ */
+
+ if (textPtr->sharedTextPtr->bindingTable == NULL) {
+ textPtr->sharedTextPtr->bindingTable =
+ Tk_CreateBindingTable(interp);
+ }
+
+ if (objc == 6) {
+ int append = 0;
+ unsigned long mask;
+ const char *fifth = Tcl_GetString(objv[5]);
+
+ if (fifth[0] == 0) {
+ return Tk_DeleteBinding(interp,
+ textPtr->sharedTextPtr->bindingTable,
+ (ClientData) tagPtr->name, Tcl_GetString(objv[4]));
+ }
+ if (fifth[0] == '+') {
+ fifth++;
+ append = 1;
+ }
+ mask = Tk_CreateBinding(interp,
+ textPtr->sharedTextPtr->bindingTable,
+ (ClientData) tagPtr->name, Tcl_GetString(objv[4]), fifth,
+ append);
+ if (mask == 0) {
+ return TCL_ERROR;
+ }
+ if (mask & (unsigned) ~(ButtonMotionMask|Button1MotionMask
+ |Button2MotionMask|Button3MotionMask|Button4MotionMask
+ |Button5MotionMask|ButtonPressMask|ButtonReleaseMask
+ |EnterWindowMask|LeaveWindowMask|KeyPressMask
+ |KeyReleaseMask|PointerMotionMask|VirtualEventMask)) {
+ Tk_DeleteBinding(interp, textPtr->sharedTextPtr->bindingTable,
+ (ClientData) tagPtr->name, Tcl_GetString(objv[4]));
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "requested illegal events; only key, button, motion,"
+ " enter, leave, and virtual events may be used", -1));
+ Tcl_SetErrorCode(interp, "TK", "TEXT", "TAG_BIND_EVENT",NULL);
+ return TCL_ERROR;
+ }
+ } else if (objc == 5) {
+ const char *command;
+
+ command = Tk_GetBinding(interp,
+ textPtr->sharedTextPtr->bindingTable,
+ (ClientData) tagPtr->name, Tcl_GetString(objv[4]));
+ if (command == NULL) {
+ const char *string = Tcl_GetString(Tcl_GetObjResult(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;
+ }
+ Tcl_ResetResult(interp);
+ } else {
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(command, -1));
+ }
+ } else {
+ Tk_GetAllBindings(interp, textPtr->sharedTextPtr->bindingTable,
+ (ClientData) tagPtr->name);
+ }
+ break;
+ case TAG_CGET:
+ if (objc != 5) {
+ Tcl_WrongNumArgs(interp, 1, objv, "tag cget tagName option");
+ return TCL_ERROR;
+ } else {
+ Tcl_Obj *objPtr;
+
+ tagPtr = FindTag(interp, textPtr, objv[3]);
+ if (tagPtr == NULL) {
+ return TCL_ERROR;
+ }
+ objPtr = Tk_GetOptionValue(interp, (char *) tagPtr,
+ tagPtr->optionTable, objv[4], textPtr->tkwin);
+ if (objPtr == NULL) {
+ return TCL_ERROR;
+ }
+ Tcl_SetObjResult(interp, objPtr);
+ return TCL_OK;
+ }
+ break;
+ case TAG_CONFIGURE: {
+ int newTag;
+
+ if (objc < 4) {
+ Tcl_WrongNumArgs(interp, 3, objv,
+ "tagName ?-option? ?value? ?-option value ...?");
+ return TCL_ERROR;
+ }
+ tagPtr = TkTextCreateTag(textPtr, Tcl_GetString(objv[3]), &newTag);
+ if (objc <= 5) {
+ Tcl_Obj *objPtr = Tk_GetOptionInfo(interp, (char *) tagPtr,
+ tagPtr->optionTable,
+ (objc == 5) ? objv[4] : NULL, textPtr->tkwin);
+
+ if (objPtr == NULL) {
+ return TCL_ERROR;
+ }
+ Tcl_SetObjResult(interp, objPtr);
+ return TCL_OK;
+ } else {
+ int result = TCL_OK;
+
+ if (Tk_SetOptions(interp, (char *) tagPtr, tagPtr->optionTable,
+ objc-4, objv+4, textPtr->tkwin, NULL, NULL) != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ /*
+ * Some of the configuration options, like -underline and
+ * -justify, require additional translation (this is needed
+ * because we need to distinguish a particular value of an option
+ * from "unspecified").
+ */
+
+ if (tagPtr->borderWidth < 0) {
+ tagPtr->borderWidth = 0;
+ }
+ if (tagPtr->reliefString != NULL) {
+ if (Tk_GetRelief(interp, tagPtr->reliefString,
+ &tagPtr->relief) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ }
+ if (tagPtr->justifyString != NULL) {
+ if (Tk_GetJustify(interp, tagPtr->justifyString,
+ &tagPtr->justify) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ }
+ if (tagPtr->lMargin1String != NULL) {
+ if (Tk_GetPixels(interp, textPtr->tkwin,
+ tagPtr->lMargin1String, &tagPtr->lMargin1) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ }
+ if (tagPtr->lMargin2String != NULL) {
+ if (Tk_GetPixels(interp, textPtr->tkwin,
+ tagPtr->lMargin2String, &tagPtr->lMargin2) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ }
+ if (tagPtr->offsetString != NULL) {
+ if (Tk_GetPixels(interp, textPtr->tkwin, tagPtr->offsetString,
+ &tagPtr->offset) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ }
+ if (tagPtr->overstrikeString != NULL) {
+ if (Tcl_GetBoolean(interp, tagPtr->overstrikeString,
+ &tagPtr->overstrike) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ }
+ if (tagPtr->rMarginString != NULL) {
+ if (Tk_GetPixels(interp, textPtr->tkwin,
+ tagPtr->rMarginString, &tagPtr->rMargin) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ }
+ if (tagPtr->spacing1String != NULL) {
+ if (Tk_GetPixels(interp, textPtr->tkwin,
+ tagPtr->spacing1String, &tagPtr->spacing1) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (tagPtr->spacing1 < 0) {
+ tagPtr->spacing1 = 0;
+ }
+ }
+ if (tagPtr->spacing2String != NULL) {
+ if (Tk_GetPixels(interp, textPtr->tkwin,
+ tagPtr->spacing2String, &tagPtr->spacing2) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (tagPtr->spacing2 < 0) {
+ tagPtr->spacing2 = 0;
+ }
+ }
+ if (tagPtr->spacing3String != NULL) {
+ if (Tk_GetPixels(interp, textPtr->tkwin,
+ tagPtr->spacing3String, &tagPtr->spacing3) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (tagPtr->spacing3 < 0) {
+ tagPtr->spacing3 = 0;
+ }
+ }
+ if (tagPtr->tabArrayPtr != NULL) {
+ ckfree(tagPtr->tabArrayPtr);
+ tagPtr->tabArrayPtr = NULL;
+ }
+ if (tagPtr->tabStringPtr != NULL) {
+ tagPtr->tabArrayPtr =
+ TkTextGetTabs(interp, textPtr, tagPtr->tabStringPtr);
+ if (tagPtr->tabArrayPtr == NULL) {
+ return TCL_ERROR;
+ }
+ }
+ if (tagPtr->underlineString != NULL) {
+ if (Tcl_GetBoolean(interp, tagPtr->underlineString,
+ &tagPtr->underline) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ }
+ if (tagPtr->elideString != NULL) {
+ if (Tcl_GetBoolean(interp, tagPtr->elideString,
+ &tagPtr->elide) != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ /*
+ * Indices are potentially obsolete after changing -elide,
+ * especially those computed with "display" or "any"
+ * submodifier, therefore increase the epoch.
+ */
+
+ textPtr->sharedTextPtr->stateEpoch++;
+ }
+
+ /*
+ * If the "sel" tag was changed, be sure to mirror information
+ * from the tag back into the text widget record. NOTE: we don't
+ * have to free up information in the widget record before
+ * overwriting it, because it was mirrored in the tag and hence
+ * freed when the tag field was overwritten.
+ */
+
+ if (tagPtr == textPtr->selTagPtr) {
+ if (tagPtr->selBorder == NULL) {
+ textPtr->selBorder = tagPtr->border;
+ } else {
+ textPtr->selBorder = tagPtr->selBorder;
+ }
+ textPtr->selBorderWidth = tagPtr->borderWidth;
+ textPtr->selBorderWidthPtr = tagPtr->borderWidthPtr;
+ if (tagPtr->selFgColor == NULL) {
+ textPtr->selFgColorPtr = tagPtr->fgColor;
+ } else {
+ textPtr->selFgColorPtr = tagPtr->selFgColor;
+ }
+ }
+
+ tagPtr->affectsDisplay = 0;
+ tagPtr->affectsDisplayGeometry = 0;
+ if ((tagPtr->elideString != NULL)
+ || (tagPtr->tkfont != None)
+ || (tagPtr->justifyString != NULL)
+ || (tagPtr->lMargin1String != NULL)
+ || (tagPtr->lMargin2String != NULL)
+ || (tagPtr->offsetString != NULL)
+ || (tagPtr->rMarginString != NULL)
+ || (tagPtr->spacing1String != NULL)
+ || (tagPtr->spacing2String != NULL)
+ || (tagPtr->spacing3String != NULL)
+ || (tagPtr->tabStringPtr != NULL)
+ || (tagPtr->tabStyle != TK_TEXT_TABSTYLE_NONE)
+ || (tagPtr->wrapMode != TEXT_WRAPMODE_NULL)) {
+ tagPtr->affectsDisplay = 1;
+ tagPtr->affectsDisplayGeometry = 1;
+ }
+ if ((tagPtr->border != NULL)
+ || (tagPtr->selBorder != NULL)
+ || (tagPtr->reliefString != NULL)
+ || (tagPtr->bgStipple != None)
+ || (tagPtr->fgColor != NULL)
+ || (tagPtr->selFgColor != NULL)
+ || (tagPtr->fgStipple != None)
+ || (tagPtr->overstrikeString != NULL)
+ || (tagPtr->overstrikeColor != NULL)
+ || (tagPtr->underlineString != NULL)
+ || (tagPtr->underlineColor != NULL)
+ || (tagPtr->lMarginColor != NULL)
+ || (tagPtr->rMarginColor != NULL)) {
+ tagPtr->affectsDisplay = 1;
+ }
+ if (!newTag) {
+ /*
+ * This line is not necessary if this is a new tag, since it
+ * can't possibly have been applied to anything yet.
+ */
+
+ /*
+ * VMD: If this is the 'sel' tag, then we don't need to call
+ * this for all peers, unless we actually want to synchronize
+ * sel-style changes across the peers.
+ */
+
+ TkTextRedrawTag(textPtr->sharedTextPtr, NULL,
+ NULL, NULL, tagPtr, 1);
+ }
+ return result;
+ }
+ break;
+ }
+ case TAG_DELETE: {
+ Tcl_HashEntry *hPtr;
+
+ if (objc < 4) {
+ Tcl_WrongNumArgs(interp, 3, objv, "tagName ?tagName ...?");
+ return TCL_ERROR;
+ }
+ for (i = 3; i < objc; i++) {
+ hPtr = Tcl_FindHashEntry(&textPtr->sharedTextPtr->tagTable,
+ Tcl_GetString(objv[i]));
+ if (hPtr == NULL) {
+ /*
+ * Either this tag doesn't exist or it's the 'sel' tag (which
+ * is not in the hash table). Either way we don't want to
+ * delete it.
+ */
+
+ continue;
+ }
+ tagPtr = Tcl_GetHashValue(hPtr);
+ if (tagPtr == textPtr->selTagPtr) {
+ continue;
+ }
+ if (tagPtr->affectsDisplay) {
+ TkTextRedrawTag(textPtr->sharedTextPtr, NULL,
+ NULL, NULL, tagPtr, 1);
+ }
+ TkTextDeleteTag(textPtr, tagPtr);
+ Tcl_DeleteHashEntry(hPtr);
+ }
+ break;
+ }
+ case TAG_LOWER: {
+ TkTextTag *tagPtr2;
+ int prio;
+
+ if ((objc != 4) && (objc != 5)) {
+ Tcl_WrongNumArgs(interp, 3, objv, "tagName ?belowThis?");
+ return TCL_ERROR;
+ }
+ tagPtr = FindTag(interp, textPtr, objv[3]);
+ if (tagPtr == NULL) {
+ return TCL_ERROR;
+ }
+ if (objc == 5) {
+ tagPtr2 = FindTag(interp, textPtr, objv[4]);
+ if (tagPtr2 == NULL) {
+ return TCL_ERROR;
+ }
+ if (tagPtr->priority < tagPtr2->priority) {
+ prio = tagPtr2->priority - 1;
+ } else {
+ prio = tagPtr2->priority;
+ }
+ } else {
+ prio = 0;
+ }
+ ChangeTagPriority(textPtr, tagPtr, prio);
+
+ /*
+ * If this is the 'sel' tag, then we don't actually need to call this
+ * for all peers.
+ */
+
+ TkTextRedrawTag(textPtr->sharedTextPtr, NULL, NULL, NULL, tagPtr, 1);
+ break;
+ }
+ case TAG_NAMES: {
+ TkTextTag **arrayPtr;
+ int arraySize;
+ Tcl_Obj *listObj;
+
+ if ((objc != 3) && (objc != 4)) {
+ Tcl_WrongNumArgs(interp, 3, objv, "?index?");
+ return TCL_ERROR;
+ }
+ if (objc == 3) {
+ Tcl_HashSearch search;
+ Tcl_HashEntry *hPtr;
+
+ arrayPtr = ckalloc(textPtr->sharedTextPtr->numTags
+ * sizeof(TkTextTag *));
+ for (i=0, hPtr = Tcl_FirstHashEntry(
+ &textPtr->sharedTextPtr->tagTable, &search);
+ hPtr != NULL; i++, hPtr = Tcl_NextHashEntry(&search)) {
+ arrayPtr[i] = Tcl_GetHashValue(hPtr);
+ }
+
+ /*
+ * The 'sel' tag is not in the hash table.
+ */
+
+ arrayPtr[i] = textPtr->selTagPtr;
+ arraySize = ++i;
+ } else {
+ if (TkTextGetObjIndex(interp, textPtr, objv[3],
+ &index1) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ arrayPtr = TkBTreeGetTags(&index1, textPtr, &arraySize);
+ if (arrayPtr == NULL) {
+ return TCL_OK;
+ }
+ }
+
+ SortTags(arraySize, arrayPtr);
+ listObj = Tcl_NewListObj(0, NULL);
+
+ for (i = 0; i < arraySize; i++) {
+ tagPtr = arrayPtr[i];
+ Tcl_ListObjAppendElement(interp, listObj,
+ Tcl_NewStringObj(tagPtr->name,-1));
+ }
+ Tcl_SetObjResult(interp, listObj);
+ ckfree(arrayPtr);
+ break;
+ }
+ case TAG_NEXTRANGE: {
+ TkTextIndex last;
+ TkTextSearch tSearch;
+ char position[TK_POS_CHARS];
+ Tcl_Obj *resultObj;
+
+ if ((objc != 5) && (objc != 6)) {
+ Tcl_WrongNumArgs(interp, 3, objv, "tagName index1 ?index2?");
+ return TCL_ERROR;
+ }
+ tagPtr = FindTag(NULL, textPtr, objv[3]);
+ if (tagPtr == NULL) {
+ return TCL_OK;
+ }
+ if (TkTextGetObjIndex(interp, textPtr, objv[4], &index1) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ TkTextMakeByteIndex(textPtr->sharedTextPtr->tree, textPtr,
+ TkBTreeNumLines(textPtr->sharedTextPtr->tree, textPtr),
+ 0, &last);
+ if (objc == 5) {
+ index2 = last;
+ } else if (TkTextGetObjIndex(interp, textPtr, objv[5],
+ &index2) != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ /*
+ * The search below is a bit tricky. Rather than use the B-tree
+ * facilities to stop the search at index2, let it search up until the
+ * end of the file but check for a position past index2 ourselves.
+ * The reason for doing it this way is that we only care whether the
+ * *start* of the range is before index2; once we find the start, we
+ * don't want TkBTreeNextTag to abort the search because the end of
+ * the range is after index2.
+ */
+
+ TkBTreeStartSearch(&index1, &last, tagPtr, &tSearch);
+ if (TkBTreeCharTagged(&index1, tagPtr)) {
+ TkTextSegment *segPtr;
+ int offset;
+
+ /*
+ * The first character is tagged. See if there is an on-toggle
+ * just before the character. If not, then skip to the end of this
+ * tagged range.
+ */
+
+ for (segPtr = index1.linePtr->segPtr, offset = index1.byteIndex;
+ offset >= 0;
+ offset -= segPtr->size, segPtr = segPtr->nextPtr) {
+ if ((offset == 0) && (segPtr->typePtr == &tkTextToggleOnType)
+ && (segPtr->body.toggle.tagPtr == tagPtr)) {
+ goto gotStart;
+ }
+ }
+ if (!TkBTreeNextTag(&tSearch)) {
+ return TCL_OK;
+ }
+ }
+
+ /*
+ * Find the start of the tagged range.
+ */
+
+ if (!TkBTreeNextTag(&tSearch)) {
+ return TCL_OK;
+ }
+
+ gotStart:
+ if (TkTextIndexCmp(&tSearch.curIndex, &index2) >= 0) {
+ return TCL_OK;
+ }
+ resultObj = Tcl_NewObj();
+ TkTextPrintIndex(textPtr, &tSearch.curIndex, position);
+ Tcl_ListObjAppendElement(NULL, resultObj,
+ Tcl_NewStringObj(position, -1));
+ TkBTreeNextTag(&tSearch);
+ TkTextPrintIndex(textPtr, &tSearch.curIndex, position);
+ Tcl_ListObjAppendElement(NULL, resultObj,
+ Tcl_NewStringObj(position, -1));
+ Tcl_SetObjResult(interp, resultObj);
+ break;
+ }
+ case TAG_PREVRANGE: {
+ TkTextIndex last;
+ TkTextSearch tSearch;
+ char position1[TK_POS_CHARS];
+ char position2[TK_POS_CHARS];
+ Tcl_Obj *resultObj;
+
+ if ((objc != 5) && (objc != 6)) {
+ Tcl_WrongNumArgs(interp, 3, objv, "tagName index1 ?index2?");
+ return TCL_ERROR;
+ }
+ tagPtr = FindTag(NULL, textPtr, objv[3]);
+ if (tagPtr == NULL) {
+ return TCL_OK;
+ }
+ if (TkTextGetObjIndex(interp, textPtr, objv[4], &index1) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (objc == 5) {
+ TkTextMakeByteIndex(textPtr->sharedTextPtr->tree, textPtr, 0, 0,
+ &index2);
+ } else if (TkTextGetObjIndex(interp, textPtr, objv[5],
+ &index2) != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ /*
+ * The search below is a bit weird. The previous toggle can be either
+ * an on or off toggle. If it is an on toggle, then we need to turn
+ * around and search forward for the end toggle. Otherwise we keep
+ * searching backwards.
+ */
+
+ TkBTreeStartSearchBack(&index1, &index2, tagPtr, &tSearch);
+
+ if (!TkBTreePrevTag(&tSearch)) {
+ /*
+ * Special case, there may be a tag off toggle at index1, and a
+ * tag on toggle before the start of a partial peer widget. In
+ * this case we missed it.
+ */
+
+ if (textPtr->start != NULL && (textPtr->start == index2.linePtr)
+ && (index2.byteIndex == 0)
+ && TkBTreeCharTagged(&index2, tagPtr)
+ && (TkTextIndexCmp(&index2, &index1) < 0)) {
+ /*
+ * The first character is tagged, so just add the range from
+ * the first char to the start of the range.
+ */
+
+ TkTextPrintIndex(textPtr, &index2, position1);
+ TkTextPrintIndex(textPtr, &index1, position2);
+ goto gotPrevIndexPair;
+ }
+ return TCL_OK;
+ }
+
+ if (tSearch.segPtr->typePtr == &tkTextToggleOnType) {
+ TkTextPrintIndex(textPtr, &tSearch.curIndex, position1);
+ if (textPtr->start != NULL) {
+ /*
+ * Make sure the first index is not before the first allowed
+ * text index in this widget.
+ */
+
+ TkTextIndex firstIndex;
+
+ firstIndex.linePtr = textPtr->start;
+ firstIndex.byteIndex = 0;
+ firstIndex.textPtr = NULL;
+ if (TkTextIndexCmp(&tSearch.curIndex, &firstIndex) < 0) {
+ if (TkTextIndexCmp(&firstIndex, &index1) >= 0) {
+ /*
+ * But now the new first index is actually too far
+ * along in the text, so nothing is returned.
+ */
+
+ return TCL_OK;
+ }
+ TkTextPrintIndex(textPtr, &firstIndex, position1);
+ }
+ }
+ TkTextMakeByteIndex(textPtr->sharedTextPtr->tree, textPtr,
+ TkBTreeNumLines(textPtr->sharedTextPtr->tree, textPtr),
+ 0, &last);
+ TkBTreeStartSearch(&tSearch.curIndex, &last, tagPtr, &tSearch);
+ TkBTreeNextTag(&tSearch);
+ TkTextPrintIndex(textPtr, &tSearch.curIndex, position2);
+ } else {
+ TkTextPrintIndex(textPtr, &tSearch.curIndex, position2);
+ TkBTreePrevTag(&tSearch);
+ TkTextPrintIndex(textPtr, &tSearch.curIndex, position1);
+ if (TkTextIndexCmp(&tSearch.curIndex, &index2) < 0) {
+ if (textPtr->start != NULL && index2.linePtr == textPtr->start
+ && index2.byteIndex == 0) {
+ /* It's ok */
+ TkTextPrintIndex(textPtr, &index2, position1);
+ } else {
+ return TCL_OK;
+ }
+ }
+ }
+
+ gotPrevIndexPair:
+ resultObj = Tcl_NewObj();
+ Tcl_ListObjAppendElement(NULL, resultObj,
+ Tcl_NewStringObj(position1, -1));
+ Tcl_ListObjAppendElement(NULL, resultObj,
+ Tcl_NewStringObj(position2, -1));
+ Tcl_SetObjResult(interp, resultObj);
+ break;
+ }
+ case TAG_RAISE: {
+ TkTextTag *tagPtr2;
+ int prio;
+
+ if ((objc != 4) && (objc != 5)) {
+ Tcl_WrongNumArgs(interp, 3, objv, "tagName ?aboveThis?");
+ return TCL_ERROR;
+ }
+ tagPtr = FindTag(interp, textPtr, objv[3]);
+ if (tagPtr == NULL) {
+ return TCL_ERROR;
+ }
+ if (objc == 5) {
+ tagPtr2 = FindTag(interp, textPtr, objv[4]);
+ if (tagPtr2 == NULL) {
+ return TCL_ERROR;
+ }
+ if (tagPtr->priority <= tagPtr2->priority) {
+ prio = tagPtr2->priority;
+ } else {
+ prio = tagPtr2->priority + 1;
+ }
+ } else {
+ prio = textPtr->sharedTextPtr->numTags-1;
+ }
+ ChangeTagPriority(textPtr, tagPtr, prio);
+
+ /*
+ * If this is the 'sel' tag, then we don't actually need to call this
+ * for all peers.
+ */
+
+ TkTextRedrawTag(textPtr->sharedTextPtr, NULL, NULL, NULL, tagPtr, 1);
+ break;
+ }
+ case TAG_RANGES: {
+ TkTextIndex first, last;
+ TkTextSearch tSearch;
+ Tcl_Obj *listObj = Tcl_NewListObj(0, NULL);
+ int count = 0;
+
+ if (objc != 4) {
+ Tcl_WrongNumArgs(interp, 3, objv, "tagName");
+ return TCL_ERROR;
+ }
+ tagPtr = FindTag(NULL, textPtr, objv[3]);
+ if (tagPtr == NULL) {
+ return TCL_OK;
+ }
+ TkTextMakeByteIndex(textPtr->sharedTextPtr->tree, textPtr, 0, 0,
+ &first);
+ TkTextMakeByteIndex(textPtr->sharedTextPtr->tree, textPtr,
+ TkBTreeNumLines(textPtr->sharedTextPtr->tree, textPtr),
+ 0, &last);
+ TkBTreeStartSearch(&first, &last, tagPtr, &tSearch);
+ if (TkBTreeCharTagged(&first, tagPtr)) {
+ Tcl_ListObjAppendElement(NULL, listObj,
+ TkTextNewIndexObj(textPtr, &first));
+ count++;
+ }
+ while (TkBTreeNextTag(&tSearch)) {
+ Tcl_ListObjAppendElement(NULL, listObj,
+ TkTextNewIndexObj(textPtr, &tSearch.curIndex));
+ count++;
+ }
+ if (count % 2 == 1) {
+ /*
+ * If a text widget uses '-end', it won't necessarily run to the
+ * end of the B-tree, and therefore the tag range might not be
+ * closed. In this case we add the end of the range.
+ */
+
+ Tcl_ListObjAppendElement(NULL, listObj,
+ TkTextNewIndexObj(textPtr, &last));
+ }
+ Tcl_SetObjResult(interp, listObj);
+ break;
+ }
+ }
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkTextCreateTag --
+ *
+ * Find the record describing a tag within a given text widget, creating
+ * a new record if one doesn't already exist.
+ *
+ * Results:
+ * The return value is a pointer to the TkTextTag record for tagName.
+ *
+ * Side effects:
+ * A new tag record is created if there isn't one already defined for
+ * tagName.
+ *
+ *----------------------------------------------------------------------
+ */
+
+TkTextTag *
+TkTextCreateTag(
+ TkText *textPtr, /* Widget in which tag is being used. */
+ const char *tagName, /* Name of desired tag. */
+ int *newTag) /* If non-NULL, then return 1 if new, or 0 if
+ * already exists. */
+{
+ register TkTextTag *tagPtr;
+ Tcl_HashEntry *hPtr = NULL;
+ int isNew;
+ const char *name;
+
+ if (!strcmp(tagName, "sel")) {
+ if (textPtr->selTagPtr != NULL) {
+ if (newTag != NULL) {
+ *newTag = 0;
+ }
+ return textPtr->selTagPtr;
+ }
+ if (newTag != NULL) {
+ *newTag = 1;
+ }
+ name = "sel";
+ } else {
+ hPtr = Tcl_CreateHashEntry(&textPtr->sharedTextPtr->tagTable,
+ tagName, &isNew);
+ if (newTag != NULL) {
+ *newTag = isNew;
+ }
+ if (!isNew) {
+ return Tcl_GetHashValue(hPtr);
+ }
+ name = Tcl_GetHashKey(&textPtr->sharedTextPtr->tagTable, hPtr);
+ }
+
+ /*
+ * No existing entry. Create a new one, initialize it, and add a pointer
+ * to it to the hash table entry.
+ */
+
+ tagPtr = ckalloc(sizeof(TkTextTag));
+ tagPtr->name = name;
+ tagPtr->textPtr = NULL;
+ tagPtr->toggleCount = 0;
+ tagPtr->tagRootPtr = NULL;
+ tagPtr->priority = textPtr->sharedTextPtr->numTags;
+ tagPtr->border = NULL;
+ tagPtr->borderWidth = 0;
+ tagPtr->borderWidthPtr = NULL;
+ tagPtr->reliefString = NULL;
+ tagPtr->relief = TK_RELIEF_FLAT;
+ tagPtr->bgStipple = None;
+ tagPtr->fgColor = NULL;
+ tagPtr->tkfont = NULL;
+ tagPtr->fgStipple = None;
+ tagPtr->justifyString = NULL;
+ tagPtr->justify = TK_JUSTIFY_LEFT;
+ tagPtr->lMargin1String = NULL;
+ tagPtr->lMargin1 = 0;
+ tagPtr->lMargin2String = NULL;
+ tagPtr->lMargin2 = 0;
+ tagPtr->lMarginColor = NULL;
+ tagPtr->offsetString = NULL;
+ tagPtr->offset = 0;
+ tagPtr->overstrikeString = NULL;
+ tagPtr->overstrike = 0;
+ tagPtr->overstrikeColor = NULL;
+ tagPtr->rMarginString = NULL;
+ tagPtr->rMargin = 0;
+ tagPtr->rMarginColor = NULL;
+ tagPtr->selBorder = NULL;
+ tagPtr->selFgColor = NULL;
+ tagPtr->spacing1String = NULL;
+ tagPtr->spacing1 = 0;
+ tagPtr->spacing2String = NULL;
+ tagPtr->spacing2 = 0;
+ tagPtr->spacing3String = NULL;
+ tagPtr->spacing3 = 0;
+ tagPtr->tabStringPtr = NULL;
+ tagPtr->tabArrayPtr = NULL;
+ tagPtr->tabStyle = TK_TEXT_TABSTYLE_NONE;
+ tagPtr->underlineString = NULL;
+ tagPtr->underline = 0;
+ tagPtr->underlineColor = NULL;
+ tagPtr->elideString = NULL;
+ tagPtr->elide = 0;
+ tagPtr->wrapMode = TEXT_WRAPMODE_NULL;
+ tagPtr->affectsDisplay = 0;
+ tagPtr->affectsDisplayGeometry = 0;
+ textPtr->sharedTextPtr->numTags++;
+ if (!strcmp(tagName, "sel")) {
+ tagPtr->textPtr = textPtr;
+ textPtr->refCount++;
+ } else {
+ CLANG_ASSERT(hPtr);
+ Tcl_SetHashValue(hPtr, tagPtr);
+ }
+ tagPtr->optionTable =
+ Tk_CreateOptionTable(textPtr->interp, tagOptionSpecs);
+ return tagPtr;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * FindTag --
+ *
+ * See if tag is defined for a given widget.
+ *
+ * Results:
+ * If tagName is defined in textPtr, a pointer to its TkTextTag structure
+ * is returned. Otherwise NULL is returned and an error message is
+ * recorded in the interp's result unless interp is NULL.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static TkTextTag *
+FindTag(
+ Tcl_Interp *interp, /* Interpreter to use for error message; if
+ * NULL, then don't record an error
+ * message. */
+ TkText *textPtr, /* Widget in which tag is being used. */
+ Tcl_Obj *tagName) /* Name of desired tag. */
+{
+ Tcl_HashEntry *hPtr;
+ int len;
+ const char *str;
+
+ str = Tcl_GetStringFromObj(tagName, &len);
+ if (len == 3 && !strcmp(str, "sel")) {
+ return textPtr->selTagPtr;
+ }
+ hPtr = Tcl_FindHashEntry(&textPtr->sharedTextPtr->tagTable,
+ Tcl_GetString(tagName));
+ if (hPtr != NULL) {
+ return Tcl_GetHashValue(hPtr);
+ }
+ if (interp != NULL) {
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "tag \"%s\" isn't defined in text widget",
+ Tcl_GetString(tagName)));
+ Tcl_SetErrorCode(interp, "TK", "LOOKUP", "TEXT_TAG",
+ Tcl_GetString(tagName), NULL);
+ }
+ return NULL;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkTextDeleteTag --
+ *
+ * This function is called to carry out most actions associated with the
+ * 'tag delete' sub-command. It will remove all evidence of the tag from
+ * the B-tree, and then call TkTextFreeTag to clean up the tag structure
+ * itself.
+ *
+ * The only actions this doesn't carry out it to check if the deletion of
+ * the tag requires something to be re-displayed, and to remove the tag
+ * from the tagTable (hash table) if that is necessary (i.e. if it's not
+ * the 'sel' tag). It is expected that the caller carry out both of these
+ * actions.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Memory and other resources are freed, the B-tree is manipulated.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TkTextDeleteTag(
+ TkText *textPtr, /* Info about overall widget. */
+ register TkTextTag *tagPtr) /* Tag being deleted. */
+{
+ TkTextIndex first, last;
+
+ TkTextMakeByteIndex(textPtr->sharedTextPtr->tree, textPtr, 0, 0, &first);
+ TkTextMakeByteIndex(textPtr->sharedTextPtr->tree, textPtr,
+ TkBTreeNumLines(textPtr->sharedTextPtr->tree, textPtr), 0, &last),
+ TkBTreeTag(&first, &last, tagPtr, 0);
+
+ if (tagPtr == textPtr->selTagPtr) {
+ /*
+ * Send an event that the selection changed. This is equivalent to:
+ * event generate $textWidget <<Selection>>
+ */
+
+ TkTextSelectionEvent(textPtr);
+ } else {
+ /*
+ * Since all peer widgets have an independent "sel" tag, we
+ * don't want removal of one sel tag to remove bindings which
+ * are still valid in other peer widgets.
+ */
+
+ if (textPtr->sharedTextPtr->bindingTable != NULL) {
+ Tk_DeleteAllBindings(textPtr->sharedTextPtr->bindingTable,
+ (ClientData) tagPtr->name);
+ }
+ }
+
+ /*
+ * Update the tag priorities to reflect the deletion of this tag.
+ */
+
+ ChangeTagPriority(textPtr, tagPtr, textPtr->sharedTextPtr->numTags-1);
+ textPtr->sharedTextPtr->numTags -= 1;
+ TkTextFreeTag(textPtr, tagPtr);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkTextFreeTag --
+ *
+ * This function is called when a tag is deleted to free up the memory
+ * and other resources associated with the tag.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Memory and other resources are freed.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TkTextFreeTag(
+ TkText *textPtr, /* Info about overall widget. */
+ register TkTextTag *tagPtr) /* Tag being deleted. */
+{
+ int i;
+
+ /*
+ * Let Tk do most of the hard work for us.
+ */
+
+ Tk_FreeConfigOptions((char *) tagPtr, tagPtr->optionTable,
+ textPtr->tkwin);
+
+ /*
+ * This associated information is managed by us.
+ */
+
+ if (tagPtr->tabArrayPtr != NULL) {
+ ckfree(tagPtr->tabArrayPtr);
+ }
+
+ /*
+ * Make sure this tag isn't referenced from the 'current' tag array.
+ */
+
+ for (i = 0; i < textPtr->numCurTags; i++) {
+ if (textPtr->curTagArrayPtr[i] == tagPtr) {
+ for (; i < textPtr->numCurTags-1; i++) {
+ textPtr->curTagArrayPtr[i] = textPtr->curTagArrayPtr[i+1];
+ }
+ textPtr->curTagArrayPtr[textPtr->numCurTags-1] = NULL;
+ textPtr->numCurTags--;
+ break;
+ }
+ }
+
+ /*
+ * If this tag is widget-specific (peer widgets) then clean up the
+ * refCount it holds.
+ */
+
+ if (tagPtr->textPtr != NULL) {
+ if (textPtr != tagPtr->textPtr) {
+ Tcl_Panic("Tag being deleted from wrong widget");
+ }
+ textPtr->refCount--;
+ if (textPtr->refCount == 0) {
+ ckfree(textPtr);
+ }
+ tagPtr->textPtr = NULL;
+ }
+
+ /*
+ * Finally free the tag's memory.
+ */
+
+ ckfree(tagPtr);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * SortTags --
+ *
+ * This function sorts an array of tag pointers in increasing order of
+ * priority, optimizing for the common case where the array is small.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+SortTags(
+ int numTags, /* Number of tag pointers at *tagArrayPtr. */
+ TkTextTag **tagArrayPtr) /* Pointer to array of pointers. */
+{
+ int i, j, prio;
+ register TkTextTag **tagPtrPtr;
+ TkTextTag **maxPtrPtr, *tmp;
+
+ if (numTags < 2) {
+ return;
+ }
+ if (numTags < 20) {
+ for (i = numTags-1; i > 0; i--, tagArrayPtr++) {
+ maxPtrPtr = tagPtrPtr = tagArrayPtr;
+ prio = tagPtrPtr[0]->priority;
+ for (j = i, tagPtrPtr++; j > 0; j--, tagPtrPtr++) {
+ if (tagPtrPtr[0]->priority < prio) {
+ prio = tagPtrPtr[0]->priority;
+ maxPtrPtr = tagPtrPtr;
+ }
+ }
+ tmp = *maxPtrPtr;
+ *maxPtrPtr = *tagArrayPtr;
+ *tagArrayPtr = tmp;
+ }
+ } else {
+ qsort(tagArrayPtr,(unsigned)numTags,sizeof(TkTextTag *),TagSortProc);
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TagSortProc --
+ *
+ * This function is called by qsort() when sorting an array of tags in
+ * priority order.
+ *
+ * Results:
+ * The return value is -1 if the first argument should be before the
+ * second element (i.e. it has lower priority), 0 if it's equivalent
+ * (this should never happen!), and 1 if it should be after the second
+ * element.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+TagSortProc(
+ const void *first,
+ const void *second) /* Elements to be compared. */
+{
+ TkTextTag *tagPtr1, *tagPtr2;
+
+ tagPtr1 = * (TkTextTag **) first;
+ tagPtr2 = * (TkTextTag **) second;
+ return tagPtr1->priority - tagPtr2->priority;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ChangeTagPriority --
+ *
+ * This function changes the priority of a tag by modifying its priority
+ * and the priorities of other tags that are affected by the change.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Priorities may be changed for some or all of the tags in textPtr. The
+ * tags will be arranged so that there is exactly one tag at each
+ * priority level between 0 and textPtr->sharedTextPtr->numTags-1, with
+ * tagPtr at priority "prio".
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+ChangeTagPriority(
+ TkText *textPtr, /* Information about text widget. */
+ TkTextTag *tagPtr, /* Tag whose priority is to be changed. */
+ int prio) /* New priority for tag. */
+{
+ int low, high, delta;
+ register TkTextTag *tagPtr2;
+ Tcl_HashEntry *hPtr;
+ Tcl_HashSearch search;
+
+ if (prio < 0) {
+ prio = 0;
+ }
+ if (prio >= textPtr->sharedTextPtr->numTags) {
+ prio = textPtr->sharedTextPtr->numTags-1;
+ }
+ if (prio == tagPtr->priority) {
+ return;
+ }
+ if (prio < tagPtr->priority) {
+ low = prio;
+ high = tagPtr->priority-1;
+ delta = 1;
+ } else {
+ low = tagPtr->priority+1;
+ high = prio;
+ delta = -1;
+ }
+
+ /*
+ * Adjust first the 'sel' tag, then all others from the hash table
+ */
+
+ if ((textPtr->selTagPtr->priority >= low)
+ && (textPtr->selTagPtr->priority <= high)) {
+ textPtr->selTagPtr->priority += delta;
+ }
+ for (hPtr = Tcl_FirstHashEntry(&textPtr->sharedTextPtr->tagTable, &search);
+ hPtr != NULL; hPtr = Tcl_NextHashEntry(&search)) {
+ tagPtr2 = Tcl_GetHashValue(hPtr);
+ if ((tagPtr2->priority >= low) && (tagPtr2->priority <= high)) {
+ tagPtr2->priority += delta;
+ }
+ }
+ tagPtr->priority = prio;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * TkTextBindProc --
+ *
+ * This function is invoked by the Tk dispatcher to handle events
+ * associated with bindings on items.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Depends on the command invoked as part of the binding (if there was
+ * any).
+ *
+ *--------------------------------------------------------------
+ */
+
+void
+TkTextBindProc(
+ ClientData clientData, /* Pointer to canvas structure. */
+ XEvent *eventPtr) /* Pointer to X event that just happened. */
+{
+ TkText *textPtr = clientData;
+ int repick = 0;
+
+# define AnyButtonMask \
+ (Button1Mask|Button2Mask|Button3Mask|Button4Mask|Button5Mask)
+
+ textPtr->refCount++;
+
+ /*
+ * This code simulates grabs for mouse buttons by keeping track of whether
+ * a button is pressed and refusing to pick a new current character while
+ * a button is pressed.
+ */
+
+ if (eventPtr->type == ButtonPress) {
+ textPtr->flags |= BUTTON_DOWN;
+ } else if (eventPtr->type == ButtonRelease) {
+ int mask;
+
+ switch (eventPtr->xbutton.button) {
+ case Button1:
+ mask = Button1Mask;
+ break;
+ case Button2:
+ mask = Button2Mask;
+ break;
+ case Button3:
+ mask = Button3Mask;
+ break;
+ case Button4:
+ mask = Button4Mask;
+ break;
+ case Button5:
+ mask = Button5Mask;
+ break;
+ default:
+ mask = 0;
+ break;
+ }
+ if ((eventPtr->xbutton.state & AnyButtonMask) == (unsigned) mask) {
+ textPtr->flags &= ~BUTTON_DOWN;
+ repick = 1;
+ }
+ } else if ((eventPtr->type == EnterNotify)
+ || (eventPtr->type == LeaveNotify)) {
+ if (eventPtr->xcrossing.state & AnyButtonMask) {
+ textPtr->flags |= BUTTON_DOWN;
+ } else {
+ textPtr->flags &= ~BUTTON_DOWN;
+ }
+ TkTextPickCurrent(textPtr, eventPtr);
+ goto done;
+ } else if (eventPtr->type == MotionNotify) {
+ if (eventPtr->xmotion.state & AnyButtonMask) {
+ textPtr->flags |= BUTTON_DOWN;
+ } else {
+ textPtr->flags &= ~BUTTON_DOWN;
+ }
+ TkTextPickCurrent(textPtr, eventPtr);
+ }
+ if ((textPtr->numCurTags > 0)
+ && (textPtr->sharedTextPtr->bindingTable != NULL)
+ && (textPtr->tkwin != NULL) && !(textPtr->flags & DESTROYED)) {
+ TagBindEvent(textPtr, eventPtr, textPtr->numCurTags,
+ textPtr->curTagArrayPtr);
+ }
+ if (repick) {
+ unsigned int oldState;
+
+ oldState = eventPtr->xbutton.state;
+ eventPtr->xbutton.state &= ~(Button1Mask|Button2Mask
+ |Button3Mask|Button4Mask|Button5Mask);
+ if (!(textPtr->flags & DESTROYED)) {
+ TkTextPickCurrent(textPtr, eventPtr);
+ }
+ eventPtr->xbutton.state = oldState;
+ }
+
+ done:
+ if (--textPtr->refCount == 0) {
+ ckfree(textPtr);
+ }
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * TkTextPickCurrent --
+ *
+ * Find the character containing the coordinates in an event and place
+ * the "current" mark on that character. If the "current" mark has moved
+ * then generate a fake leave event on the old current character and a
+ * fake enter event on the new current character.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The current mark for textPtr may change. If it does, then the commands
+ * associated with character entry and leave could do just about
+ * anything. For example, the text widget might be deleted. It is up to
+ * the caller to protect itself by incrementing the refCount of the text
+ * widget.
+ *
+ *--------------------------------------------------------------
+ */
+
+void
+TkTextPickCurrent(
+ register TkText *textPtr, /* Text widget in which to select current
+ * character. */
+ XEvent *eventPtr) /* Event describing location of mouse cursor.
+ * Must be EnterWindow, LeaveWindow,
+ * ButtonRelease, or MotionNotify. */
+{
+ TkTextIndex index;
+ TkTextTag **oldArrayPtr, **newArrayPtr;
+ TkTextTag **copyArrayPtr = NULL;
+ /* Initialization needed to prevent compiler
+ * warning. */
+ int numOldTags, numNewTags, i, j, size, nearby;
+ XEvent event;
+
+ /*
+ * If a button is down, then don't do anything at all; we'll be called
+ * again when all buttons are up, and we can repick then. This implements
+ * a form of mouse grabbing.
+ */
+
+ if (textPtr->flags & BUTTON_DOWN) {
+ if (((eventPtr->type == EnterNotify)
+ || (eventPtr->type == LeaveNotify))
+ && ((eventPtr->xcrossing.mode == NotifyGrab)
+ || (eventPtr->xcrossing.mode == NotifyUngrab))) {
+ /*
+ * Special case: the window is being entered or left because of a
+ * grab or ungrab. In this case, repick after all. Furthermore,
+ * clear BUTTON_DOWN to release the simulated grab.
+ */
+
+ textPtr->flags &= ~BUTTON_DOWN;
+ } else {
+ return;
+ }
+ }
+
+ /*
+ * Save information about this event in the widget in case we have to
+ * synthesize more enter and leave events later (e.g. because a character
+ * was deleted, causing a new character to be underneath the mouse
+ * cursor). Also translate MotionNotify events into EnterNotify events,
+ * since that's what gets reported to event handlers when the current
+ * character changes.
+ */
+
+ if (eventPtr != &textPtr->pickEvent) {
+ if ((eventPtr->type == MotionNotify)
+ || (eventPtr->type == ButtonRelease)) {
+ textPtr->pickEvent.xcrossing.type = EnterNotify;
+ textPtr->pickEvent.xcrossing.serial = eventPtr->xmotion.serial;
+ textPtr->pickEvent.xcrossing.send_event
+ = eventPtr->xmotion.send_event;
+ textPtr->pickEvent.xcrossing.display = eventPtr->xmotion.display;
+ textPtr->pickEvent.xcrossing.window = eventPtr->xmotion.window;
+ textPtr->pickEvent.xcrossing.root = eventPtr->xmotion.root;
+ textPtr->pickEvent.xcrossing.subwindow = None;
+ textPtr->pickEvent.xcrossing.time = eventPtr->xmotion.time;
+ textPtr->pickEvent.xcrossing.x = eventPtr->xmotion.x;
+ textPtr->pickEvent.xcrossing.y = eventPtr->xmotion.y;
+ textPtr->pickEvent.xcrossing.x_root = eventPtr->xmotion.x_root;
+ textPtr->pickEvent.xcrossing.y_root = eventPtr->xmotion.y_root;
+ textPtr->pickEvent.xcrossing.mode = NotifyNormal;
+ textPtr->pickEvent.xcrossing.detail = NotifyNonlinear;
+ textPtr->pickEvent.xcrossing.same_screen
+ = eventPtr->xmotion.same_screen;
+ textPtr->pickEvent.xcrossing.focus = False;
+ textPtr->pickEvent.xcrossing.state = eventPtr->xmotion.state;
+ } else {
+ textPtr->pickEvent = *eventPtr;
+ }
+ }
+
+ /*
+ * Find the new current character, then find and sort all of the tags
+ * associated with it.
+ */
+
+ if (textPtr->pickEvent.type != LeaveNotify) {
+ TkTextPixelIndex(textPtr, textPtr->pickEvent.xcrossing.x,
+ textPtr->pickEvent.xcrossing.y, &index, &nearby);
+ if (nearby) {
+ newArrayPtr = NULL;
+ numNewTags = 0;
+ } else {
+ newArrayPtr = TkBTreeGetTags(&index, textPtr, &numNewTags);
+ SortTags(numNewTags, newArrayPtr);
+ }
+ } else {
+ newArrayPtr = NULL;
+ numNewTags = 0;
+ }
+
+ /*
+ * Resort the tags associated with the previous marked character (the
+ * priorities might have changed), then make a copy of the new tags, and
+ * compare the old tags to the copy, nullifying any tags that are present
+ * in both groups (i.e. the tags that haven't changed).
+ */
+
+ SortTags(textPtr->numCurTags, textPtr->curTagArrayPtr);
+ if (numNewTags > 0) {
+ size = numNewTags * sizeof(TkTextTag *);
+ copyArrayPtr = ckalloc(size);
+ memcpy(copyArrayPtr, newArrayPtr, (size_t) size);
+ for (i = 0; i < textPtr->numCurTags; i++) {
+ for (j = 0; j < numNewTags; j++) {
+ if (textPtr->curTagArrayPtr[i] == copyArrayPtr[j]) {
+ textPtr->curTagArrayPtr[i] = NULL;
+ copyArrayPtr[j] = NULL;
+ break;
+ }
+ }
+ }
+ }
+
+ /*
+ * Invoke the binding system with a LeaveNotify event for all of the tags
+ * that have gone away. We have to be careful here, because it's possible
+ * that the binding could do something (like calling tkwait) that
+ * eventually modifies textPtr->curTagArrayPtr. To avoid problems in
+ * situations like this, update curTagArrayPtr to its new value before
+ * invoking any bindings, and don't use it any more here.
+ */
+
+ numOldTags = textPtr->numCurTags;
+ textPtr->numCurTags = numNewTags;
+ oldArrayPtr = textPtr->curTagArrayPtr;
+ textPtr->curTagArrayPtr = newArrayPtr;
+ if (numOldTags != 0) {
+ if ((textPtr->sharedTextPtr->bindingTable != NULL)
+ && (textPtr->tkwin != NULL)
+ && !(textPtr->flags & DESTROYED)) {
+ event = textPtr->pickEvent;
+ event.type = LeaveNotify;
+
+ /*
+ * Always use a detail of NotifyAncestor. Besides being
+ * consistent, this avoids problems where the binding code will
+ * discard NotifyInferior events.
+ */
+
+ event.xcrossing.detail = NotifyAncestor;
+ TagBindEvent(textPtr, &event, numOldTags, oldArrayPtr);
+ }
+ ckfree(oldArrayPtr);
+ }
+
+ /*
+ * Reset the "current" mark (be careful to recompute its location, since
+ * it might have changed during an event binding). Then invoke the binding
+ * system with an EnterNotify event for all of the tags that have just
+ * appeared.
+ */
+
+ TkTextPixelIndex(textPtr, textPtr->pickEvent.xcrossing.x,
+ textPtr->pickEvent.xcrossing.y, &index, &nearby);
+ TkTextSetMark(textPtr, "current", &index);
+ if (numNewTags != 0) {
+ if ((textPtr->sharedTextPtr->bindingTable != NULL)
+ && (textPtr->tkwin != NULL)
+ && !(textPtr->flags & DESTROYED) && !nearby) {
+ event = textPtr->pickEvent;
+ event.type = EnterNotify;
+ event.xcrossing.detail = NotifyAncestor;
+ TagBindEvent(textPtr, &event, numNewTags, copyArrayPtr);
+ }
+ ckfree(copyArrayPtr);
+ }
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * TagBindEvent --
+ *
+ * Trigger given events for all tags that match the relevant bindings.
+ * To handle the "sel" tag correctly in all peer widgets, we must use the
+ * name of the tags as the binding table element.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Almost anything can be triggered by tag bindings, including deletion
+ * of the text widget.
+ *
+ *--------------------------------------------------------------
+ */
+
+static void
+TagBindEvent(
+ TkText *textPtr, /* Text widget to fire bindings in. */
+ XEvent *eventPtr, /* What actually happened. */
+ int numTags, /* Number of relevant tags. */
+ TkTextTag **tagArrayPtr) /* Array of relevant tags. */
+{
+# define NUM_BIND_TAGS 10
+ const char *nameArray[NUM_BIND_TAGS];
+ const char **nameArrPtr;
+ int i;
+
+ /*
+ * Try to avoid allocation unless there are lots of tags.
+ */
+
+ if (numTags > NUM_BIND_TAGS) {
+ nameArrPtr = ckalloc(numTags * sizeof(const char *));
+ } else {
+ nameArrPtr = nameArray;
+ }
+
+ /*
+ * We use tag names as keys in the hash table. We do this instead of using
+ * the actual tagPtr objects because we want one "sel" tag binding for all
+ * peer widgets, despite the fact that each has its own tagPtr object.
+ */
+
+ for (i = 0; i < numTags; i++) {
+ TkTextTag *tagPtr = tagArrayPtr[i];
+
+ if (tagPtr != NULL) {
+ nameArrPtr[i] = tagPtr->name;
+ } else {
+ /*
+ * Tag has been deleted elsewhere, and therefore nulled out in
+ * this array. Tk_BindEvent is clever enough to cope with NULLs
+ * being thrown at it.
+ */
+
+ nameArrPtr[i] = NULL;
+ }
+ }
+ Tk_BindEvent(textPtr->sharedTextPtr->bindingTable, eventPtr,
+ textPtr->tkwin, numTags, (ClientData *) nameArrPtr);
+
+ if (numTags > NUM_BIND_TAGS) {
+ ckfree(nameArrPtr);
+ }
+}
+
+/*
+ * Local Variables:
+ * mode: c
+ * c-basic-offset: 4
+ * fill-column: 78
+ * End:
+ */
diff --git a/tk8.6/generic/tkTextWind.c b/tk8.6/generic/tkTextWind.c
new file mode 100644
index 0000000..c9fc20f
--- /dev/null
+++ b/tk8.6/generic/tkTextWind.c
@@ -0,0 +1,1409 @@
+/*
+ * tkTextWind.c --
+ *
+ * This file contains code that allows arbitrary windows to be nested
+ * inside text widgets. It also implements the "window" widget command
+ * for texts.
+ *
+ * Copyright (c) 1994 The Regents of the University of California.
+ * Copyright (c) 1994-1997 Sun Microsystems, Inc.
+ *
+ * See the file "license.terms" for information on usage and redistribution of
+ * this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ */
+
+#include "tkPort.h"
+#include "tkText.h"
+
+/*
+ * The following structure is the official type record for the embedded window
+ * geometry manager:
+ */
+
+static void EmbWinRequestProc(ClientData clientData,
+ Tk_Window tkwin);
+static void EmbWinLostSlaveProc(ClientData clientData,
+ Tk_Window tkwin);
+
+static const Tk_GeomMgr textGeomType = {
+ "text", /* name */
+ EmbWinRequestProc, /* requestProc */
+ EmbWinLostSlaveProc, /* lostSlaveProc */
+};
+
+/*
+ * Macro that determines the size of an embedded window segment:
+ */
+
+#define EW_SEG_SIZE ((unsigned) (Tk_Offset(TkTextSegment, body) \
+ + sizeof(TkTextEmbWindow)))
+
+/*
+ * Prototypes for functions defined in this file:
+ */
+
+static TkTextSegment * EmbWinCleanupProc(TkTextSegment *segPtr,
+ TkTextLine *linePtr);
+static void EmbWinCheckProc(TkTextSegment *segPtr,
+ TkTextLine *linePtr);
+static void EmbWinBboxProc(TkText *textPtr,
+ TkTextDispChunk *chunkPtr, int index, int y,
+ int lineHeight, int baseline, int *xPtr,int *yPtr,
+ int *widthPtr, int *heightPtr);
+static int EmbWinConfigure(TkText *textPtr, TkTextSegment *ewPtr,
+ int objc, Tcl_Obj *const objv[]);
+static void EmbWinDelayedUnmap(ClientData clientData);
+static int EmbWinDeleteProc(TkTextSegment *segPtr,
+ TkTextLine *linePtr, int treeGone);
+static int EmbWinLayoutProc(TkText *textPtr,
+ TkTextIndex *indexPtr, TkTextSegment *segPtr,
+ int offset, int maxX, int maxChars,int noCharsYet,
+ TkWrapMode wrapMode, TkTextDispChunk *chunkPtr);
+static void EmbWinStructureProc(ClientData clientData,
+ XEvent *eventPtr);
+static void EmbWinUndisplayProc(TkText *textPtr,
+ TkTextDispChunk *chunkPtr);
+static TkTextEmbWindowClient *EmbWinGetClient(const TkText *textPtr,
+ TkTextSegment *ewPtr);
+
+/*
+ * The following structure declares the "embedded window" segment type.
+ */
+
+const Tk_SegType tkTextEmbWindowType = {
+ "window", /* name */
+ 0, /* leftGravity */
+ NULL, /* splitProc */
+ EmbWinDeleteProc, /* deleteProc */
+ EmbWinCleanupProc, /* cleanupProc */
+ NULL, /* lineChangeProc */
+ EmbWinLayoutProc, /* layoutProc */
+ EmbWinCheckProc /* checkProc */
+};
+
+/*
+ * Definitions for alignment values:
+ */
+
+static const char *const alignStrings[] = {
+ "baseline", "bottom", "center", "top", NULL
+};
+
+typedef enum {
+ ALIGN_BASELINE, ALIGN_BOTTOM, ALIGN_CENTER, ALIGN_TOP
+} alignMode;
+
+/*
+ * Information used for parsing window configuration options:
+ */
+
+static const Tk_OptionSpec optionSpecs[] = {
+ {TK_OPTION_STRING_TABLE, "-align", NULL, NULL,
+ "center", -1, Tk_Offset(TkTextEmbWindow, align),
+ 0, alignStrings, 0},
+ {TK_OPTION_STRING, "-create", NULL, NULL,
+ NULL, -1, Tk_Offset(TkTextEmbWindow, create), TK_OPTION_NULL_OK, 0, 0},
+ {TK_OPTION_PIXELS, "-padx", NULL, NULL,
+ "0", -1, Tk_Offset(TkTextEmbWindow, padX), 0, 0, 0},
+ {TK_OPTION_PIXELS, "-pady", NULL, NULL,
+ "0", -1, Tk_Offset(TkTextEmbWindow, padY), 0, 0, 0},
+ {TK_OPTION_BOOLEAN, "-stretch", NULL, NULL,
+ "0", -1, Tk_Offset(TkTextEmbWindow, stretch), 0, 0, 0},
+ {TK_OPTION_WINDOW, "-window", NULL, NULL,
+ NULL, -1, Tk_Offset(TkTextEmbWindow, tkwin), TK_OPTION_NULL_OK, 0, 0},
+ {TK_OPTION_END, NULL, NULL, NULL, NULL, 0, 0, 0, 0, 0}
+};
+
+/*
+ *--------------------------------------------------------------
+ *
+ * TkTextWindowCmd --
+ *
+ * This function implements the "window" widget command for text widgets.
+ * See the user documentation for details on what it does.
+ *
+ * Results:
+ * A standard Tcl result or error.
+ *
+ * Side effects:
+ * See the user documentation.
+ *
+ *--------------------------------------------------------------
+ */
+
+int
+TkTextWindowCmd(
+ register TkText *textPtr, /* Information about text widget. */
+ Tcl_Interp *interp, /* Current interpreter. */
+ int objc, /* Number of arguments. */
+ Tcl_Obj *const objv[]) /* Argument objects. Someone else has already
+ * parsed this command enough to know that
+ * objv[1] is "window". */
+{
+ int optionIndex;
+ static const char *const windOptionStrings[] = {
+ "cget", "configure", "create", "names", NULL
+ };
+ enum windOptions {
+ WIND_CGET, WIND_CONFIGURE, WIND_CREATE, WIND_NAMES
+ };
+ register TkTextSegment *ewPtr;
+
+ if (objc < 3) {
+ Tcl_WrongNumArgs(interp, 2, objv, "option ?arg ...?");
+ return TCL_ERROR;
+ }
+ if (Tcl_GetIndexFromObjStruct(interp, objv[2], windOptionStrings,
+ sizeof(char *), "window option", 0, &optionIndex) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ switch ((enum windOptions) optionIndex) {
+ case WIND_CGET: {
+ TkTextIndex index;
+ TkTextSegment *ewPtr;
+ Tcl_Obj *objPtr;
+ TkTextEmbWindowClient *client;
+
+ if (objc != 5) {
+ Tcl_WrongNumArgs(interp, 3, objv, "index option");
+ return TCL_ERROR;
+ }
+ if (TkTextGetObjIndex(interp, textPtr, objv[3], &index) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ ewPtr = TkTextIndexToSeg(&index, NULL);
+ if (ewPtr->typePtr != &tkTextEmbWindowType) {
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "no embedded window at index \"%s\"",
+ Tcl_GetString(objv[3])));
+ Tcl_SetErrorCode(interp, "TK", "TEXT", "NO_WINDOW", NULL);
+ return TCL_ERROR;
+ }
+
+ /*
+ * Copy over client specific value before querying.
+ */
+
+ client = EmbWinGetClient(textPtr, ewPtr);
+ if (client != NULL) {
+ ewPtr->body.ew.tkwin = client->tkwin;
+ } else {
+ ewPtr->body.ew.tkwin = NULL;
+ }
+
+ objPtr = Tk_GetOptionValue(interp, (char *) &ewPtr->body.ew,
+ ewPtr->body.ew.optionTable, objv[4], textPtr->tkwin);
+ if (objPtr == NULL) {
+ return TCL_ERROR;
+ }
+ Tcl_SetObjResult(interp, objPtr);
+ return TCL_OK;
+ }
+ case WIND_CONFIGURE: {
+ TkTextIndex index;
+ TkTextSegment *ewPtr;
+
+ if (objc < 4) {
+ Tcl_WrongNumArgs(interp, 3, objv, "index ?-option value ...?");
+ return TCL_ERROR;
+ }
+ if (TkTextGetObjIndex(interp, textPtr, objv[3], &index) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ ewPtr = TkTextIndexToSeg(&index, NULL);
+ if (ewPtr->typePtr != &tkTextEmbWindowType) {
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "no embedded window at index \"%s\"",
+ Tcl_GetString(objv[3])));
+ Tcl_SetErrorCode(interp, "TK", "TEXT", "NO_WINDOW", NULL);
+ return TCL_ERROR;
+ }
+ if (objc <= 5) {
+ TkTextEmbWindowClient *client;
+ Tcl_Obj *objPtr;
+
+ /*
+ * Copy over client specific value before querying.
+ */
+
+ client = EmbWinGetClient(textPtr, ewPtr);
+ if (client != NULL) {
+ ewPtr->body.ew.tkwin = client->tkwin;
+ } else {
+ ewPtr->body.ew.tkwin = NULL;
+ }
+
+ objPtr = Tk_GetOptionInfo(interp, (char *) &ewPtr->body.ew,
+ ewPtr->body.ew.optionTable, (objc == 5) ? objv[4] : NULL,
+ textPtr->tkwin);
+ if (objPtr == NULL) {
+ return TCL_ERROR;
+ }
+ Tcl_SetObjResult(interp, objPtr);
+ return TCL_OK;
+ } else {
+ TkTextChanged(textPtr->sharedTextPtr, NULL, &index, &index);
+
+ /*
+ * It's probably not true that all window configuration can change
+ * the line height, so we could be more efficient here and only
+ * call this when necessary.
+ */
+
+ TkTextInvalidateLineMetrics(textPtr->sharedTextPtr, NULL,
+ index.linePtr, 0, TK_TEXT_INVALIDATE_ONLY);
+ return EmbWinConfigure(textPtr, ewPtr, objc-4, objv+4);
+ }
+ }
+ case WIND_CREATE: {
+ TkTextIndex index;
+ int lineIndex;
+ TkTextEmbWindowClient *client;
+ int res;
+
+ /*
+ * Add a new window. Find where to put the new window, and mark that
+ * position for redisplay.
+ */
+
+ if (objc < 4) {
+ Tcl_WrongNumArgs(interp, 3, objv, "index ?-option value ...?");
+ return TCL_ERROR;
+ }
+ if (TkTextGetObjIndex(interp, textPtr, objv[3], &index) != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ /*
+ * Don't allow insertions on the last (dummy) line of the text.
+ */
+
+ lineIndex = TkBTreeLinesTo(textPtr, index.linePtr);
+ if (lineIndex == TkBTreeNumLines(textPtr->sharedTextPtr->tree,
+ textPtr)) {
+ lineIndex--;
+ TkTextMakeByteIndex(textPtr->sharedTextPtr->tree, textPtr,
+ lineIndex, 1000000, &index);
+ }
+
+ /*
+ * Create the new window segment and initialize it.
+ */
+
+ ewPtr = ckalloc(EW_SEG_SIZE);
+ ewPtr->typePtr = &tkTextEmbWindowType;
+ ewPtr->size = 1;
+ ewPtr->body.ew.sharedTextPtr = textPtr->sharedTextPtr;
+ ewPtr->body.ew.linePtr = NULL;
+ ewPtr->body.ew.tkwin = NULL;
+ ewPtr->body.ew.create = NULL;
+ ewPtr->body.ew.align = ALIGN_CENTER;
+ ewPtr->body.ew.padX = ewPtr->body.ew.padY = 0;
+ ewPtr->body.ew.stretch = 0;
+ ewPtr->body.ew.optionTable = Tk_CreateOptionTable(interp, optionSpecs);
+
+ client = ckalloc(sizeof(TkTextEmbWindowClient));
+ client->next = NULL;
+ client->textPtr = textPtr;
+ client->tkwin = NULL;
+ client->chunkCount = 0;
+ client->displayed = 0;
+ client->parent = ewPtr;
+ ewPtr->body.ew.clients = client;
+
+ /*
+ * Link the segment into the text widget, then configure it (delete it
+ * again if the configuration fails).
+ */
+
+ TkTextChanged(textPtr->sharedTextPtr, NULL, &index, &index);
+ TkBTreeLinkSegment(ewPtr, &index);
+ res = EmbWinConfigure(textPtr, ewPtr, objc-4, objv+4);
+ client->tkwin = ewPtr->body.ew.tkwin;
+ if (res != TCL_OK) {
+ TkTextIndex index2;
+
+ TkTextIndexForwChars(NULL, &index, 1, &index2, COUNT_INDICES);
+ TkBTreeDeleteIndexRange(textPtr->sharedTextPtr->tree, &index,
+ &index2);
+ return TCL_ERROR;
+ }
+ TkTextInvalidateLineMetrics(textPtr->sharedTextPtr, NULL,
+ index.linePtr, 0, TK_TEXT_INVALIDATE_ONLY);
+ break;
+ }
+ case WIND_NAMES: {
+ Tcl_HashSearch search;
+ Tcl_HashEntry *hPtr;
+ Tcl_Obj *resultObj;
+
+ if (objc != 3) {
+ Tcl_WrongNumArgs(interp, 3, objv, NULL);
+ return TCL_ERROR;
+ }
+ resultObj = Tcl_NewObj();
+ for (hPtr = Tcl_FirstHashEntry(&textPtr->sharedTextPtr->windowTable,
+ &search); hPtr != NULL; hPtr = Tcl_NextHashEntry(&search)) {
+ Tcl_ListObjAppendElement(NULL, resultObj, Tcl_NewStringObj(
+ Tcl_GetHashKey(&textPtr->sharedTextPtr->markTable, hPtr),
+ -1));
+ }
+ Tcl_SetObjResult(interp, resultObj);
+ break;
+ }
+ }
+ return TCL_OK;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * EmbWinConfigure --
+ *
+ * This function is called to handle configuration options for an
+ * embedded window, using an objc/objv list.
+ *
+ * Results:
+ * The return value is a standard Tcl result. If TCL_ERROR is returned,
+ * then the interp's result contains an error message..
+ *
+ * Side effects:
+ * Configuration information for the embedded window changes, such as
+ * alignment, stretching, or name of the embedded window.
+ *
+ * Note that this function may leave widget specific client information
+ * with a NULL tkwin attached to ewPtr. While we could choose to clean up
+ * the client data structure here, there is no need to do so, and it is
+ * likely that the user is going to adjust the tkwin again soon.
+ *
+ *--------------------------------------------------------------
+ */
+
+static int
+EmbWinConfigure(
+ TkText *textPtr, /* Information about text widget that contains
+ * embedded window. */
+ TkTextSegment *ewPtr, /* Embedded window to be configured. */
+ int objc, /* Number of strings in objv. */
+ Tcl_Obj *const objv[]) /* Array of objects describing configuration
+ * options. */
+{
+ Tk_Window oldWindow;
+ TkTextEmbWindowClient *client;
+
+ /*
+ * Copy over client specific value before querying or setting.
+ */
+
+ client = EmbWinGetClient(textPtr, ewPtr);
+ if (client != NULL) {
+ ewPtr->body.ew.tkwin = client->tkwin;
+ } else {
+ ewPtr->body.ew.tkwin = NULL;
+ }
+
+ oldWindow = ewPtr->body.ew.tkwin;
+ if (Tk_SetOptions(textPtr->interp, (char *) &ewPtr->body.ew,
+ ewPtr->body.ew.optionTable, objc, objv, textPtr->tkwin, NULL,
+ NULL) != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ if (oldWindow != ewPtr->body.ew.tkwin) {
+ if (oldWindow != NULL) {
+ Tcl_DeleteHashEntry(Tcl_FindHashEntry(
+ &textPtr->sharedTextPtr->windowTable,
+ Tk_PathName(oldWindow)));
+ Tk_DeleteEventHandler(oldWindow, StructureNotifyMask,
+ EmbWinStructureProc, client);
+ Tk_ManageGeometry(oldWindow, NULL, NULL);
+ if (textPtr->tkwin != Tk_Parent(oldWindow)) {
+ Tk_UnmaintainGeometry(oldWindow, textPtr->tkwin);
+ } else {
+ Tk_UnmapWindow(oldWindow);
+ }
+ }
+ if (client != NULL) {
+ client->tkwin = NULL;
+ }
+ if (ewPtr->body.ew.tkwin != NULL) {
+ Tk_Window ancestor, parent;
+ Tcl_HashEntry *hPtr;
+ int isNew;
+
+ /*
+ * Make sure that the text is either the parent of the embedded
+ * window or a descendant of that parent. Also, don't allow a
+ * top-level window to be managed inside a text.
+ */
+
+ parent = Tk_Parent(ewPtr->body.ew.tkwin);
+ for (ancestor = textPtr->tkwin; ; ancestor = Tk_Parent(ancestor)) {
+ if (ancestor == parent) {
+ break;
+ }
+ if (Tk_TopWinHierarchy(ancestor)) {
+ badMaster:
+ Tcl_SetObjResult(textPtr->interp, Tcl_ObjPrintf(
+ "can't embed %s in %s",
+ Tk_PathName(ewPtr->body.ew.tkwin),
+ Tk_PathName(textPtr->tkwin)));
+ Tcl_SetErrorCode(textPtr->interp, "TK", "GEOMETRY",
+ "HIERARCHY", NULL);
+ ewPtr->body.ew.tkwin = NULL;
+ if (client != NULL) {
+ client->tkwin = NULL;
+ }
+ return TCL_ERROR;
+ }
+ }
+ if (Tk_TopWinHierarchy(ewPtr->body.ew.tkwin)
+ || (ewPtr->body.ew.tkwin == textPtr->tkwin)) {
+ goto badMaster;
+ }
+
+ if (client == NULL) {
+ /*
+ * Have to make the new client.
+ */
+
+ client = ckalloc(sizeof(TkTextEmbWindowClient));
+ client->next = ewPtr->body.ew.clients;
+ client->textPtr = textPtr;
+ client->tkwin = NULL;
+ client->chunkCount = 0;
+ client->displayed = 0;
+ client->parent = ewPtr;
+ ewPtr->body.ew.clients = client;
+ }
+ client->tkwin = ewPtr->body.ew.tkwin;
+
+ /*
+ * Take over geometry management for the window, plus create an
+ * event handler to find out when it is deleted.
+ */
+
+ Tk_ManageGeometry(ewPtr->body.ew.tkwin, &textGeomType, client);
+ Tk_CreateEventHandler(ewPtr->body.ew.tkwin, StructureNotifyMask,
+ EmbWinStructureProc, client);
+
+ /*
+ * Special trick! Must enter into the hash table *after* calling
+ * Tk_ManageGeometry: if the window was already managed elsewhere
+ * in this text, the Tk_ManageGeometry call will cause the entry
+ * to be removed, which could potentially lose the new entry.
+ */
+
+ hPtr = Tcl_CreateHashEntry(&textPtr->sharedTextPtr->windowTable,
+ Tk_PathName(ewPtr->body.ew.tkwin), &isNew);
+ Tcl_SetHashValue(hPtr, ewPtr);
+ }
+ }
+ return TCL_OK;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * EmbWinStructureProc --
+ *
+ * This function is invoked by the Tk event loop whenever StructureNotify
+ * events occur for a window that's embedded in a text widget. This
+ * function's only purpose is to clean up when windows are deleted.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The window is disassociated from the window segment, and the portion
+ * of the text is redisplayed.
+ *
+ *--------------------------------------------------------------
+ */
+
+static void
+EmbWinStructureProc(
+ ClientData clientData, /* Pointer to record describing window item. */
+ XEvent *eventPtr) /* Describes what just happened. */
+{
+ TkTextEmbWindowClient *client = clientData;
+ TkTextSegment *ewPtr = client->parent;
+ TkTextIndex index;
+ Tcl_HashEntry *hPtr;
+
+ if (eventPtr->type != DestroyNotify) {
+ return;
+ }
+
+ hPtr = Tcl_FindHashEntry(&ewPtr->body.ew.sharedTextPtr->windowTable,
+ Tk_PathName(client->tkwin));
+ if (hPtr != NULL) {
+ /*
+ * This may not exist if the entire widget is being deleted.
+ */
+
+ Tcl_DeleteHashEntry(hPtr);
+ }
+
+ ewPtr->body.ew.tkwin = NULL;
+ client->tkwin = NULL;
+ index.tree = ewPtr->body.ew.sharedTextPtr->tree;
+ index.linePtr = ewPtr->body.ew.linePtr;
+ index.byteIndex = TkTextSegToOffset(ewPtr, ewPtr->body.ew.linePtr);
+ TkTextChanged(ewPtr->body.ew.sharedTextPtr, NULL, &index, &index);
+ TkTextInvalidateLineMetrics(ewPtr->body.ew.sharedTextPtr, NULL,
+ index.linePtr, 0, TK_TEXT_INVALIDATE_ONLY);
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * EmbWinRequestProc --
+ *
+ * This function is invoked whenever a window that's associated with a
+ * window canvas item changes its requested dimensions.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The size and location on the screen of the window may change,
+ * depending on the options specified for the window item.
+ *
+ *--------------------------------------------------------------
+ */
+
+ /* ARGSUSED */
+static void
+EmbWinRequestProc(
+ ClientData clientData, /* Pointer to record for window item. */
+ Tk_Window tkwin) /* Window that changed its desired size. */
+{
+ TkTextEmbWindowClient *client = clientData;
+ TkTextSegment *ewPtr = client->parent;
+ TkTextIndex index;
+
+ index.tree = ewPtr->body.ew.sharedTextPtr->tree;
+ index.linePtr = ewPtr->body.ew.linePtr;
+ index.byteIndex = TkTextSegToOffset(ewPtr, ewPtr->body.ew.linePtr);
+ TkTextChanged(ewPtr->body.ew.sharedTextPtr, NULL, &index, &index);
+ TkTextInvalidateLineMetrics(ewPtr->body.ew.sharedTextPtr, NULL,
+ index.linePtr, 0, TK_TEXT_INVALIDATE_ONLY);
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * EmbWinLostSlaveProc --
+ *
+ * This function is invoked by the Tk geometry manager when a slave
+ * window managed by a text widget is claimed away by another geometry
+ * manager.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The window is disassociated from the window segment, and the portion
+ * of the text is redisplayed.
+ *
+ *--------------------------------------------------------------
+ */
+
+static void
+EmbWinLostSlaveProc(
+ ClientData clientData, /* Pointer to record describing window item. */
+ Tk_Window tkwin) /* Window that was claimed away by another
+ * geometry manager. */
+{
+ TkTextEmbWindowClient *client = clientData;
+ TkTextSegment *ewPtr = client->parent;
+ TkTextIndex index;
+ Tcl_HashEntry *hPtr;
+ TkTextEmbWindowClient *loop;
+
+ Tk_DeleteEventHandler(client->tkwin, StructureNotifyMask,
+ EmbWinStructureProc, client);
+ Tcl_CancelIdleCall(EmbWinDelayedUnmap, client);
+ if (client->textPtr->tkwin != Tk_Parent(tkwin)) {
+ Tk_UnmaintainGeometry(tkwin, client->textPtr->tkwin);
+ } else {
+ Tk_UnmapWindow(tkwin);
+ }
+ hPtr = Tcl_FindHashEntry(&ewPtr->body.ew.sharedTextPtr->windowTable,
+ Tk_PathName(client->tkwin));
+ Tcl_DeleteHashEntry(hPtr);
+ client->tkwin = NULL;
+ ewPtr->body.ew.tkwin = NULL;
+
+ /*
+ * Free up the memory allocation for this client.
+ */
+
+ loop = ewPtr->body.ew.clients;
+ if (loop == client) {
+ ewPtr->body.ew.clients = client->next;
+ } else {
+ while (loop->next != client) {
+ loop = loop->next;
+ }
+ loop->next = client->next;
+ }
+ ckfree(client);
+
+ index.tree = ewPtr->body.ew.sharedTextPtr->tree;
+ index.linePtr = ewPtr->body.ew.linePtr;
+ index.byteIndex = TkTextSegToOffset(ewPtr, ewPtr->body.ew.linePtr);
+ TkTextChanged(ewPtr->body.ew.sharedTextPtr, NULL, &index, &index);
+ TkTextInvalidateLineMetrics(ewPtr->body.ew.sharedTextPtr, NULL,
+ index.linePtr, 0, TK_TEXT_INVALIDATE_ONLY);
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * TkTextWinFreeClient --
+ *
+ * Free up the hash entry and client information for a given embedded
+ * window.
+ *
+ * It is assumed the caller will manage the linked list of clients
+ * associated with the relevant TkTextSegment.
+ *
+ * Results:
+ * Nothing.
+ *
+ * Side effects:
+ * The embedded window information for a single client is deleted, if it
+ * exists, and any resources associated with it are released.
+ *
+ *--------------------------------------------------------------
+ */
+
+void
+TkTextWinFreeClient(
+ Tcl_HashEntry *hPtr, /* Hash entry corresponding to this client, or
+ * NULL */
+ TkTextEmbWindowClient *client)
+ /* Client data structure, with the 'tkwin'
+ * field to be cleaned up. */
+{
+ if (hPtr != NULL) {
+ /*
+ * (It's possible for there to be no hash table entry for this window,
+ * if an error occurred while creating the window segment but before
+ * the window got added to the table)
+ */
+
+ Tcl_DeleteHashEntry(hPtr);
+ }
+
+ /*
+ * Delete the event handler for the window before destroying the window,
+ * so that EmbWinStructureProc doesn't get called (we'll already do
+ * everything that it would have done, and it will just get confused).
+ */
+
+ if (client->tkwin != NULL) {
+ Tk_DeleteEventHandler(client->tkwin, StructureNotifyMask,
+ EmbWinStructureProc, client);
+ Tk_DestroyWindow(client->tkwin);
+ }
+ Tcl_CancelIdleCall(EmbWinDelayedUnmap, client);
+
+ /*
+ * Free up this client.
+ */
+
+ ckfree(client);
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * EmbWinDeleteProc --
+ *
+ * This function is invoked by the text B-tree code whenever an embedded
+ * window lies in a range of characters being deleted.
+ *
+ * Results:
+ * Returns 0 to indicate that the deletion has been accepted.
+ *
+ * Side effects:
+ * The embedded window is deleted, if it exists, and any resources
+ * associated with it are released.
+ *
+ *--------------------------------------------------------------
+ */
+
+ /* ARGSUSED */
+static int
+EmbWinDeleteProc(
+ TkTextSegment *ewPtr, /* Segment being deleted. */
+ TkTextLine *linePtr, /* Line containing segment. */
+ int treeGone) /* Non-zero means the entire tree is being
+ * deleted, so everything must get cleaned
+ * up. */
+{
+ TkTextEmbWindowClient *client;
+ client = ewPtr->body.ew.clients;
+
+ while (client != NULL) {
+ TkTextEmbWindowClient *next = client->next;
+ Tcl_HashEntry *hPtr = NULL;
+
+ if (client->tkwin != NULL) {
+ hPtr = Tcl_FindHashEntry(
+ &ewPtr->body.ew.sharedTextPtr->windowTable,
+ Tk_PathName(client->tkwin));
+ }
+ TkTextWinFreeClient(hPtr, client);
+ client = next;
+ }
+ ewPtr->body.ew.clients = NULL;
+
+ Tk_FreeConfigOptions((char *) &ewPtr->body.ew, ewPtr->body.ew.optionTable,
+ NULL);
+
+ /*
+ * Free up all memory allocated.
+ */
+
+ ckfree(ewPtr);
+ return 0;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * EmbWinCleanupProc --
+ *
+ * This function is invoked by the B-tree code whenever a segment
+ * containing an embedded window is moved from one line to another.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The linePtr field of the segment gets updated.
+ *
+ *--------------------------------------------------------------
+ */
+
+static TkTextSegment *
+EmbWinCleanupProc(
+ TkTextSegment *ewPtr, /* Mark segment that's being moved. */
+ TkTextLine *linePtr) /* Line that now contains segment. */
+{
+ ewPtr->body.ew.linePtr = linePtr;
+ return ewPtr;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * EmbWinLayoutProc --
+ *
+ * This function is the "layoutProc" for embedded window segments.
+ *
+ * Results:
+ * 1 is returned to indicate that the segment should be displayed. The
+ * chunkPtr structure is filled in.
+ *
+ * Side effects:
+ * None, except for filling in chunkPtr.
+ *
+ *--------------------------------------------------------------
+ */
+
+ /*ARGSUSED*/
+static int
+EmbWinLayoutProc(
+ TkText *textPtr, /* Text widget being layed out. */
+ TkTextIndex *indexPtr, /* Identifies first character in chunk. */
+ TkTextSegment *ewPtr, /* Segment corresponding to indexPtr. */
+ int offset, /* Offset within segPtr corresponding to
+ * indexPtr (always 0). */
+ int maxX, /* Chunk must not occupy pixels at this
+ * position or higher. */
+ int maxChars, /* Chunk must not include more than this many
+ * characters. */
+ int noCharsYet, /* Non-zero means no characters have been
+ * assigned to this line yet. */
+ TkWrapMode wrapMode, /* Wrap mode to use for line:
+ * TEXT_WRAPMODE_CHAR, TEXT_WRAPMODE_NONE, or
+ * TEXT_WRAPMODE_WORD. */
+ register TkTextDispChunk *chunkPtr)
+ /* Structure to fill in with information about
+ * this chunk. The x field has already been
+ * set by the caller. */
+{
+ int width, height;
+ TkTextEmbWindowClient *client;
+
+ if (offset != 0) {
+ Tcl_Panic("Non-zero offset in EmbWinLayoutProc");
+ }
+
+ client = EmbWinGetClient(textPtr, ewPtr);
+ if (client == NULL) {
+ ewPtr->body.ew.tkwin = NULL;
+ } else {
+ ewPtr->body.ew.tkwin = client->tkwin;
+ }
+
+ if ((ewPtr->body.ew.tkwin == NULL) && (ewPtr->body.ew.create != NULL)) {
+ int code, isNew;
+ Tk_Window ancestor;
+ Tcl_HashEntry *hPtr;
+ const char *before, *string;
+ Tcl_DString buf, *dsPtr = NULL;
+ Tcl_Obj *nameObj;
+
+ before = ewPtr->body.ew.create;
+
+ /*
+ * Find everything up to the next % character and append it to the
+ * result string.
+ */
+
+ string = before;
+ while (*string != 0) {
+ if ((*string == '%') && (string[1] == '%' || string[1] == 'W')) {
+ if (dsPtr == NULL) {
+ Tcl_DStringInit(&buf);
+ dsPtr = &buf;
+ }
+ if (string != before) {
+ Tcl_DStringAppend(dsPtr, before, (int) (string-before));
+ before = string;
+ }
+ if (string[1] == '%') {
+ Tcl_DStringAppend(dsPtr, "%", 1);
+ } else {
+ /*
+ * Substitute string as proper Tcl list element.
+ */
+
+ int spaceNeeded, cvtFlags, length;
+ const char *str = Tk_PathName(textPtr->tkwin);
+
+ spaceNeeded = Tcl_ScanElement(str, &cvtFlags);
+ length = Tcl_DStringLength(dsPtr);
+ Tcl_DStringSetLength(dsPtr, length + spaceNeeded);
+ spaceNeeded = Tcl_ConvertElement(str,
+ Tcl_DStringValue(dsPtr) + length,
+ cvtFlags | TCL_DONT_USE_BRACES);
+ Tcl_DStringSetLength(dsPtr, length + spaceNeeded);
+ }
+ before += 2;
+ string++;
+ }
+ string++;
+ }
+
+ /*
+ * The window doesn't currently exist. Create it by evaluating the
+ * creation script. The script must return the window's path name:
+ * look up that name to get back to the window token. Then register
+ * ourselves as the geometry manager for the window.
+ */
+
+ if (dsPtr != NULL) {
+ Tcl_DStringAppend(dsPtr, before, (int) (string-before));
+ code = Tcl_EvalEx(textPtr->interp, Tcl_DStringValue(dsPtr), -1, TCL_EVAL_GLOBAL);
+ Tcl_DStringFree(dsPtr);
+ } else {
+ code = Tcl_EvalEx(textPtr->interp, ewPtr->body.ew.create, -1, TCL_EVAL_GLOBAL);
+ }
+ if (code != TCL_OK) {
+ Tcl_BackgroundException(textPtr->interp, code);
+ goto gotWindow;
+ }
+ nameObj = Tcl_GetObjResult(textPtr->interp);
+ Tcl_IncrRefCount(nameObj);
+ Tcl_ResetResult(textPtr->interp);
+ ewPtr->body.ew.tkwin = Tk_NameToWindow(textPtr->interp,
+ Tcl_GetString(nameObj), textPtr->tkwin);
+ Tcl_DecrRefCount(nameObj);
+ if (ewPtr->body.ew.tkwin == NULL) {
+ Tcl_BackgroundException(textPtr->interp, TCL_ERROR);
+ goto gotWindow;
+ }
+
+ for (ancestor = textPtr->tkwin; ; ancestor = Tk_Parent(ancestor)) {
+ if (ancestor == Tk_Parent(ewPtr->body.ew.tkwin)) {
+ break;
+ }
+ if (Tk_TopWinHierarchy(ancestor)) {
+ goto badMaster;
+ }
+ }
+ if (Tk_TopWinHierarchy(ewPtr->body.ew.tkwin)
+ || (textPtr->tkwin == ewPtr->body.ew.tkwin)) {
+ badMaster:
+ Tcl_SetObjResult(textPtr->interp, Tcl_ObjPrintf(
+ "can't embed %s relative to %s",
+ Tk_PathName(ewPtr->body.ew.tkwin),
+ Tk_PathName(textPtr->tkwin)));
+ Tcl_SetErrorCode(textPtr->interp, "TK", "GEOMETRY", "HIERARCHY",
+ NULL);
+ Tcl_BackgroundException(textPtr->interp, TCL_ERROR);
+ ewPtr->body.ew.tkwin = NULL;
+ goto gotWindow;
+ }
+
+ if (client == NULL) {
+ /*
+ * We just used a '-create' script to make a new window, which we
+ * now need to add to our client list.
+ */
+
+ client = ckalloc(sizeof(TkTextEmbWindowClient));
+ client->next = ewPtr->body.ew.clients;
+ client->textPtr = textPtr;
+ client->tkwin = NULL;
+ client->chunkCount = 0;
+ client->displayed = 0;
+ client->parent = ewPtr;
+ ewPtr->body.ew.clients = client;
+ }
+
+ client->tkwin = ewPtr->body.ew.tkwin;
+ Tk_ManageGeometry(client->tkwin, &textGeomType, client);
+ Tk_CreateEventHandler(client->tkwin, StructureNotifyMask,
+ EmbWinStructureProc, client);
+
+ /*
+ * Special trick! Must enter into the hash table *after* calling
+ * Tk_ManageGeometry: if the window was already managed elsewhere in
+ * this text, the Tk_ManageGeometry call will cause the entry to be
+ * removed, which could potentially lose the new entry.
+ */
+
+ hPtr = Tcl_CreateHashEntry(&textPtr->sharedTextPtr->windowTable,
+ Tk_PathName(client->tkwin), &isNew);
+ Tcl_SetHashValue(hPtr, ewPtr);
+ }
+
+ /*
+ * See if there's room for this window on this line.
+ */
+
+ gotWindow:
+ if (ewPtr->body.ew.tkwin == NULL) {
+ width = 0;
+ height = 0;
+ } else {
+ width = Tk_ReqWidth(ewPtr->body.ew.tkwin) + 2*ewPtr->body.ew.padX;
+ height = Tk_ReqHeight(ewPtr->body.ew.tkwin) + 2*ewPtr->body.ew.padY;
+ }
+ if ((width > (maxX - chunkPtr->x))
+ && !noCharsYet && (textPtr->wrapMode != TEXT_WRAPMODE_NONE)) {
+ return 0;
+ }
+
+ /*
+ * Fill in the chunk structure.
+ */
+
+ chunkPtr->displayProc = TkTextEmbWinDisplayProc;
+ chunkPtr->undisplayProc = EmbWinUndisplayProc;
+ chunkPtr->measureProc = NULL;
+ chunkPtr->bboxProc = EmbWinBboxProc;
+ chunkPtr->numBytes = 1;
+ if (ewPtr->body.ew.align == ALIGN_BASELINE) {
+ chunkPtr->minAscent = height - ewPtr->body.ew.padY;
+ chunkPtr->minDescent = ewPtr->body.ew.padY;
+ chunkPtr->minHeight = 0;
+ } else {
+ chunkPtr->minAscent = 0;
+ chunkPtr->minDescent = 0;
+ chunkPtr->minHeight = height;
+ }
+ chunkPtr->width = width;
+ chunkPtr->breakIndex = -1;
+ chunkPtr->breakIndex = 1;
+ chunkPtr->clientData = ewPtr;
+ if (client != NULL) {
+ client->chunkCount += 1;
+ }
+ return 1;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * EmbWinCheckProc --
+ *
+ * This function is invoked by the B-tree code to perform consistency
+ * checks on embedded windows.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The function panics if it detects anything wrong with the embedded
+ * window.
+ *
+ *--------------------------------------------------------------
+ */
+
+static void
+EmbWinCheckProc(
+ TkTextSegment *ewPtr, /* Segment to check. */
+ TkTextLine *linePtr) /* Line containing segment. */
+{
+ if (ewPtr->nextPtr == NULL) {
+ Tcl_Panic("EmbWinCheckProc: embedded window is last segment in line");
+ }
+ if (ewPtr->size != 1) {
+ Tcl_Panic("EmbWinCheckProc: embedded window has size %d", ewPtr->size);
+ }
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * TkTextEmbWinDisplayProc --
+ *
+ * This function is invoked by the text displaying code when it is time
+ * to actually draw an embedded window chunk on the screen.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The embedded window gets moved to the correct location and mapped onto
+ * the screen.
+ *
+ *--------------------------------------------------------------
+ */
+
+void
+TkTextEmbWinDisplayProc(
+ TkText *textPtr, /* Information about text widget. */
+ TkTextDispChunk *chunkPtr, /* Chunk that is to be drawn. */
+ int x, /* X-position in dst at which to draw this
+ * chunk (differs from the x-position in the
+ * chunk because of scrolling). */
+ int y, /* Top of rectangular bounding box for line:
+ * tells where to draw this chunk in dst
+ * (x-position is in the chunk itself). */
+ int lineHeight, /* Total height of line. */
+ int baseline, /* Offset of baseline from y. */
+ Display *display, /* Display to use for drawing (unused). */
+ Drawable dst, /* Pixmap or window in which to draw
+ * (unused). */
+ int screenY) /* Y-coordinate in text window that
+ * corresponds to y. */
+{
+ int lineX, windowX, windowY, width, height;
+ Tk_Window tkwin;
+ TkTextSegment *ewPtr = chunkPtr->clientData;
+ TkTextEmbWindowClient *client = EmbWinGetClient(textPtr, ewPtr);
+
+ if (client == NULL) {
+ return;
+ }
+
+ tkwin = client->tkwin;
+ if (tkwin == NULL) {
+ return;
+ }
+
+ if ((x + chunkPtr->width) <= 0) {
+ /*
+ * The window is off-screen; just unmap it.
+ */
+
+ if (textPtr->tkwin != Tk_Parent(tkwin)) {
+ Tk_UnmaintainGeometry(tkwin, textPtr->tkwin);
+ } else {
+ Tk_UnmapWindow(tkwin);
+ }
+ return;
+ }
+
+ /*
+ * Compute the window's location and size in the text widget, taking into
+ * account the align and stretch values for the window.
+ */
+
+ EmbWinBboxProc(textPtr, chunkPtr, 0, screenY, lineHeight, baseline,
+ &lineX, &windowY, &width, &height);
+ windowX = lineX - chunkPtr->x + x;
+
+ /*
+ * Mark the window as displayed so that it won't get unmapped.
+ * This needs to be done before the next instruction block because
+ * Tk_MaintainGeometry/Tk_MapWindow will run event handlers, in
+ * particular for the <Map> event, and if the bound script deletes
+ * the embedded window its clients will get freed.
+ */
+
+ client->displayed = 1;
+
+ if (textPtr->tkwin == Tk_Parent(tkwin)) {
+ if ((windowX != Tk_X(tkwin)) || (windowY != Tk_Y(tkwin))
+ || (Tk_ReqWidth(tkwin) != Tk_Width(tkwin))
+ || (height != Tk_Height(tkwin))) {
+ Tk_MoveResizeWindow(tkwin, windowX, windowY, width, height);
+ }
+ Tk_MapWindow(tkwin);
+ } else {
+ Tk_MaintainGeometry(tkwin, textPtr->tkwin, windowX, windowY,
+ width, height);
+ }
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * EmbWinUndisplayProc --
+ *
+ * This function is called when the chunk for an embedded window is no
+ * longer going to be displayed. It arranges for the window associated
+ * with the chunk to be unmapped.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The window is scheduled for unmapping.
+ *
+ *--------------------------------------------------------------
+ */
+
+static void
+EmbWinUndisplayProc(
+ TkText *textPtr, /* Overall information about text widget. */
+ TkTextDispChunk *chunkPtr) /* Chunk that is about to be freed. */
+{
+ TkTextSegment *ewPtr = chunkPtr->clientData;
+ TkTextEmbWindowClient *client = EmbWinGetClient(textPtr, ewPtr);
+
+ if (client == NULL) {
+ return;
+ }
+
+ client->chunkCount--;
+ if (client->chunkCount == 0) {
+ /*
+ * Don't unmap the window immediately, since there's a good chance
+ * that it will immediately be redisplayed, perhaps even in the same
+ * place. Instead, schedule the window to be unmapped later; the call
+ * to EmbWinDelayedUnmap will be cancelled in the likely event that
+ * the unmap becomes unnecessary.
+ */
+
+ client->displayed = 0;
+ Tcl_DoWhenIdle(EmbWinDelayedUnmap, client);
+ }
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * EmbWinBboxProc --
+ *
+ * This function is called to compute the bounding box of the area
+ * occupied by an embedded window.
+ *
+ * Results:
+ * There is no return value. *xPtr and *yPtr are filled in with the
+ * coordinates of the upper left corner of the window, and *widthPtr and
+ * *heightPtr are filled in with the dimensions of the window in pixels.
+ * Note: not all of the returned bbox is necessarily visible on the
+ * screen (the rightmost part might be off-screen to the right, and the
+ * bottommost part might be off-screen to the bottom).
+ *
+ * Side effects:
+ * None.
+ *
+ *--------------------------------------------------------------
+ */
+
+static void
+EmbWinBboxProc(
+ TkText *textPtr, /* Information about text widget. */
+ TkTextDispChunk *chunkPtr, /* Chunk containing desired char. */
+ int index, /* Index of desired character within the
+ * chunk. */
+ int y, /* Topmost pixel in area allocated for this
+ * line. */
+ int lineHeight, /* Total height of line. */
+ int baseline, /* Location of line's baseline, in pixels
+ * measured down from y. */
+ int *xPtr, int *yPtr, /* Gets filled in with coords of character's
+ * upper-left pixel. */
+ int *widthPtr, /* Gets filled in with width of window, in
+ * pixels. */
+ int *heightPtr) /* Gets filled in with height of window, in
+ * pixels. */
+{
+ Tk_Window tkwin;
+ TkTextSegment *ewPtr = chunkPtr->clientData;
+ TkTextEmbWindowClient *client = EmbWinGetClient(textPtr, ewPtr);
+
+ if (client == NULL) {
+ tkwin = NULL;
+ } else {
+ tkwin = client->tkwin;
+ }
+ if (tkwin != NULL) {
+ *widthPtr = Tk_ReqWidth(tkwin);
+ *heightPtr = Tk_ReqHeight(tkwin);
+ } else {
+ *widthPtr = 0;
+ *heightPtr = 0;
+ }
+ *xPtr = chunkPtr->x + ewPtr->body.ew.padX;
+ if (ewPtr->body.ew.stretch) {
+ if (ewPtr->body.ew.align == ALIGN_BASELINE) {
+ *heightPtr = baseline - ewPtr->body.ew.padY;
+ } else {
+ *heightPtr = lineHeight - 2*ewPtr->body.ew.padY;
+ }
+ }
+ switch (ewPtr->body.ew.align) {
+ case ALIGN_BOTTOM:
+ *yPtr = y + (lineHeight - *heightPtr - ewPtr->body.ew.padY);
+ break;
+ case ALIGN_CENTER:
+ *yPtr = y + (lineHeight - *heightPtr)/2;
+ break;
+ case ALIGN_TOP:
+ *yPtr = y + ewPtr->body.ew.padY;
+ break;
+ case ALIGN_BASELINE:
+ *yPtr = y + (baseline - *heightPtr);
+ break;
+ }
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * EmbWinDelayedUnmap --
+ *
+ * This function is an idle handler that does the actual work of
+ * unmapping an embedded window. See the comment in EmbWinUndisplayProc
+ * for details.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The window gets unmapped, unless its chunk reference count has become
+ * non-zero again.
+ *
+ *--------------------------------------------------------------
+ */
+
+static void
+EmbWinDelayedUnmap(
+ ClientData clientData) /* Token for the window to be unmapped. */
+{
+ TkTextEmbWindowClient *client = clientData;
+
+ if (!client->displayed && (client->tkwin != NULL)) {
+ if (client->textPtr->tkwin != Tk_Parent(client->tkwin)) {
+ Tk_UnmaintainGeometry(client->tkwin, client->textPtr->tkwin);
+ } else {
+ Tk_UnmapWindow(client->tkwin);
+ }
+ }
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * TkTextWindowIndex --
+ *
+ * Given the name of an embedded window within a text widget, returns an
+ * index corresponding to the window's position in the text.
+ *
+ * Results:
+ * The return value is 1 if there is an embedded window by the given name
+ * in the text widget, 0 otherwise. If the window exists, *indexPtr is
+ * filled in with its index.
+ *
+ * Side effects:
+ * None.
+ *
+ *--------------------------------------------------------------
+ */
+
+int
+TkTextWindowIndex(
+ TkText *textPtr, /* Text widget containing window. */
+ const char *name, /* Name of window. */
+ TkTextIndex *indexPtr) /* Index information gets stored here. */
+{
+ Tcl_HashEntry *hPtr;
+ TkTextSegment *ewPtr;
+
+ if (textPtr == NULL) {
+ return 0;
+ }
+
+ hPtr = Tcl_FindHashEntry(&textPtr->sharedTextPtr->windowTable, name);
+ if (hPtr == NULL) {
+ return 0;
+ }
+
+ ewPtr = Tcl_GetHashValue(hPtr);
+ indexPtr->tree = textPtr->sharedTextPtr->tree;
+ indexPtr->linePtr = ewPtr->body.ew.linePtr;
+ indexPtr->byteIndex = TkTextSegToOffset(ewPtr, indexPtr->linePtr);
+ return 1;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * EmbWinGetClient --
+ *
+ * Given a text widget and a segment which contains an embedded window,
+ * find the text-widget specific information about the embedded window,
+ * if any.
+ *
+ * This function performs a completely linear lookup for a matching data
+ * structure. If we envisage using this code with dozens of peer widgets,
+ * then performance could become an issue and a more sophisticated lookup
+ * mechanism might be desirable.
+ *
+ * Results:
+ * NULL if no widget-specific info exists, otherwise the structure is
+ * returned.
+ *
+ * Side effects:
+ * None.
+ *
+ *--------------------------------------------------------------
+ */
+
+static TkTextEmbWindowClient *
+EmbWinGetClient(
+ const TkText *textPtr, /* Information about text widget. */
+ TkTextSegment *ewPtr) /* Segment containing embedded window. */
+{
+ TkTextEmbWindowClient *client = ewPtr->body.ew.clients;
+
+ while (client != NULL) {
+ if (client->textPtr == textPtr) {
+ return client;
+ }
+ client = client->next;
+ }
+ return NULL;
+}
+
+/*
+ * Local Variables:
+ * mode: c
+ * c-basic-offset: 4
+ * fill-column: 78
+ * End:
+ */
diff --git a/tk8.6/generic/tkTrig.c b/tk8.6/generic/tkTrig.c
new file mode 100644
index 0000000..a2bf456
--- /dev/null
+++ b/tk8.6/generic/tkTrig.c
@@ -0,0 +1,1753 @@
+/*
+ * tkTrig.c --
+ *
+ * This file contains a collection of trigonometry utility routines that
+ * are used by Tk and in particular by the canvas code. It also has
+ * miscellaneous geometry functions used by canvases.
+ *
+ * Copyright (c) 1992-1994 The Regents of the University of California.
+ * Copyright (c) 1994-1997 Sun Microsystems, Inc.
+ *
+ * See the file "license.terms" for information on usage and redistribution of
+ * this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ */
+
+#include "tkInt.h"
+#include "tkCanvas.h"
+
+#undef MIN
+#define MIN(a,b) (((a) < (b)) ? (a) : (b))
+#undef MAX
+#define MAX(a,b) (((a) > (b)) ? (a) : (b))
+
+/*
+ *--------------------------------------------------------------
+ *
+ * TkLineToPoint --
+ *
+ * Compute the distance from a point to a finite line segment.
+ *
+ * Results:
+ * The return value is the distance from the line segment whose
+ * end-points are *end1Ptr and *end2Ptr to the point given by *pointPtr.
+ *
+ * Side effects:
+ * None.
+ *
+ *--------------------------------------------------------------
+ */
+
+double
+TkLineToPoint(
+ double end1Ptr[2], /* Coordinates of first end-point of line. */
+ double end2Ptr[2], /* Coordinates of second end-point of line. */
+ double pointPtr[2]) /* Points to coords for point. */
+{
+ double x, y;
+
+ /*
+ * Compute the point on the line that is closest to the point. This must
+ * be done separately for vertical edges, horizontal edges, and other
+ * edges.
+ */
+
+ if (end1Ptr[0] == end2Ptr[0]) {
+
+ /*
+ * Vertical edge.
+ */
+
+ x = end1Ptr[0];
+ if (end1Ptr[1] >= end2Ptr[1]) {
+ y = MIN(end1Ptr[1], pointPtr[1]);
+ y = MAX(y, end2Ptr[1]);
+ } else {
+ y = MIN(end2Ptr[1], pointPtr[1]);
+ y = MAX(y, end1Ptr[1]);
+ }
+ } else if (end1Ptr[1] == end2Ptr[1]) {
+
+ /*
+ * Horizontal edge.
+ */
+
+ y = end1Ptr[1];
+ if (end1Ptr[0] >= end2Ptr[0]) {
+ x = MIN(end1Ptr[0], pointPtr[0]);
+ x = MAX(x, end2Ptr[0]);
+ } else {
+ x = MIN(end2Ptr[0], pointPtr[0]);
+ x = MAX(x, end1Ptr[0]);
+ }
+ } else {
+ double m1, b1, m2, b2;
+
+ /*
+ * The edge is neither horizontal nor vertical. Convert the edge to a
+ * line equation of the form y = m1*x + b1. Then compute a line
+ * perpendicular to this edge but passing through the point, also in
+ * the form y = m2*x + b2.
+ */
+
+ m1 = (end2Ptr[1] - end1Ptr[1])/(end2Ptr[0] - end1Ptr[0]);
+ b1 = end1Ptr[1] - m1*end1Ptr[0];
+ m2 = -1.0/m1;
+ b2 = pointPtr[1] - m2*pointPtr[0];
+ x = (b2 - b1)/(m1 - m2);
+ y = m1*x + b1;
+ if (end1Ptr[0] > end2Ptr[0]) {
+ if (x > end1Ptr[0]) {
+ x = end1Ptr[0];
+ y = end1Ptr[1];
+ } else if (x < end2Ptr[0]) {
+ x = end2Ptr[0];
+ y = end2Ptr[1];
+ }
+ } else {
+ if (x > end2Ptr[0]) {
+ x = end2Ptr[0];
+ y = end2Ptr[1];
+ } else if (x < end1Ptr[0]) {
+ x = end1Ptr[0];
+ y = end1Ptr[1];
+ }
+ }
+ }
+
+ /*
+ * Compute the distance to the closest point.
+ */
+
+ return hypot(pointPtr[0] - x, pointPtr[1] - y);
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * TkLineToArea --
+ *
+ * Determine whether a line lies entirely inside, entirely outside, or
+ * overlapping a given rectangular area.
+ *
+ * Results:
+ * -1 is returned if the line given by end1Ptr and end2Ptr is entirely
+ * outside the rectangle given by rectPtr. 0 is returned if the polygon
+ * overlaps the rectangle, and 1 is returned if the polygon is entirely
+ * inside the rectangle.
+ *
+ * Side effects:
+ * None.
+ *
+ *--------------------------------------------------------------
+ */
+
+int
+TkLineToArea(
+ double end1Ptr[2], /* X and y coordinates for one endpoint of
+ * line. */
+ double end2Ptr[2], /* X and y coordinates for other endpoint of
+ * line. */
+ double rectPtr[4]) /* Points to coords for rectangle, in the
+ * order x1, y1, x2, y2. X1 must be no larger
+ * than x2, and y1 no larger than y2. */
+{
+ int inside1, inside2;
+
+ /*
+ * First check the two points individually to see whether they are inside
+ * the rectangle or not.
+ */
+
+ inside1 = (end1Ptr[0] >= rectPtr[0]) && (end1Ptr[0] <= rectPtr[2])
+ && (end1Ptr[1] >= rectPtr[1]) && (end1Ptr[1] <= rectPtr[3]);
+ inside2 = (end2Ptr[0] >= rectPtr[0]) && (end2Ptr[0] <= rectPtr[2])
+ && (end2Ptr[1] >= rectPtr[1]) && (end2Ptr[1] <= rectPtr[3]);
+ if (inside1 != inside2) {
+ return 0;
+ }
+ if (inside1 & inside2) {
+ return 1;
+ }
+
+ /*
+ * Both points are outside the rectangle, but still need to check for
+ * intersections between the line and the rectangle. Horizontal and
+ * vertical lines are particularly easy, so handle them separately.
+ */
+
+ if (end1Ptr[0] == end2Ptr[0]) {
+ /*
+ * Vertical line.
+ */
+
+ if (((end1Ptr[1] >= rectPtr[1]) ^ (end2Ptr[1] >= rectPtr[1]))
+ && (end1Ptr[0] >= rectPtr[0])
+ && (end1Ptr[0] <= rectPtr[2])) {
+ return 0;
+ }
+ } else if (end1Ptr[1] == end2Ptr[1]) {
+ /*
+ * Horizontal line.
+ */
+
+ if (((end1Ptr[0] >= rectPtr[0]) ^ (end2Ptr[0] >= rectPtr[0]))
+ && (end1Ptr[1] >= rectPtr[1])
+ && (end1Ptr[1] <= rectPtr[3])) {
+ return 0;
+ }
+ } else {
+ double m, x, y, low, high;
+
+ /*
+ * Diagonal line. Compute slope of line and use for intersection
+ * checks against each of the sides of the rectangle: left, right,
+ * bottom, top.
+ */
+
+ m = (end2Ptr[1] - end1Ptr[1])/(end2Ptr[0] - end1Ptr[0]);
+ if (end1Ptr[0] < end2Ptr[0]) {
+ low = end1Ptr[0];
+ high = end2Ptr[0];
+ } else {
+ low = end2Ptr[0];
+ high = end1Ptr[0];
+ }
+
+ /*
+ * Left edge.
+ */
+
+ y = end1Ptr[1] + (rectPtr[0] - end1Ptr[0])*m;
+ if ((rectPtr[0] >= low) && (rectPtr[0] <= high)
+ && (y >= rectPtr[1]) && (y <= rectPtr[3])) {
+ return 0;
+ }
+
+ /*
+ * Right edge.
+ */
+
+ y += (rectPtr[2] - rectPtr[0])*m;
+ if ((y >= rectPtr[1]) && (y <= rectPtr[3])
+ && (rectPtr[2] >= low) && (rectPtr[2] <= high)) {
+ return 0;
+ }
+
+ /*
+ * Bottom edge.
+ */
+
+ if (end1Ptr[1] < end2Ptr[1]) {
+ low = end1Ptr[1];
+ high = end2Ptr[1];
+ } else {
+ low = end2Ptr[1];
+ high = end1Ptr[1];
+ }
+ x = end1Ptr[0] + (rectPtr[1] - end1Ptr[1])/m;
+ if ((x >= rectPtr[0]) && (x <= rectPtr[2])
+ && (rectPtr[1] >= low) && (rectPtr[1] <= high)) {
+ return 0;
+ }
+
+ /*
+ * Top edge.
+ */
+
+ x += (rectPtr[3] - rectPtr[1])/m;
+ if ((x >= rectPtr[0]) && (x <= rectPtr[2])
+ && (rectPtr[3] >= low) && (rectPtr[3] <= high)) {
+ return 0;
+ }
+ }
+ return -1;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * TkThickPolyLineToArea --
+ *
+ * This function is called to determine whether a connected series of
+ * line segments lies entirely inside, entirely outside, or overlapping a
+ * given rectangular area.
+ *
+ * Results:
+ * -1 is returned if the lines are entirely outside the area, 0 if they
+ * overlap, and 1 if they are entirely inside the given area.
+ *
+ * Side effects:
+ * None.
+ *
+ *--------------------------------------------------------------
+ */
+
+ /* ARGSUSED */
+int
+TkThickPolyLineToArea(
+ double *coordPtr, /* Points to an array of coordinates for the
+ * polyline: x0, y0, x1, y1, ... */
+ int numPoints, /* Total number of points at *coordPtr. */
+ double width, /* Width of each line segment. */
+ int capStyle, /* How are end-points of polyline drawn?
+ * CapRound, CapButt, or CapProjecting. */
+ int joinStyle, /* How are joints in polyline drawn?
+ * JoinMiter, JoinRound, or JoinBevel. */
+ double *rectPtr) /* Rectangular area to check against. */
+{
+ double radius, poly[10];
+ int count;
+ int changedMiterToBevel; /* Non-zero means that a mitered corner had to
+ * be treated as beveled after all because the
+ * angle was < 11 degrees. */
+ int inside; /* Tentative guess about what to return, based
+ * on all points seen so far: one means
+ * everything seen so far was inside the area;
+ * -1 means everything was outside the area.
+ * 0 means overlap has been found. */
+
+ radius = width/2.0;
+ inside = -1;
+
+ if ((coordPtr[0] >= rectPtr[0]) && (coordPtr[0] <= rectPtr[2])
+ && (coordPtr[1] >= rectPtr[1]) && (coordPtr[1] <= rectPtr[3])) {
+ inside = 1;
+ }
+
+ /*
+ * Iterate through all of the edges of the line, computing a polygon for
+ * each edge and testing the area against that polygon. In addition, there
+ * are additional tests to deal with rounded joints and caps.
+ */
+
+ changedMiterToBevel = 0;
+ for (count = numPoints; count >= 2; count--, coordPtr += 2) {
+ /*
+ * If rounding is done around the first point of the edge then test a
+ * circular region around the point with the area.
+ */
+
+ if (((capStyle == CapRound) && (count == numPoints))
+ || ((joinStyle == JoinRound) && (count != numPoints))) {
+ poly[0] = coordPtr[0] - radius;
+ poly[1] = coordPtr[1] - radius;
+ poly[2] = coordPtr[0] + radius;
+ poly[3] = coordPtr[1] + radius;
+ if (TkOvalToArea(poly, rectPtr) != inside) {
+ return 0;
+ }
+ }
+
+ /*
+ * Compute the polygonal shape corresponding to this edge, consisting
+ * of two points for the first point of the edge and two points for
+ * the last point of the edge.
+ */
+
+ if (count == numPoints) {
+ TkGetButtPoints(coordPtr+2, coordPtr, width,
+ capStyle == CapProjecting, poly, poly+2);
+ } else if ((joinStyle == JoinMiter) && !changedMiterToBevel) {
+ poly[0] = poly[6];
+ poly[1] = poly[7];
+ poly[2] = poly[4];
+ poly[3] = poly[5];
+ } else {
+ TkGetButtPoints(coordPtr+2, coordPtr, width, 0, poly, poly+2);
+
+ /*
+ * If the last joint was beveled, then also check a polygon
+ * comprising the last two points of the previous polygon and the
+ * first two from this polygon; this checks the wedges that fill
+ * the beveled joint.
+ */
+
+ if ((joinStyle == JoinBevel) || changedMiterToBevel) {
+ poly[8] = poly[0];
+ poly[9] = poly[1];
+ if (TkPolygonToArea(poly, 5, rectPtr) != inside) {
+ return 0;
+ }
+ changedMiterToBevel = 0;
+ }
+ }
+ if (count == 2) {
+ TkGetButtPoints(coordPtr, coordPtr+2, width,
+ capStyle == CapProjecting, poly+4, poly+6);
+ } else if (joinStyle == JoinMiter) {
+ if (TkGetMiterPoints(coordPtr, coordPtr+2, coordPtr+4,
+ (double) width, poly+4, poly+6) == 0) {
+ changedMiterToBevel = 1;
+ TkGetButtPoints(coordPtr, coordPtr+2, width, 0, poly+4,
+ poly+6);
+ }
+ } else {
+ TkGetButtPoints(coordPtr, coordPtr+2, width, 0, poly+4, poly+6);
+ }
+ poly[8] = poly[0];
+ poly[9] = poly[1];
+ if (TkPolygonToArea(poly, 5, rectPtr) != inside) {
+ return 0;
+ }
+ }
+
+ /*
+ * If caps are rounded, check the cap around the final point of the line.
+ */
+
+ if (capStyle == CapRound) {
+ poly[0] = coordPtr[0] - radius;
+ poly[1] = coordPtr[1] - radius;
+ poly[2] = coordPtr[0] + radius;
+ poly[3] = coordPtr[1] + radius;
+ if (TkOvalToArea(poly, rectPtr) != inside) {
+ return 0;
+ }
+ }
+
+ return inside;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * TkPolygonToPoint --
+ *
+ * Compute the distance from a point to a polygon.
+ *
+ * Results:
+ * The return value is 0.0 if the point referred to by pointPtr is within
+ * the polygon referred to by polyPtr and numPoints. Otherwise the return
+ * value is the distance of the point from the polygon.
+ *
+ * Side effects:
+ * None.
+ *
+ *--------------------------------------------------------------
+ */
+
+double
+TkPolygonToPoint(
+ double *polyPtr, /* Points to an array coordinates for closed
+ * polygon: x0, y0, x1, y1, ... The polygon
+ * may be self-intersecting. */
+ int numPoints, /* Total number of points at *polyPtr. */
+ double *pointPtr) /* Points to coords for point. */
+{
+ double bestDist; /* Closest distance between point and any edge
+ * in polygon. */
+ int intersections; /* Number of edges in the polygon that
+ * intersect a ray extending vertically
+ * upwards from the point to infinity. */
+ int count;
+ register double *pPtr;
+
+ /*
+ * Iterate through all of the edges in the polygon, updating bestDist and
+ * intersections.
+ *
+ * TRICKY POINT: when computing intersections, include left x-coordinate
+ * of line within its range, but not y-coordinate. Otherwise if the point
+ * lies exactly below a vertex we'll count it as two intersections.
+ */
+
+ bestDist = 1.0e36;
+ intersections = 0;
+
+ for (count = numPoints, pPtr = polyPtr; count > 1; count--, pPtr += 2) {
+ double x, y, dist;
+
+ /*
+ * Compute the point on the current edge closest to the point and
+ * update the intersection count. This must be done separately for
+ * vertical edges, horizontal edges, and other edges.
+ */
+
+ if (pPtr[2] == pPtr[0]) {
+
+ /*
+ * Vertical edge.
+ */
+
+ x = pPtr[0];
+ if (pPtr[1] >= pPtr[3]) {
+ y = MIN(pPtr[1], pointPtr[1]);
+ y = MAX(y, pPtr[3]);
+ } else {
+ y = MIN(pPtr[3], pointPtr[1]);
+ y = MAX(y, pPtr[1]);
+ }
+ } else if (pPtr[3] == pPtr[1]) {
+
+ /*
+ * Horizontal edge.
+ */
+
+ y = pPtr[1];
+ if (pPtr[0] >= pPtr[2]) {
+ x = MIN(pPtr[0], pointPtr[0]);
+ x = MAX(x, pPtr[2]);
+ if ((pointPtr[1] < y) && (pointPtr[0] < pPtr[0])
+ && (pointPtr[0] >= pPtr[2])) {
+ intersections++;
+ }
+ } else {
+ x = MIN(pPtr[2], pointPtr[0]);
+ x = MAX(x, pPtr[0]);
+ if ((pointPtr[1] < y) && (pointPtr[0] < pPtr[2])
+ && (pointPtr[0] >= pPtr[0])) {
+ intersections++;
+ }
+ }
+ } else {
+ double m1, b1, m2, b2;
+ int lower; /* Non-zero means point below line. */
+
+ /*
+ * The edge is neither horizontal nor vertical. Convert the edge
+ * to a line equation of the form y = m1*x + b1. Then compute a
+ * line perpendicular to this edge but passing through the point,
+ * also in the form y = m2*x + b2.
+ */
+
+ m1 = (pPtr[3] - pPtr[1])/(pPtr[2] - pPtr[0]);
+ b1 = pPtr[1] - m1*pPtr[0];
+ m2 = -1.0/m1;
+ b2 = pointPtr[1] - m2*pointPtr[0];
+ x = (b2 - b1)/(m1 - m2);
+ y = m1*x + b1;
+ if (pPtr[0] > pPtr[2]) {
+ if (x > pPtr[0]) {
+ x = pPtr[0];
+ y = pPtr[1];
+ } else if (x < pPtr[2]) {
+ x = pPtr[2];
+ y = pPtr[3];
+ }
+ } else {
+ if (x > pPtr[2]) {
+ x = pPtr[2];
+ y = pPtr[3];
+ } else if (x < pPtr[0]) {
+ x = pPtr[0];
+ y = pPtr[1];
+ }
+ }
+ lower = (m1*pointPtr[0] + b1) > pointPtr[1];
+ if (lower && (pointPtr[0] >= MIN(pPtr[0], pPtr[2]))
+ && (pointPtr[0] < MAX(pPtr[0], pPtr[2]))) {
+ intersections++;
+ }
+ }
+
+ /*
+ * Compute the distance to the closest point, and see if that is the
+ * best distance seen so far.
+ */
+
+ dist = hypot(pointPtr[0] - x, pointPtr[1] - y);
+ if (dist < bestDist) {
+ bestDist = dist;
+ }
+ }
+
+ /*
+ * We've processed all of the points. If the number of intersections is
+ * odd, the point is inside the polygon.
+ */
+
+ if (intersections & 0x1) {
+ return 0.0;
+ }
+ return bestDist;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * TkPolygonToArea --
+ *
+ * Determine whether a polygon lies entirely inside, entirely outside, or
+ * overlapping a given rectangular area.
+ *
+ * Results:
+ * -1 is returned if the polygon given by polyPtr and numPoints is
+ * entirely outside the rectangle given by rectPtr. 0 is returned if the
+ * polygon overlaps the rectangle, and 1 is returned if the polygon is
+ * entirely inside the rectangle.
+ *
+ * Side effects:
+ * None.
+ *
+ *--------------------------------------------------------------
+ */
+
+int
+TkPolygonToArea(
+ double *polyPtr, /* Points to an array coordinates for closed
+ * polygon: x0, y0, x1, y1, ... The polygon
+ * may be self-intersecting. */
+ int numPoints, /* Total number of points at *polyPtr. */
+ register double *rectPtr) /* Points to coords for rectangle, in the
+ * order x1, y1, x2, y2. X1 and y1 must be
+ * lower-left corner. */
+{
+ int state; /* State of all edges seen so far (-1 means
+ * outside, 1 means inside, won't ever be
+ * 0). */
+ int count;
+ register double *pPtr;
+
+ /*
+ * Iterate over all of the edges of the polygon and test them against the
+ * rectangle. Can quit as soon as the state becomes "intersecting".
+ */
+
+ state = TkLineToArea(polyPtr, polyPtr+2, rectPtr);
+ if (state == 0) {
+ return 0;
+ }
+ for (pPtr = polyPtr+2, count = numPoints-1; count >= 2;
+ pPtr += 2, count--) {
+ if (TkLineToArea(pPtr, pPtr+2, rectPtr) != state) {
+ return 0;
+ }
+ }
+
+ /*
+ * If all of the edges were inside the rectangle we're done. If all of the
+ * edges were outside, then the rectangle could still intersect the
+ * polygon (if it's entirely enclosed). Call TkPolygonToPoint to figure
+ * this out.
+ */
+
+ if (state == 1) {
+ return 1;
+ }
+ if (TkPolygonToPoint(polyPtr, numPoints, rectPtr) == 0.0) {
+ return 0;
+ }
+ return -1;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * TkOvalToPoint --
+ *
+ * Computes the distance from a given point to a given oval, in canvas
+ * units.
+ *
+ * Results:
+ * The return value is 0 if the point given by *pointPtr is inside the
+ * oval. If the point isn't inside the oval then the return value is
+ * approximately the distance from the point to the oval. If the oval is
+ * filled, then anywhere in the interior is considered "inside"; if the
+ * oval isn't filled, then "inside" means only the area occupied by the
+ * outline.
+ *
+ * Side effects:
+ * None.
+ *
+ *--------------------------------------------------------------
+ */
+
+ /* ARGSUSED */
+double
+TkOvalToPoint(
+ double ovalPtr[4], /* Pointer to array of four coordinates (x1,
+ * y1, x2, y2) defining oval's bounding
+ * box. */
+ double width, /* Width of outline for oval. */
+ int filled, /* Non-zero means oval should be treated as
+ * filled; zero means only consider
+ * outline. */
+ double pointPtr[2]) /* Coordinates of point. */
+{
+ double xDelta, yDelta, scaledDistance, distToOutline, distToCenter;
+ double xDiam, yDiam;
+
+ /*
+ * Compute the distance between the center of the oval and the point in
+ * question, using a coordinate system where the oval has been transformed
+ * to a circle with unit radius.
+ */
+
+ xDelta = (pointPtr[0] - (ovalPtr[0] + ovalPtr[2])/2.0);
+ yDelta = (pointPtr[1] - (ovalPtr[1] + ovalPtr[3])/2.0);
+ distToCenter = hypot(xDelta, yDelta);
+ scaledDistance = hypot(xDelta / ((ovalPtr[2] + width - ovalPtr[0])/2.0),
+ yDelta / ((ovalPtr[3] + width - ovalPtr[1])/2.0));
+
+ /*
+ * If the scaled distance is greater than 1 then it means no hit. Compute
+ * the distance from the point to the edge of the circle, then scale this
+ * distance back to the original coordinate system.
+ *
+ * Note: this distance isn't completely accurate. It's only an
+ * approximation, and it can overestimate the correct distance when the
+ * oval is eccentric.
+ */
+
+ if (scaledDistance > 1.0) {
+ return (distToCenter/scaledDistance) * (scaledDistance - 1.0);
+ }
+
+ /*
+ * Scaled distance less than 1 means the point is inside the outer edge of
+ * the oval. If this is a filled oval, then we have a hit. Otherwise, do
+ * the same computation as above (scale back to original coordinate
+ * system), but also check to see if the point is within the width of the
+ * outline.
+ */
+
+ if (filled) {
+ return 0.0;
+ }
+ if (scaledDistance > 1E-10) {
+ distToOutline = (distToCenter/scaledDistance) * (1.0 - scaledDistance)
+ - width;
+ } else {
+ /*
+ * Avoid dividing by a very small number (it could cause an arithmetic
+ * overflow). This problem occurs if the point is very close to the
+ * center of the oval.
+ */
+
+ xDiam = ovalPtr[2] - ovalPtr[0];
+ yDiam = ovalPtr[3] - ovalPtr[1];
+ if (xDiam < yDiam) {
+ distToOutline = (xDiam - width)/2;
+ } else {
+ distToOutline = (yDiam - width)/2;
+ }
+ }
+
+ if (distToOutline < 0.0) {
+ return 0.0;
+ }
+ return distToOutline;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * TkOvalToArea --
+ *
+ * Determine whether an oval lies entirely inside, entirely outside, or
+ * overlapping a given rectangular area.
+ *
+ * Results:
+ * -1 is returned if the oval described by ovalPtr is entirely outside
+ * the rectangle given by rectPtr. 0 is returned if the oval overlaps the
+ * rectangle, and 1 is returned if the oval is entirely inside the
+ * rectangle.
+ *
+ * Side effects:
+ * None.
+ *
+ *--------------------------------------------------------------
+ */
+
+int
+TkOvalToArea(
+ register double *ovalPtr, /* Points to coordinates defining the
+ * bounding rectangle for the oval: x1, y1,
+ * x2, y2. X1 must be less than x2 and y1 less
+ * than y2. */
+ register double *rectPtr) /* Points to coords for rectangle, in the
+ * order x1, y1, x2, y2. X1 and y1 must be
+ * lower-left corner. */
+{
+ double centerX, centerY, radX, radY, deltaX, deltaY;
+
+ /*
+ * First, see if oval is entirely inside rectangle or entirely outside
+ * rectangle.
+ */
+
+ if ((rectPtr[0] <= ovalPtr[0]) && (rectPtr[2] >= ovalPtr[2])
+ && (rectPtr[1] <= ovalPtr[1]) && (rectPtr[3] >= ovalPtr[3])) {
+ return 1;
+ }
+ if ((rectPtr[2] < ovalPtr[0]) || (rectPtr[0] > ovalPtr[2])
+ || (rectPtr[3] < ovalPtr[1]) || (rectPtr[1] > ovalPtr[3])) {
+ return -1;
+ }
+
+ /*
+ * Next, go through the rectangle side by side. For each side of the
+ * rectangle, find the point on the side that is closest to the oval's
+ * center, and see if that point is inside the oval. If at least one such
+ * point is inside the oval, then the rectangle intersects the oval.
+ */
+
+ centerX = (ovalPtr[0] + ovalPtr[2])/2;
+ centerY = (ovalPtr[1] + ovalPtr[3])/2;
+ radX = (ovalPtr[2] - ovalPtr[0])/2;
+ radY = (ovalPtr[3] - ovalPtr[1])/2;
+
+ deltaY = rectPtr[1] - centerY;
+ if (deltaY < 0.0) {
+ deltaY = centerY - rectPtr[3];
+ if (deltaY < 0.0) {
+ deltaY = 0;
+ }
+ }
+ deltaY /= radY;
+ deltaY *= deltaY;
+
+ /*
+ * Left side:
+ */
+
+ deltaX = (rectPtr[0] - centerX)/radX;
+ deltaX *= deltaX;
+ if ((deltaX + deltaY) <= 1.0) {
+ return 0;
+ }
+
+ /*
+ * Right side:
+ */
+
+ deltaX = (rectPtr[2] - centerX)/radX;
+ deltaX *= deltaX;
+ if ((deltaX + deltaY) <= 1.0) {
+ return 0;
+ }
+
+ deltaX = rectPtr[0] - centerX;
+ if (deltaX < 0.0) {
+ deltaX = centerX - rectPtr[2];
+ if (deltaX < 0.0) {
+ deltaX = 0;
+ }
+ }
+ deltaX /= radX;
+ deltaX *= deltaX;
+
+ /*
+ * Bottom side:
+ */
+
+ deltaY = (rectPtr[1] - centerY)/radY;
+ deltaY *= deltaY;
+ if ((deltaX + deltaY) < 1.0) {
+ return 0;
+ }
+
+ /*
+ * Top side:
+ */
+
+ deltaY = (rectPtr[3] - centerY)/radY;
+ deltaY *= deltaY;
+ if ((deltaX + deltaY) < 1.0) {
+ return 0;
+ }
+
+ return -1;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * TkIncludePoint --
+ *
+ * Given a point and a generic canvas item header, expand the item's
+ * bounding box if needed to include the point.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The boudn.
+ *
+ *--------------------------------------------------------------
+ */
+
+ /* ARGSUSED */
+void
+TkIncludePoint(
+ register Tk_Item *itemPtr, /* Item whose bounding box is being
+ * calculated. */
+ double *pointPtr) /* Address of two doubles giving x and y
+ * coordinates of point. */
+{
+ int tmp;
+
+ tmp = (int) (pointPtr[0] + 0.5);
+ if (tmp < itemPtr->x1) {
+ itemPtr->x1 = tmp;
+ }
+ if (tmp > itemPtr->x2) {
+ itemPtr->x2 = tmp;
+ }
+ tmp = (int) (pointPtr[1] + 0.5);
+ if (tmp < itemPtr->y1) {
+ itemPtr->y1 = tmp;
+ }
+ if (tmp > itemPtr->y2) {
+ itemPtr->y2 = tmp;
+ }
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * TkBezierScreenPoints --
+ *
+ * Given four control points, create a larger set of XPoints for a Bezier
+ * curve based on the points.
+ *
+ * Results:
+ * The array at *xPointPtr gets filled in with numSteps XPoints
+ * corresponding to the Bezier spline defined by the four control points.
+ * Note: no output point is generated for the first input point, but an
+ * output point *is* generated for the last input point.
+ *
+ * Side effects:
+ * None.
+ *
+ *--------------------------------------------------------------
+ */
+
+void
+TkBezierScreenPoints(
+ Tk_Canvas canvas, /* Canvas in which curve is to be drawn. */
+ double control[], /* Array of coordinates for four control
+ * points: x0, y0, x1, y1, ... x3 y3. */
+ int numSteps, /* Number of curve points to generate. */
+ register XPoint *xPointPtr) /* Where to put new points. */
+{
+ int i;
+ double u, u2, u3, t, t2, t3;
+
+ for (i = 1; i <= numSteps; i++, xPointPtr++) {
+ t = ((double) i)/((double) numSteps);
+ t2 = t*t;
+ t3 = t2*t;
+ u = 1.0 - t;
+ u2 = u*u;
+ u3 = u2*u;
+ Tk_CanvasDrawableCoords(canvas,
+ (control[0]*u3 + 3.0 * (control[2]*t*u2 + control[4]*t2*u)
+ + control[6]*t3),
+ (control[1]*u3 + 3.0 * (control[3]*t*u2 + control[5]*t2*u)
+ + control[7]*t3),
+ &xPointPtr->x, &xPointPtr->y);
+ }
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * TkBezierPoints --
+ *
+ * Given four control points, create a larger set of points for a Bezier
+ * curve based on the points.
+ *
+ * Results:
+ * The array at *coordPtr gets filled in with 2*numSteps coordinates,
+ * which correspond to the Bezier spline defined by the four control
+ * points. Note: no output point is generated for the first input point,
+ * but an output point *is* generated for the last input point.
+ *
+ * Side effects:
+ * None.
+ *
+ *--------------------------------------------------------------
+ */
+
+void
+TkBezierPoints(
+ double control[], /* Array of coordinates for four control
+ * points: x0, y0, x1, y1, ... x3 y3. */
+ int numSteps, /* Number of curve points to generate. */
+ register double *coordPtr) /* Where to put new points. */
+{
+ int i;
+ double u, u2, u3, t, t2, t3;
+
+ for (i = 1; i <= numSteps; i++, coordPtr += 2) {
+ t = ((double) i)/((double) numSteps);
+ t2 = t*t;
+ t3 = t2*t;
+ u = 1.0 - t;
+ u2 = u*u;
+ u3 = u2*u;
+ coordPtr[0] = control[0]*u3
+ + 3.0 * (control[2]*t*u2 + control[4]*t2*u) + control[6]*t3;
+ coordPtr[1] = control[1]*u3
+ + 3.0 * (control[3]*t*u2 + control[5]*t2*u) + control[7]*t3;
+ }
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * TkMakeBezierCurve --
+ *
+ * Given a set of points, create a new set of points that fit parabolic
+ * splines to the line segments connecting the original points. Produces
+ * output points in either of two forms.
+ *
+ * Note: the name of this function should *not* be taken to mean that it
+ * interprets the input points as directly defining Bezier curves.
+ * Rather, it internally computes a Bezier curve representation of each
+ * parabolic spline segment. (These Bezier curves are then flattened to
+ * produce the points filled into the output arrays.)
+ *
+ * Results:
+ * Either or both of the xPoints or dblPoints arrays are filled in. The
+ * return value is the number of points placed in the arrays. Note: if
+ * the first and last points are the same, then a closed curve is
+ * generated.
+ *
+ * Side effects:
+ * None.
+ *
+ *--------------------------------------------------------------
+ */
+
+int
+TkMakeBezierCurve(
+ Tk_Canvas canvas, /* Canvas in which curve is to be drawn. */
+ double *pointPtr, /* Array of input coordinates: x0, y0, x1, y1,
+ * etc.. */
+ int numPoints, /* Number of points at pointPtr. */
+ int numSteps, /* Number of steps to use for each spline
+ * segments (determines smoothness of
+ * curve). */
+ XPoint xPoints[], /* Array of XPoints to fill in (e.g. for
+ * display). NULL means don't fill in any
+ * XPoints. */
+ double dblPoints[]) /* Array of points to fill in as doubles, in
+ * the form x0, y0, x1, y1, .... NULL means
+ * don't fill in anything in this form. Caller
+ * must make sure that this array has enough
+ * space. */
+{
+ int closed, outputPoints, i;
+ int numCoords = numPoints*2;
+ double control[8];
+
+ /*
+ * If the curve is a closed one then generate a special spline that spans
+ * the last points and the first ones. Otherwise just put the first point
+ * into the output.
+ */
+
+ if (!pointPtr) {
+ /*
+ * Of pointPtr == NULL, this function returns an upper limit of the
+ * array size to store the coordinates. This can be used to allocate
+ * storage, before the actual coordinates are calculated.
+ */
+
+ return 1 + numPoints * numSteps;
+ }
+
+ outputPoints = 0;
+ if ((pointPtr[0] == pointPtr[numCoords-2])
+ && (pointPtr[1] == pointPtr[numCoords-1])) {
+ closed = 1;
+ control[0] = 0.5*pointPtr[numCoords-4] + 0.5*pointPtr[0];
+ control[1] = 0.5*pointPtr[numCoords-3] + 0.5*pointPtr[1];
+ control[2] = 0.167*pointPtr[numCoords-4] + 0.833*pointPtr[0];
+ control[3] = 0.167*pointPtr[numCoords-3] + 0.833*pointPtr[1];
+ control[4] = 0.833*pointPtr[0] + 0.167*pointPtr[2];
+ control[5] = 0.833*pointPtr[1] + 0.167*pointPtr[3];
+ control[6] = 0.5*pointPtr[0] + 0.5*pointPtr[2];
+ control[7] = 0.5*pointPtr[1] + 0.5*pointPtr[3];
+ if (xPoints != NULL) {
+ Tk_CanvasDrawableCoords(canvas, control[0], control[1],
+ &xPoints->x, &xPoints->y);
+ TkBezierScreenPoints(canvas, control, numSteps, xPoints+1);
+ xPoints += numSteps+1;
+ }
+ if (dblPoints != NULL) {
+ dblPoints[0] = control[0];
+ dblPoints[1] = control[1];
+ TkBezierPoints(control, numSteps, dblPoints+2);
+ dblPoints += 2*(numSteps+1);
+ }
+ outputPoints += numSteps+1;
+ } else {
+ closed = 0;
+ if (xPoints != NULL) {
+ Tk_CanvasDrawableCoords(canvas, pointPtr[0], pointPtr[1],
+ &xPoints->x, &xPoints->y);
+ xPoints += 1;
+ }
+ if (dblPoints != NULL) {
+ dblPoints[0] = pointPtr[0];
+ dblPoints[1] = pointPtr[1];
+ dblPoints += 2;
+ }
+ outputPoints += 1;
+ }
+
+ for (i = 2; i < numPoints; i++, pointPtr += 2) {
+ /*
+ * Set up the first two control points. This is done differently for
+ * the first spline of an open curve than for other cases.
+ */
+
+ if ((i == 2) && !closed) {
+ control[0] = pointPtr[0];
+ control[1] = pointPtr[1];
+ control[2] = 0.333*pointPtr[0] + 0.667*pointPtr[2];
+ control[3] = 0.333*pointPtr[1] + 0.667*pointPtr[3];
+ } else {
+ control[0] = 0.5*pointPtr[0] + 0.5*pointPtr[2];
+ control[1] = 0.5*pointPtr[1] + 0.5*pointPtr[3];
+ control[2] = 0.167*pointPtr[0] + 0.833*pointPtr[2];
+ control[3] = 0.167*pointPtr[1] + 0.833*pointPtr[3];
+ }
+
+ /*
+ * Set up the last two control points. This is done differently for
+ * the last spline of an open curve than for other cases.
+ */
+
+ if ((i == (numPoints-1)) && !closed) {
+ control[4] = .667*pointPtr[2] + .333*pointPtr[4];
+ control[5] = .667*pointPtr[3] + .333*pointPtr[5];
+ control[6] = pointPtr[4];
+ control[7] = pointPtr[5];
+ } else {
+ control[4] = .833*pointPtr[2] + .167*pointPtr[4];
+ control[5] = .833*pointPtr[3] + .167*pointPtr[5];
+ control[6] = 0.5*pointPtr[2] + 0.5*pointPtr[4];
+ control[7] = 0.5*pointPtr[3] + 0.5*pointPtr[5];
+ }
+
+ /*
+ * If the first two points coincide, or if the last two points
+ * coincide, then generate a single straight-line segment by
+ * outputting the last control point.
+ */
+
+ if (((pointPtr[0] == pointPtr[2]) && (pointPtr[1] == pointPtr[3]))
+ || ((pointPtr[2] == pointPtr[4])
+ && (pointPtr[3] == pointPtr[5]))) {
+ if (xPoints != NULL) {
+ Tk_CanvasDrawableCoords(canvas, control[6], control[7],
+ &xPoints[0].x, &xPoints[0].y);
+ xPoints++;
+ }
+ if (dblPoints != NULL) {
+ dblPoints[0] = control[6];
+ dblPoints[1] = control[7];
+ dblPoints += 2;
+ }
+ outputPoints += 1;
+ continue;
+ }
+
+ /*
+ * Generate a Bezier spline using the control points.
+ */
+
+
+ if (xPoints != NULL) {
+ TkBezierScreenPoints(canvas, control, numSteps, xPoints);
+ xPoints += numSteps;
+ }
+ if (dblPoints != NULL) {
+ TkBezierPoints(control, numSteps, dblPoints);
+ dblPoints += 2*numSteps;
+ }
+ outputPoints += numSteps;
+ }
+ return outputPoints;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * TkMakeRawCurve --
+ *
+ * Interpret the given set of points as the raw knots and control points
+ * defining a sequence of cubic Bezier curves. Create a new set of points
+ * that fit these Bezier curves. Output points are produced in either of
+ * two forms.
+ *
+ * Results:
+ * Either or both of the xPoints or dblPoints arrays are filled in. The
+ * return value is the number of points placed in the arrays.
+ *
+ * Side effects:
+ * None.
+ *
+ *--------------------------------------------------------------
+ */
+
+int
+TkMakeRawCurve(
+ Tk_Canvas canvas, /* Canvas in which curve is to be drawn. */
+ double *pointPtr, /* Array of input coordinates: x0, y0, x1, y1,
+ * etc.. */
+ int numPoints, /* Number of points at pointPtr. */
+ int numSteps, /* Number of steps to use for each curve
+ * segment (determines smoothness of
+ * curve). */
+ XPoint xPoints[], /* Array of XPoints to fill in (e.g. for
+ * display). NULL means don't fill in any
+ * XPoints. */
+ double dblPoints[]) /* Array of points to fill in as doubles, in
+ * the form x0, y0, x1, y1, .... NULL means
+ * don't fill in anything in this form.
+ * Caller must make sure that this array has
+ * enough space. */
+{
+ int outputPoints, i;
+ int numSegments = (numPoints+1)/3;
+ double *segPtr;
+
+ /*
+ * The input describes a curve with s Bezier curve segments if there are
+ * 3s+1, 3s, or 3s-1 input points. In the last two cases, 1 or 2 initial
+ * points from the first curve segment are reused as defining points also
+ * for the last curve segment. In the case of 3s input points, this will
+ * automatically close the curve.
+ */
+
+ if (!pointPtr) {
+ /*
+ * If 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 + numSegments * numSteps;
+ }
+
+ outputPoints = 0;
+ if (xPoints != NULL) {
+ Tk_CanvasDrawableCoords(canvas, pointPtr[0], pointPtr[1],
+ &xPoints->x, &xPoints->y);
+ xPoints += 1;
+ }
+ if (dblPoints != NULL) {
+ dblPoints[0] = pointPtr[0];
+ dblPoints[1] = pointPtr[1];
+ dblPoints += 2;
+ }
+ outputPoints += 1;
+
+ /*
+ * The next loop handles all curve segments except one that overlaps the
+ * end of the list of coordinates.
+ */
+
+ for (i=numPoints,segPtr=pointPtr ; i>=4 ; i-=3,segPtr+=6) {
+ if (segPtr[0]==segPtr[2] && segPtr[1]==segPtr[3] &&
+ segPtr[4]==segPtr[6] && segPtr[5]==segPtr[7]) {
+ /*
+ * The control points on this segment are equal to their
+ * neighbouring knots, so this segment is just a straight line. A
+ * single point is sufficient.
+ */
+
+ if (xPoints != NULL) {
+ Tk_CanvasDrawableCoords(canvas, segPtr[6], segPtr[7],
+ &xPoints->x, &xPoints->y);
+ xPoints += 1;
+ }
+ if (dblPoints != NULL) {
+ dblPoints[0] = segPtr[6];
+ dblPoints[1] = segPtr[7];
+ dblPoints += 2;
+ }
+ outputPoints += 1;
+ } else {
+ /*
+ * This is a generic Bezier curve segment.
+ */
+
+ if (xPoints != NULL) {
+ TkBezierScreenPoints(canvas, segPtr, numSteps, xPoints);
+ xPoints += numSteps;
+ }
+ if (dblPoints != NULL) {
+ TkBezierPoints(segPtr, numSteps, dblPoints);
+ dblPoints += 2*numSteps;
+ }
+ outputPoints += numSteps;
+ }
+ }
+
+ /*
+ * If at this point i>1, then there is some point which has not yet been
+ * used. Make another curve segment.
+ */
+
+ if (i > 1) {
+ int j;
+ double control[8];
+
+ /*
+ * Copy the relevant coordinates to control[], so that it can be
+ * passed as a unit to e.g. TkBezierPoints.
+ */
+
+ for (j=0; j<2*i; j++) {
+ control[j] = segPtr[j];
+ }
+ for (; j<8; j++) {
+ control[j] = pointPtr[j-2*i];
+ }
+
+ /*
+ * Then we just do the same things as above.
+ */
+
+ if (control[0]==control[2] && control[1]==control[3] &&
+ control[4]==control[6] && control[5]==control[7]) {
+ /*
+ * The control points on this segment are equal to their
+ * neighbouring knots, so this segment is just a straight line. A
+ * single point is sufficient.
+ */
+
+ if (xPoints != NULL) {
+ Tk_CanvasDrawableCoords(canvas, control[6], control[7],
+ &xPoints->x, &xPoints->y);
+ xPoints += 1;
+ }
+ if (dblPoints != NULL) {
+ dblPoints[0] = control[6];
+ dblPoints[1] = control[7];
+ dblPoints += 2;
+ }
+ outputPoints += 1;
+ } else {
+ /*
+ * This is a generic Bezier curve segment.
+ */
+
+ if (xPoints != NULL) {
+ TkBezierScreenPoints(canvas, control, numSteps, xPoints);
+ xPoints += numSteps;
+ }
+ if (dblPoints != NULL) {
+ TkBezierPoints(control, numSteps, dblPoints);
+ dblPoints += 2*numSteps;
+ }
+ outputPoints += numSteps;
+ }
+ }
+
+ return outputPoints;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * TkMakeBezierPostscript --
+ *
+ * This function generates Postscript commands that create a path
+ * corresponding to a given Bezier curve.
+ *
+ * Results:
+ * None. Postscript commands to generate the path are appended to the
+ * interp's result.
+ *
+ * Side effects:
+ * None.
+ *
+ *--------------------------------------------------------------
+ */
+
+void
+TkMakeBezierPostscript(
+ Tcl_Interp *interp, /* Interpreter in whose result the Postscript
+ * is to be stored. */
+ Tk_Canvas canvas, /* Canvas widget for which the Postscript is
+ * being generated. */
+ double *pointPtr, /* Array of input coordinates: x0, y0, x1, y1,
+ * etc.. */
+ int numPoints) /* Number of points at pointPtr. */
+{
+ int closed, i;
+ int numCoords = numPoints*2;
+ double control[8];
+ Tcl_Obj *psObj;
+
+ /*
+ * If the curve is a closed one then generate a special spline that spans
+ * the last points and the first ones. Otherwise just put the first point
+ * into the path.
+ */
+
+ if ((pointPtr[0] == pointPtr[numCoords-2])
+ && (pointPtr[1] == pointPtr[numCoords-1])) {
+ closed = 1;
+ control[0] = 0.5*pointPtr[numCoords-4] + 0.5*pointPtr[0];
+ control[1] = 0.5*pointPtr[numCoords-3] + 0.5*pointPtr[1];
+ control[2] = 0.167*pointPtr[numCoords-4] + 0.833*pointPtr[0];
+ control[3] = 0.167*pointPtr[numCoords-3] + 0.833*pointPtr[1];
+ control[4] = 0.833*pointPtr[0] + 0.167*pointPtr[2];
+ control[5] = 0.833*pointPtr[1] + 0.167*pointPtr[3];
+ control[6] = 0.5*pointPtr[0] + 0.5*pointPtr[2];
+ control[7] = 0.5*pointPtr[1] + 0.5*pointPtr[3];
+ psObj = Tcl_ObjPrintf(
+ "%.15g %.15g moveto\n"
+ "%.15g %.15g %.15g %.15g %.15g %.15g curveto\n",
+ control[0], Tk_CanvasPsY(canvas, control[1]),
+ control[2], Tk_CanvasPsY(canvas, control[3]),
+ control[4], Tk_CanvasPsY(canvas, control[5]),
+ control[6], Tk_CanvasPsY(canvas, control[7]));
+ } else {
+ closed = 0;
+ control[6] = pointPtr[0];
+ control[7] = pointPtr[1];
+ psObj = Tcl_ObjPrintf("%.15g %.15g moveto\n",
+ control[6], Tk_CanvasPsY(canvas, control[7]));
+ }
+
+ /*
+ * Cycle through all the remaining points in the curve, generating a curve
+ * section for each vertex in the linear path.
+ */
+
+ for (i = numPoints-2, pointPtr += 2; i > 0; i--, pointPtr += 2) {
+ control[2] = 0.333*control[6] + 0.667*pointPtr[0];
+ control[3] = 0.333*control[7] + 0.667*pointPtr[1];
+
+ /*
+ * Set up the last two control points. This is done differently for
+ * the last spline of an open curve than for other cases.
+ */
+
+ if ((i == 1) && !closed) {
+ control[6] = pointPtr[2];
+ control[7] = pointPtr[3];
+ } else {
+ control[6] = 0.5*pointPtr[0] + 0.5*pointPtr[2];
+ control[7] = 0.5*pointPtr[1] + 0.5*pointPtr[3];
+ }
+ control[4] = 0.333*control[6] + 0.667*pointPtr[0];
+ control[5] = 0.333*control[7] + 0.667*pointPtr[1];
+
+ Tcl_AppendPrintfToObj(psObj,
+ "%.15g %.15g %.15g %.15g %.15g %.15g curveto\n",
+ control[2], Tk_CanvasPsY(canvas, control[3]),
+ control[4], Tk_CanvasPsY(canvas, control[5]),
+ control[6], Tk_CanvasPsY(canvas, control[7]));
+ }
+
+ Tcl_AppendObjToObj(Tcl_GetObjResult(interp), psObj);
+ Tcl_DecrRefCount(psObj);
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * TkMakeRawCurvePostscript --
+ *
+ * This function interprets the input points as the raw knot and control
+ * points for a curve composed of Bezier curve segments, just like
+ * TkMakeRawCurve. It generates Postscript commands that create a path
+ * corresponding to this given curve.
+ *
+ * Results:
+ * None. Postscript commands to generate the path are appended to the
+ * interp's result.
+ *
+ * Side effects:
+ * None.
+ *
+ *--------------------------------------------------------------
+ */
+
+void
+TkMakeRawCurvePostscript(
+ Tcl_Interp *interp, /* Interpreter in whose result the Postscript
+ * is to be stored. */
+ Tk_Canvas canvas, /* Canvas widget for which the Postscript is
+ * being generated. */
+ double *pointPtr, /* Array of input coordinates: x0, y0, x1, y1,
+ * etc.. */
+ int numPoints) /* Number of points at pointPtr. */
+{
+ int i;
+ double *segPtr;
+ Tcl_Obj *psObj;
+
+ /*
+ * Put the first point into the path.
+ */
+
+ psObj = Tcl_ObjPrintf("%.15g %.15g moveto\n",
+ pointPtr[0], Tk_CanvasPsY(canvas, pointPtr[1]));
+
+ /*
+ * Loop through all the remaining points in the curve, generating a
+ * straight line or curve section for every three of them.
+ */
+
+ for (i=numPoints-1,segPtr=pointPtr ; i>=3 ; i-=3,segPtr+=6) {
+ if (segPtr[0]==segPtr[2] && segPtr[1]==segPtr[3] &&
+ segPtr[4]==segPtr[6] && segPtr[5]==segPtr[7]) {
+ /*
+ * The control points on this segment are equal to their
+ * neighbouring knots, so this segment is just a straight line.
+ */
+
+ Tcl_AppendPrintfToObj(psObj, "%.15g %.15g lineto\n",
+ segPtr[6], Tk_CanvasPsY(canvas, segPtr[7]));
+ } else {
+ /*
+ * This is a generic Bezier curve segment.
+ */
+
+ Tcl_AppendPrintfToObj(psObj,
+ "%.15g %.15g %.15g %.15g %.15g %.15g curveto\n",
+ segPtr[2], Tk_CanvasPsY(canvas, segPtr[3]),
+ segPtr[4], Tk_CanvasPsY(canvas, segPtr[5]),
+ segPtr[6], Tk_CanvasPsY(canvas, segPtr[7]));
+ }
+ }
+
+ /*
+ * If there are any points left that haven't been used, then build the
+ * last segment and generate Postscript in the same way for that.
+ */
+
+ if (i > 0) {
+ int j;
+ double control[8];
+
+ for (j=0; j<2*i+2; j++) {
+ control[j] = segPtr[j];
+ }
+ for (; j<8; j++) {
+ control[j] = pointPtr[j-2*i-2];
+ }
+
+ if (control[0]==control[2] && control[1]==control[3] &&
+ control[4]==control[6] && control[5]==control[7]) {
+ /*
+ * Straight line.
+ */
+
+ Tcl_AppendPrintfToObj(psObj, "%.15g %.15g lineto\n",
+ control[6], Tk_CanvasPsY(canvas, control[7]));
+ } else {
+ /*
+ * Bezier curve segment.
+ */
+
+ Tcl_AppendPrintfToObj(psObj,
+ "%.15g %.15g %.15g %.15g %.15g %.15g curveto\n",
+ control[2], Tk_CanvasPsY(canvas, control[3]),
+ control[4], Tk_CanvasPsY(canvas, control[5]),
+ control[6], Tk_CanvasPsY(canvas, control[7]));
+ }
+ }
+
+ Tcl_AppendObjToObj(Tcl_GetObjResult(interp), psObj);
+ Tcl_DecrRefCount(psObj);
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * TkGetMiterPoints --
+ *
+ * Given three points forming an angle, compute the coordinates of the
+ * inside and outside points of the mitered corner formed by a line of a
+ * given width at that angle.
+ *
+ * Results:
+ * If the angle formed by the three points is less than 11 degrees then 0
+ * is returned and m1 and m2 aren't modified. Otherwise 1 is returned and
+ * the points at m1 and m2 are filled in with the positions of the points
+ * of the mitered corner.
+ *
+ * Side effects:
+ * None.
+ *
+ *--------------------------------------------------------------
+ */
+
+int
+TkGetMiterPoints(
+ double p1[], /* Points to x- and y-coordinates of point
+ * before vertex. */
+ double p2[], /* Points to x- and y-coordinates of vertex
+ * for mitered joint. */
+ double p3[], /* Points to x- and y-coordinates of point
+ * after vertex. */
+ double width, /* Width of line. */
+ double m1[], /* Points to place to put "left" vertex point
+ * (see as you face from p1 to p2). */
+ double m2[]) /* Points to place to put "right" vertex
+ * point. */
+{
+ double theta1; /* Angle of segment p2-p1. */
+ double theta2; /* Angle of segment p2-p3. */
+ double theta; /* Angle between line segments (angle of
+ * joint). */
+ double theta3; /* Angle that bisects theta1 and theta2 and
+ * points to m1. */
+ double dist; /* Distance of miter points from p2. */
+ double deltaX, deltaY; /* X and y offsets cooresponding to dist
+ * (fudge factors for bounding box). */
+ double p1x, p1y, p2x, p2y, p3x, p3y;
+#ifndef _MSC_VER
+ static const double elevenDegrees = (11.0*2.0*PI)/360.0;
+#else /* msvc8 with -fp:strict requires it this way */
+ static const double elevenDegrees = 0.19198621771937624;
+#endif
+
+ /*
+ * Round the coordinates to integers to mimic what happens when the line
+ * segments are displayed; without this code, the bounding box of a
+ * mitered line can be miscomputed greatly.
+ */
+
+ p1x = floor(p1[0]+0.5);
+ p1y = floor(p1[1]+0.5);
+ p2x = floor(p2[0]+0.5);
+ p2y = floor(p2[1]+0.5);
+ p3x = floor(p3[0]+0.5);
+ p3y = floor(p3[1]+0.5);
+
+ if (p2y == p1y) {
+ theta1 = (p2x < p1x) ? 0 : PI;
+ } else if (p2x == p1x) {
+ theta1 = (p2y < p1y) ? PI/2.0 : -PI/2.0;
+ } else {
+ theta1 = atan2(p1y - p2y, p1x - p2x);
+ }
+
+ if (p3y == p2y) {
+ theta2 = (p3x > p2x) ? 0 : PI;
+ } else if (p3x == p2x) {
+ theta2 = (p3y > p2y) ? PI/2.0 : -PI/2.0;
+ } else {
+ theta2 = atan2(p3y - p2y, p3x - p2x);
+ }
+
+ theta = theta1 - theta2;
+ if (theta > PI) {
+ theta -= 2*PI;
+ } else if (theta < -PI) {
+ theta += 2*PI;
+ }
+
+ if ((theta < elevenDegrees) && (theta > -elevenDegrees)) {
+ return 0;
+ }
+
+ dist = 0.5*width/sin(0.5*theta);
+ if (dist < 0.0) {
+ dist = -dist;
+ }
+
+ /*
+ * Compute theta3 (make sure that it points to the left when looking from
+ * p1 to p2).
+ */
+
+ theta3 = (theta1 + theta2)/2.0;
+ if (sin(theta3 - (theta1 + PI)) < 0.0) {
+ theta3 += PI;
+ }
+ deltaX = dist*cos(theta3);
+ m1[0] = p2x + deltaX;
+ m2[0] = p2x - deltaX;
+ deltaY = dist*sin(theta3);
+ m1[1] = p2y + deltaY;
+ m2[1] = p2y - deltaY;
+
+ return 1;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * TkGetButtPoints --
+ *
+ * Given two points forming a line segment, compute the coordinates of
+ * two endpoints of a rectangle formed by bloating the line segment until
+ * it is width units wide.
+ *
+ * Results:
+ * There is no return value. M1 and m2 are filled in to correspond to m1
+ * and m2 in the diagram below:
+ *
+ * ----------------* m1
+ * |
+ * p1 *---------------* p2
+ * |
+ * ----------------* m2
+ *
+ * M1 and m2 will be W units apart, with p2 centered between them and
+ * m1-m2 perpendicular to p1-p2. However, if "project" is true then m1
+ * and m2 will be as follows:
+ *
+ * -------------------* m1
+ * p2 |
+ * p1 *---------------* |
+ * |
+ * -------------------* m2
+ *
+ * In this case p2 will be width/2 units from the segment m1-m2.
+ *
+ * Side effects:
+ * None.
+ *
+ *--------------------------------------------------------------
+ */
+
+void
+TkGetButtPoints(
+ double p1[], /* Points to x- and y-coordinates of point
+ * before vertex. */
+ double p2[], /* Points to x- and y-coordinates of vertex
+ * for mitered joint. */
+ double width, /* Width of line. */
+ int project, /* Non-zero means project p2 by an additional
+ * width/2 before computing m1 and m2. */
+ double m1[], /* Points to place to put "left" result point,
+ * as you face from p1 to p2. */
+ double m2[]) /* Points to place to put "right" result
+ * point. */
+{
+ double length; /* Length of p1-p2 segment. */
+ double deltaX, deltaY; /* Increments in coords. */
+
+ width *= 0.5;
+ length = hypot(p2[0] - p1[0], p2[1] - p1[1]);
+ if (length == 0.0) {
+ m1[0] = m2[0] = p2[0];
+ m1[1] = m2[1] = p2[1];
+ } else {
+ deltaX = -width * (p2[1] - p1[1]) / length;
+ deltaY = width * (p2[0] - p1[0]) / length;
+ m1[0] = p2[0] + deltaX;
+ m2[0] = p2[0] - deltaX;
+ m1[1] = p2[1] + deltaY;
+ m2[1] = p2[1] - deltaY;
+ if (project) {
+ m1[0] += deltaY;
+ m2[0] += deltaY;
+ m1[1] -= deltaX;
+ m2[1] -= deltaX;
+ }
+ }
+}
+
+/*
+ * Local Variables:
+ * mode: c
+ * c-basic-offset: 4
+ * fill-column: 78
+ * End:
+ */
diff --git a/tk8.6/generic/tkUndo.c b/tk8.6/generic/tkUndo.c
new file mode 100644
index 0000000..c66905d
--- /dev/null
+++ b/tk8.6/generic/tkUndo.c
@@ -0,0 +1,736 @@
+/*
+ * tkUndo.c --
+ *
+ * This module provides the implementation of an undo stack.
+ *
+ * Copyright (c) 2002 by Ludwig Callewaert.
+ * Copyright (c) 2003-2004 by Vincent Darley.
+ *
+ * See the file "license.terms" for information on usage and redistribution of
+ * this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ */
+
+#include "tkInt.h"
+#include "tkUndo.h"
+
+static int EvaluateActionList(Tcl_Interp *interp,
+ TkUndoSubAtom *action);
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkUndoPushStack --
+ *
+ * Push elem on the stack identified by stack.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TkUndoPushStack(
+ TkUndoAtom **stack,
+ TkUndoAtom *elem)
+{
+ elem->next = *stack;
+ *stack = elem;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkUndoPopStack --
+ *
+ * Remove and return the top element from the stack identified by stack.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+TkUndoAtom *
+TkUndoPopStack(
+ TkUndoAtom **stack)
+{
+ TkUndoAtom *elem = NULL;
+
+ if (*stack != NULL) {
+ elem = *stack;
+ *stack = elem->next;
+ }
+ return elem;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkUndoInsertSeparator --
+ *
+ * Insert a separator on the stack, indicating a border for an undo/redo
+ * chunk.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TkUndoInsertSeparator(
+ TkUndoAtom **stack)
+{
+ TkUndoAtom *separator;
+
+ if (*stack!=NULL && (*stack)->type!=TK_UNDO_SEPARATOR) {
+ separator = ckalloc(sizeof(TkUndoAtom));
+ separator->type = TK_UNDO_SEPARATOR;
+ TkUndoPushStack(stack,separator);
+ return 1;
+ }
+ return 0;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkUndoClearStack --
+ *
+ * Clear an entire undo or redo stack and destroy all elements in it.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TkUndoClearStack(
+ TkUndoAtom **stack) /* An Undo or Redo stack */
+{
+ TkUndoAtom *elem;
+
+ while ((elem = TkUndoPopStack(stack)) != NULL) {
+ if (elem->type != TK_UNDO_SEPARATOR) {
+ TkUndoSubAtom *sub;
+
+ sub = elem->apply;
+ while (sub != NULL) {
+ TkUndoSubAtom *next = sub->next;
+
+ if (sub->action != NULL) {
+ Tcl_DecrRefCount(sub->action);
+ }
+ ckfree(sub);
+ sub = next;
+ }
+
+ sub = elem->revert;
+ while (sub != NULL) {
+ TkUndoSubAtom *next = sub->next;
+
+ if (sub->action != NULL) {
+ Tcl_DecrRefCount(sub->action);
+ }
+ ckfree(sub);
+ sub = next;
+ }
+ }
+ ckfree(elem);
+ }
+ *stack = NULL;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkUndoPushAction --
+ *
+ * Push a new elem on the stack identified by stack. Action and revert
+ * are given through Tcl_Obj's to which we will retain a reference. (So
+ * they can be passed in with a zero refCount if desired).
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TkUndoPushAction(
+ TkUndoRedoStack *stack, /* An Undo or Redo stack */
+ TkUndoSubAtom *apply,
+ TkUndoSubAtom *revert)
+{
+ TkUndoAtom *atom;
+
+ atom = ckalloc(sizeof(TkUndoAtom));
+ atom->type = TK_UNDO_ACTION;
+ atom->apply = apply;
+ atom->revert = revert;
+
+ TkUndoPushStack(&stack->undoStack, atom);
+ TkUndoClearStack(&stack->redoStack);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkUndoMakeCmdSubAtom --
+ *
+ * Create a new undo/redo step which must later be place into an undo
+ * stack with TkUndoPushAction. This sub-atom, if evaluated, will take
+ * the given command (if non-NULL), find its full Tcl command string, and
+ * then evaluate that command with the list elements of 'actionScript'
+ * appended.
+ *
+ * If 'subAtomList' is non-NULL, the newly created sub-atom is added onto
+ * the end of the linked list of which 'subAtomList' is a part. This
+ * makes it easy to build up a sequence of actions which will be pushed
+ * in one step.
+ *
+ * Note: if the undo stack can persist for longer than the Tcl_Command
+ * provided, the stack will cause crashes when actions are evaluated. In
+ * this case the 'command' argument should not be used. This is the case
+ * with peer text widgets, for example.
+ *
+ * Results:
+ * The newly created subAtom is returned. It must be passed to
+ * TkUndoPushAction otherwise a memory leak will result.
+ *
+ * Side effects:
+ * A refCount is retained on 'actionScript'.
+ *
+ *----------------------------------------------------------------------
+ */
+
+TkUndoSubAtom *
+TkUndoMakeCmdSubAtom(
+ Tcl_Command command, /* Tcl command token for actions, may be NULL
+ * if not needed. */
+ Tcl_Obj *actionScript, /* The script to append to the command to
+ * perform the action (may be NULL if the
+ * command is not-null). */
+ TkUndoSubAtom *subAtomList) /* Add to the end of this list of actions if
+ * non-NULL */
+{
+ TkUndoSubAtom *atom;
+
+ if (command == NULL && actionScript == NULL) {
+ Tcl_Panic("NULL command and actionScript in TkUndoMakeCmdSubAtom");
+ }
+
+ atom = ckalloc(sizeof(TkUndoSubAtom));
+ atom->command = command;
+ atom->funcPtr = NULL;
+ atom->clientData = NULL;
+ atom->next = NULL;
+ atom->action = actionScript;
+ if (atom->action != NULL) {
+ Tcl_IncrRefCount(atom->action);
+ }
+
+ if (subAtomList != NULL) {
+ while (subAtomList->next != NULL) {
+ subAtomList = subAtomList->next;
+ }
+ subAtomList->next = atom;
+ }
+ return atom;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkUndoMakeSubAtom --
+ *
+ * Create a new undo/redo step which must later be place into an undo
+ * stack with TkUndoPushAction. This sub-atom, if evaluated, will take
+ * the given C-funcPtr (which must be non-NULL), and call it with three
+ * arguments: the undo stack's 'interp', the 'clientData' given and the
+ * 'actionScript'. The callback should return a standard Tcl return code
+ * (TCL_OK on success).
+ *
+ * If 'subAtomList' is non-NULL, the newly created sub-atom is added onto
+ * the end of the linked list of which 'subAtomList' is a part. This
+ * makes it easy to build up a sequence of actions which will be pushed
+ * in one step.
+ *
+ * Results:
+ * The newly created subAtom is returned. It must be passed to
+ * TkUndoPushAction otherwise a memory leak will result.
+ *
+ * Side effects:
+ * A refCount is retained on 'actionScript'.
+ *
+ *----------------------------------------------------------------------
+ */
+
+TkUndoSubAtom *
+TkUndoMakeSubAtom(
+ TkUndoProc *funcPtr, /* Callback function to perform the
+ * undo/redo. */
+ ClientData clientData, /* Data to pass to the callback function. */
+ Tcl_Obj *actionScript, /* Additional Tcl data to pass to the callback
+ * function (may be NULL). */
+ TkUndoSubAtom *subAtomList) /* Add to the end of this list of actions if
+ * non-NULL */
+{
+ TkUndoSubAtom *atom;
+
+ if (funcPtr == NULL) {
+ Tcl_Panic("NULL funcPtr in TkUndoMakeSubAtom");
+ }
+
+ atom = ckalloc(sizeof(TkUndoSubAtom));
+ atom->command = NULL;
+ atom->funcPtr = funcPtr;
+ atom->clientData = clientData;
+ atom->next = NULL;
+ atom->action = actionScript;
+ if (atom->action != NULL) {
+ Tcl_IncrRefCount(atom->action);
+ }
+
+ if (subAtomList != NULL) {
+ while (subAtomList->next != NULL) {
+ subAtomList = subAtomList->next;
+ }
+ subAtomList->next = atom;
+ }
+ return atom;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkUndoInitStack --
+ *
+ * Initialize a new undo/redo stack.
+ *
+ * Results:
+ * An Undo/Redo stack pointer.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+TkUndoRedoStack *
+TkUndoInitStack(
+ Tcl_Interp *interp, /* The interpreter */
+ int maxdepth) /* The maximum stack depth */
+{
+ TkUndoRedoStack *stack; /* An Undo/Redo stack */
+
+ stack = ckalloc(sizeof(TkUndoRedoStack));
+ stack->undoStack = NULL;
+ stack->redoStack = NULL;
+ stack->interp = interp;
+ stack->maxdepth = maxdepth;
+ stack->depth = 0;
+ return stack;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkUndoSetMaxDepth --
+ *
+ * Set the maximum depth of stack.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * May delete elements from the stack if the new maximum depth is smaller
+ * than the number of elements previously in the stack.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TkUndoSetMaxDepth(
+ TkUndoRedoStack *stack, /* An Undo/Redo stack */
+ int maxdepth) /* The maximum stack depth */
+{
+ stack->maxdepth = maxdepth;
+
+ if (stack->maxdepth>0 && stack->depth>stack->maxdepth) {
+ TkUndoAtom *elem, *prevelem;
+ int sepNumber = 0;
+
+ /*
+ * Maximum stack depth exceeded. We have to remove the last compound
+ * elements on the stack.
+ */
+
+ elem = stack->undoStack;
+ prevelem = NULL;
+ while ((elem != NULL) && (sepNumber <= stack->maxdepth)) {
+ if (elem->type == TK_UNDO_SEPARATOR) {
+ sepNumber++;
+ }
+ prevelem = elem;
+ elem = elem->next;
+ }
+ CLANG_ASSERT(prevelem);
+ prevelem->next = NULL;
+ while (elem != NULL) {
+ prevelem = elem;
+ if (elem->type != TK_UNDO_SEPARATOR) {
+ TkUndoSubAtom *sub = elem->apply;
+ while (sub != NULL) {
+ TkUndoSubAtom *next = sub->next;
+
+ if (sub->action != NULL) {
+ Tcl_DecrRefCount(sub->action);
+ }
+ ckfree(sub);
+ sub = next;
+ }
+ sub = elem->revert;
+ while (sub != NULL) {
+ TkUndoSubAtom *next = sub->next;
+
+ if (sub->action != NULL) {
+ Tcl_DecrRefCount(sub->action);
+ }
+ ckfree(sub);
+ sub = next;
+ }
+ }
+ elem = elem->next;
+ ckfree(prevelem);
+ }
+ stack->depth = stack->maxdepth;
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkUndoClearStacks --
+ *
+ * Clear both the undo and redo stack.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TkUndoClearStacks(
+ TkUndoRedoStack *stack) /* An Undo/Redo stack */
+{
+ TkUndoClearStack(&stack->undoStack);
+ TkUndoClearStack(&stack->redoStack);
+ stack->depth = 0;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkUndoFreeStack
+ *
+ * Clear both the undo and redo stack and free the memory allocated to
+ * the u/r stack pointer.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TkUndoFreeStack(
+ TkUndoRedoStack *stack) /* An Undo/Redo stack */
+{
+ TkUndoClearStacks(stack);
+ ckfree(stack);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkUndoCanRedo --
+ *
+ * Returns true if redo is possible, i.e. if the redo stack is not empty.
+ *
+ * Results:
+ * A boolean.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TkUndoCanRedo(
+ TkUndoRedoStack *stack) /* An Undo/Redo stack */
+{
+ return stack->redoStack != NULL;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkUndoCanUndo --
+ *
+ * Returns true if undo is possible, i.e. if the undo stack is not empty.
+ *
+ * Results:
+ * A boolean.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TkUndoCanUndo(
+ TkUndoRedoStack *stack) /* An Undo/Redo stack */
+{
+ return stack->undoStack != NULL;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkUndoInsertUndoSeparator --
+ *
+ * Insert a separator on the undo stack, indicating a border for an
+ * undo/redo chunk.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TkUndoInsertUndoSeparator(
+ TkUndoRedoStack *stack)
+{
+ if (TkUndoInsertSeparator(&stack->undoStack)) {
+ stack->depth++;
+ TkUndoSetMaxDepth(stack, stack->maxdepth);
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkUndoRevert --
+ *
+ * Undo a compound action on the stack.
+ *
+ * Results:
+ * A Tcl status code
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TkUndoRevert(
+ TkUndoRedoStack *stack)
+{
+ TkUndoAtom *elem;
+
+ /*
+ * Insert a separator on the undo and the redo stack.
+ */
+
+ TkUndoInsertUndoSeparator(stack);
+ TkUndoInsertSeparator(&stack->redoStack);
+
+ /*
+ * Pop and skip the first separator if there is one.
+ */
+
+ elem = TkUndoPopStack(&stack->undoStack);
+ if (elem == NULL) {
+ return TCL_ERROR;
+ }
+
+ if (elem->type == TK_UNDO_SEPARATOR) {
+ ckfree(elem);
+ elem = TkUndoPopStack(&stack->undoStack);
+ }
+
+ while (elem != NULL && elem->type != TK_UNDO_SEPARATOR) {
+ /*
+ * Note that we currently ignore errors thrown here.
+ */
+
+ EvaluateActionList(stack->interp, elem->revert);
+
+ TkUndoPushStack(&stack->redoStack, elem);
+ elem = TkUndoPopStack(&stack->undoStack);
+ }
+
+ /*
+ * Insert a separator on the redo stack.
+ */
+
+ TkUndoInsertSeparator(&stack->redoStack);
+ stack->depth--;
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkUndoApply --
+ *
+ * Redo a compound action on the stack.
+ *
+ * Results:
+ * A Tcl status code
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TkUndoApply(
+ TkUndoRedoStack *stack)
+{
+ TkUndoAtom *elem;
+
+ /*
+ * Insert a separator on the undo stack.
+ */
+
+ TkUndoInsertSeparator(&stack->undoStack);
+
+ /*
+ * Pop and skip the first separator if there is one.
+ */
+
+ elem = TkUndoPopStack(&stack->redoStack);
+ if (elem == NULL) {
+ return TCL_ERROR;
+ }
+
+ if (elem->type == TK_UNDO_SEPARATOR) {
+ ckfree(elem);
+ elem = TkUndoPopStack(&stack->redoStack);
+ }
+
+ while (elem != NULL && elem->type != TK_UNDO_SEPARATOR) {
+ /*
+ * Note that we currently ignore errors thrown here.
+ */
+
+ EvaluateActionList(stack->interp, elem->apply);
+
+ TkUndoPushStack(&stack->undoStack, elem);
+ elem = TkUndoPopStack(&stack->redoStack);
+ }
+
+ /*
+ * Insert a separator on the undo stack.
+ */
+
+ TkUndoInsertSeparator(&stack->undoStack);
+ stack->depth++;
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * EvaluateActionList --
+ *
+ * Execute a linked list of undo/redo sub-atoms. If any sub-atom returns
+ * a non TCL_OK value, execution of subsequent sub-atoms is cancelled and
+ * the error returned immediately.
+ *
+ * Results:
+ * A Tcl status code
+ *
+ * Side effects:
+ * The undo/redo subAtoms can perform arbitrary actions.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+EvaluateActionList(
+ Tcl_Interp *interp, /* Interpreter to evaluate the action in. */
+ TkUndoSubAtom *action) /* Head of linked list of action steps to
+ * perform. */
+{
+ int result = TCL_OK;
+
+ while (action != NULL) {
+ if (action->funcPtr != NULL) {
+ result = action->funcPtr(interp, action->clientData,
+ action->action);
+ } else if (action->command != NULL) {
+ Tcl_Obj *cmdNameObj, *evalObj;
+
+ cmdNameObj = Tcl_NewObj();
+ evalObj = Tcl_NewObj();
+ Tcl_IncrRefCount(evalObj);
+ Tcl_GetCommandFullName(interp, action->command, cmdNameObj);
+ Tcl_ListObjAppendElement(NULL, evalObj, cmdNameObj);
+ if (action->action != NULL) {
+ Tcl_ListObjAppendList(NULL, evalObj, action->action);
+ }
+ result = Tcl_EvalObjEx(interp, evalObj, TCL_EVAL_GLOBAL);
+ Tcl_DecrRefCount(evalObj);
+ } else {
+ result = Tcl_EvalObjEx(interp, action->action, TCL_EVAL_GLOBAL);
+ }
+ if (result != TCL_OK) {
+ return result;
+ }
+ action = action->next;
+ }
+ return result;
+}
+
+/*
+ * Local Variables:
+ * mode: c
+ * c-basic-offset: 4
+ * fill-column: 78
+ * End:
+ */
diff --git a/tk8.6/generic/tkUndo.h b/tk8.6/generic/tkUndo.h
new file mode 100644
index 0000000..490ede9
--- /dev/null
+++ b/tk8.6/generic/tkUndo.h
@@ -0,0 +1,115 @@
+/*
+ * tkUndo.h --
+ *
+ * Declarations shared among the files that implement an undo stack.
+ *
+ * Copyright (c) 2002 Ludwig Callewaert.
+ *
+ * See the file "license.terms" for information on usage and redistribution of
+ * this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ */
+
+#ifndef _TKUNDO
+#define _TKUNDO
+
+#ifndef _TKINT
+#include "tkInt.h"
+#endif
+
+/*
+ * Enum defining the types used in an undo stack.
+ */
+
+typedef enum {
+ TK_UNDO_SEPARATOR, /* Marker */
+ TK_UNDO_ACTION /* Command */
+} TkUndoAtomType;
+
+/*
+ * Callback proc type to carry out an undo or redo action via C code. (Actions
+ * can also be defined by Tcl scripts).
+ */
+
+typedef int (TkUndoProc)(Tcl_Interp *interp, ClientData clientData,
+ Tcl_Obj *objPtr);
+
+/*
+ * Struct defining a single action, one or more of which may be defined (and
+ * stored in a linked list) separately for each undo and redo action of an
+ * undo atom.
+ */
+
+typedef struct TkUndoSubAtom {
+ Tcl_Command command; /* Tcl token used to get the current Tcl
+ * command name which will be used to execute
+ * apply/revert scripts. If NULL then it is
+ * assumed the apply/revert scripts already
+ * contain everything. */
+ TkUndoProc *funcPtr; /* Function pointer for callback to perform
+ * undo/redo actions. */
+ ClientData clientData; /* Data for 'funcPtr'. */
+ Tcl_Obj *action; /* Command to apply the action that was
+ * taken. */
+ struct TkUndoSubAtom *next; /* Pointer to the next element in the linked
+ * list. */
+} TkUndoSubAtom;
+
+/*
+ * Struct representing a single undo+redo atom to be placed in the stack.
+ */
+
+typedef struct TkUndoAtom {
+ TkUndoAtomType type; /* The type that will trigger the required
+ * action. */
+ TkUndoSubAtom *apply; /* Linked list of 'apply' actions to perform
+ * for this operation. */
+ TkUndoSubAtom *revert; /* Linked list of 'revert' actions to perform
+ * for this operation. */
+ struct TkUndoAtom *next; /* Pointer to the next element in the
+ * stack. */
+} TkUndoAtom;
+
+/*
+ * Struct defining a single undo+redo stack.
+ */
+
+typedef struct TkUndoRedoStack {
+ TkUndoAtom *undoStack; /* The undo stack. */
+ TkUndoAtom *redoStack; /* The redo stack. */
+ Tcl_Interp *interp; /* The interpreter in which to execute the
+ * revert and apply scripts. */
+ int maxdepth;
+ int depth;
+} TkUndoRedoStack;
+
+/*
+ * Basic functions.
+ */
+
+MODULE_SCOPE void TkUndoPushStack(TkUndoAtom **stack, TkUndoAtom *elem);
+MODULE_SCOPE TkUndoAtom *TkUndoPopStack(TkUndoAtom **stack);
+MODULE_SCOPE int TkUndoInsertSeparator(TkUndoAtom **stack);
+MODULE_SCOPE void TkUndoClearStack(TkUndoAtom **stack);
+
+/*
+ * Functions for working on an undo/redo stack.
+ */
+
+MODULE_SCOPE TkUndoRedoStack *TkUndoInitStack(Tcl_Interp *interp, int maxdepth);
+MODULE_SCOPE void TkUndoSetMaxDepth(TkUndoRedoStack *stack, int maxdepth);
+MODULE_SCOPE void TkUndoClearStacks(TkUndoRedoStack *stack);
+MODULE_SCOPE void TkUndoFreeStack(TkUndoRedoStack *stack);
+MODULE_SCOPE int TkUndoCanRedo(TkUndoRedoStack *stack);
+MODULE_SCOPE int TkUndoCanUndo(TkUndoRedoStack *stack);
+MODULE_SCOPE void TkUndoInsertUndoSeparator(TkUndoRedoStack *stack);
+MODULE_SCOPE TkUndoSubAtom *TkUndoMakeCmdSubAtom(Tcl_Command command,
+ Tcl_Obj *actionScript, TkUndoSubAtom *subAtomList);
+MODULE_SCOPE TkUndoSubAtom *TkUndoMakeSubAtom(TkUndoProc *funcPtr,
+ ClientData clientData, Tcl_Obj *actionScript,
+ TkUndoSubAtom *subAtomList);
+MODULE_SCOPE void TkUndoPushAction(TkUndoRedoStack *stack,
+ TkUndoSubAtom *apply, TkUndoSubAtom *revert);
+MODULE_SCOPE int TkUndoRevert(TkUndoRedoStack *stack);
+MODULE_SCOPE int TkUndoApply(TkUndoRedoStack *stack);
+
+#endif /* _TKUNDO */
diff --git a/tk8.6/generic/tkUtil.c b/tk8.6/generic/tkUtil.c
new file mode 100644
index 0000000..6563165
--- /dev/null
+++ b/tk8.6/generic/tkUtil.c
@@ -0,0 +1,1201 @@
+/*
+ * tkUtil.c --
+ *
+ * This file contains miscellaneous utility functions that are used by
+ * the rest of Tk, such as a function for drawing a focus highlight.
+ *
+ * Copyright (c) 1994 The Regents of the University of California.
+ * Copyright (c) 1994-1997 Sun Microsystems, Inc.
+ *
+ * See the file "license.terms" for information on usage and redistribution of
+ * this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ */
+
+#include "tkInt.h"
+
+/*
+ * The structure below defines the implementation of the "statekey" Tcl
+ * object, used for quickly finding a mapping in a TkStateMap.
+ */
+
+const Tcl_ObjType tkStateKeyObjType = {
+ "statekey", /* name */
+ NULL, /* freeIntRepProc */
+ NULL, /* dupIntRepProc */
+ NULL, /* updateStringProc */
+ NULL /* setFromAnyProc */
+};
+
+/*
+ *--------------------------------------------------------------
+ *
+ * TkStateParseProc --
+ *
+ * This function 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 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 = PTR2INT(clientData);
+ size_t length;
+ Tcl_Obj *msgObj;
+
+ 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;
+ }
+
+ msgObj = Tcl_ObjPrintf("bad %s value \"%s\": must be normal",
+ ((flags & 4) ? "-default" : "state"), value);
+ if (flags & 1) {
+ Tcl_AppendToObj(msgObj, ", active", -1);
+ }
+ if (flags & 2) {
+ Tcl_AppendToObj(msgObj, ", hidden", -1);
+ }
+ if (flags & 3) {
+ Tcl_AppendToObj(msgObj, ",", -1);
+ }
+ Tcl_AppendToObj(msgObj, " or disabled", -1);
+ Tcl_SetObjResult(interp, msgObj);
+ Tcl_SetErrorCode(interp, "TK", "VALUE", "STATE", NULL);
+ *statePtr = TK_STATE_NORMAL;
+ return TCL_ERROR;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * TkStatePrintProc --
+ *
+ * This function 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 function 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.
+ *
+ *--------------------------------------------------------------
+ */
+
+const char *
+TkStatePrintProc(
+ 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);
+
+ switch (*statePtr) {
+ case TK_STATE_NORMAL:
+ return "normal";
+ case TK_STATE_DISABLED:
+ return "disabled";
+ case TK_STATE_HIDDEN:
+ return "hidden";
+ case TK_STATE_ACTIVE:
+ return "active";
+ default:
+ return "";
+ }
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * TkOrientParseProc --
+ *
+ * This function 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 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_SetObjResult(interp, Tcl_ObjPrintf(
+ "bad orientation \"%s\": must be vertical or horizontal",
+ value));
+ Tcl_SetErrorCode(interp, "TK", "VALUE", "ORIENTATION", NULL);
+ *orientPtr = 0;
+ return TCL_ERROR;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * TkOrientPrintProc --
+ *
+ * This function 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 function 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.
+ *
+ *--------------------------------------------------------------
+ */
+
+const char *
+TkOrientPrintProc(
+ 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 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;
+ Tcl_Obj *msgObj;
+
+ 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 (PTR2INT(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;
+ }
+
+ /*
+ * Check for an extra offset.
+ */
+
+ q = strchr(p, ',');
+ if (q == NULL) {
+ if (PTR2INT(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;
+ }
+
+ /*
+ * 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()!!!!
+ */
+
+ goodTSOffset:
+ memcpy(offsetPtr, &tsoffset, sizeof(Tk_TSOffset));
+ return TCL_OK;
+
+ badTSOffset:
+ msgObj = Tcl_ObjPrintf("bad offset \"%s\": expected \"x,y\"", value);
+ if (PTR2INT(clientData) & TK_OFFSET_RELATIVE) {
+ Tcl_AppendToObj(msgObj, ", \"#x,y\"", -1);
+ }
+ if (PTR2INT(clientData) & TK_OFFSET_INDEX) {
+ Tcl_AppendToObj(msgObj, ", <index>", -1);
+ }
+ Tcl_AppendToObj(msgObj, ", n, ne, e, se, s, sw, w, nw, or center", -1);
+ Tcl_SetObjResult(interp, msgObj);
+ Tcl_SetErrorCode(interp, "TK", "VALUE", "OFFSET", NULL);
+ return TCL_ERROR;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkOffsetPrintProc --
+ *
+ * Returns the offset of the tile.
+ *
+ * Results:
+ * The offset of the tile is returned.
+ *
+ *----------------------------------------------------------------------
+ */
+
+const char *
+TkOffsetPrintProc(
+ 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 = 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 = 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 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_SetObjResult(interp, Tcl_ObjPrintf(
+ "bad screen distance \"%s\"", value));
+ Tcl_SetErrorCode(interp, "TK", "VALUE", "PIXELS", NULL);
+ return TCL_ERROR;
+ }
+ return result;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkPixelPrintProc --
+ *
+ * Returns the name of the tile.
+ *
+ * Results:
+ * The name of the tile is returned.
+ *
+ *----------------------------------------------------------------------
+ */
+
+const char *
+TkPixelPrintProc(
+ 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 = ckalloc(24);
+
+ Tcl_PrintDouble(NULL, *doublePtr, p);
+ *freeProcPtr = TCL_DYNAMIC;
+ return p;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkDrawInsetFocusHighlight --
+ *
+ * This function draws a rectangular ring around the outside of a widget
+ * to indicate that it has received the input focus. It takes an
+ * additional padding argument that specifies how much padding is present
+ * outside the widget.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * A rectangle "width" pixels wide is drawn in "drawable", corresponding
+ * to the outer area of "tkwin".
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TkDrawInsetFocusHighlight(
+ Tk_Window tkwin, /* Window whose focus highlight ring is to be
+ * drawn. */
+ GC gc, /* Graphics context to use for drawing the
+ * highlight ring. */
+ int width, /* Width of the highlight ring, in pixels. */
+ Drawable drawable, /* Where to draw the ring (typically a pixmap
+ * for double buffering). */
+ int padding) /* Width of padding outside of widget. */
+{
+ XRectangle rects[4];
+
+ rects[0].x = padding;
+ rects[0].y = padding;
+ rects[0].width = Tk_Width(tkwin) - (2 * padding);
+ rects[0].height = width;
+ rects[1].x = padding;
+ rects[1].y = Tk_Height(tkwin) - width - padding;
+ rects[1].width = Tk_Width(tkwin) - (2 * padding);
+ rects[1].height = width;
+ rects[2].x = padding;
+ rects[2].y = width + padding;
+ rects[2].width = width;
+ rects[2].height = Tk_Height(tkwin) - 2*width - 2*padding;
+ rects[3].x = Tk_Width(tkwin) - width - padding;
+ rects[3].y = rects[2].y;
+ rects[3].width = width;
+ rects[3].height = rects[2].height;
+ XFillRectangles(Tk_Display(tkwin), drawable, gc, rects, 4);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_DrawFocusHighlight --
+ *
+ * This function draws a rectangular ring around the outside of a widget
+ * to indicate that it has received the input focus.
+ *
+ * This function is now deprecated. Use TkpDrawHighlightBorder instead,
+ * since this function does not handle drawing the Focus ring properly on
+ * the Macintosh - you need to know the background GC as well as the
+ * foreground since the Mac focus ring separated from the widget by a 1
+ * pixel border.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * A rectangle "width" pixels wide is drawn in "drawable", corresponding
+ * to the outer area of "tkwin".
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tk_DrawFocusHighlight(
+ Tk_Window tkwin, /* Window whose focus highlight ring is to be
+ * drawn. */
+ GC gc, /* Graphics context to use for drawing the
+ * highlight ring. */
+ int width, /* Width of the highlight ring, in pixels. */
+ Drawable drawable) /* Where to draw the ring (typically a pixmap
+ * for double buffering). */
+{
+ TkDrawInsetFocusHighlight(tkwin, gc, width, drawable, 0);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_GetScrollInfo --
+ *
+ * This function is invoked to parse "xview" and "yview" scrolling
+ * commands for widgets using the new scrolling command syntax ("moveto"
+ * or "scroll" options).
+ *
+ * Results:
+ * The return value is either TK_SCROLL_MOVETO, TK_SCROLL_PAGES,
+ * TK_SCROLL_UNITS, or TK_SCROLL_ERROR. This indicates whether the
+ * command was successfully parsed and what form the command took. If
+ * TK_SCROLL_MOVETO, *dblPtr is filled in with the desired position; if
+ * TK_SCROLL_PAGES or TK_SCROLL_UNITS, *intPtr is filled in with the
+ * number of lines to move (may be negative); if TK_SCROLL_ERROR, the
+ * interp's result contains an error message.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tk_GetScrollInfo(
+ Tcl_Interp *interp, /* Used for error reporting. */
+ int argc, /* # arguments for command. */
+ const char **argv, /* Arguments for command. */
+ double *dblPtr, /* Filled in with argument "moveto" option, if
+ * any. */
+ int *intPtr) /* Filled in with number of pages or lines to
+ * scroll, if any. */
+{
+ int c = argv[2][0];
+ size_t length = strlen(argv[2]);
+
+ if ((c == 'm') && (strncmp(argv[2], "moveto", length) == 0)) {
+ if (argc != 4) {
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "wrong # args: should be \"%s %s %s\"",
+ argv[0], argv[1], "moveto fraction"));
+ Tcl_SetErrorCode(interp, "TCL", "WRONGARGS", NULL);
+ return TK_SCROLL_ERROR;
+ }
+ if (Tcl_GetDouble(interp, argv[3], dblPtr) != TCL_OK) {
+ return TK_SCROLL_ERROR;
+ }
+ return TK_SCROLL_MOVETO;
+ } else if ((c == 's')
+ && (strncmp(argv[2], "scroll", length) == 0)) {
+ if (argc != 5) {
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "wrong # args: should be \"%s %s %s\"",
+ argv[0], argv[1], "scroll number units|pages"));
+ Tcl_SetErrorCode(interp, "TCL", "WRONGARGS", NULL);
+ return TK_SCROLL_ERROR;
+ }
+ if (Tcl_GetInt(interp, argv[3], intPtr) != TCL_OK) {
+ return TK_SCROLL_ERROR;
+ }
+ length = strlen(argv[4]);
+ c = argv[4][0];
+ if ((c == 'p') && (strncmp(argv[4], "pages", length) == 0)) {
+ return TK_SCROLL_PAGES;
+ } else if ((c == 'u') && (strncmp(argv[4], "units", length) == 0)) {
+ return TK_SCROLL_UNITS;
+ }
+
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "bad argument \"%s\": must be units or pages", argv[4]));
+ Tcl_SetErrorCode(interp, "TK", "VALUE", "SCROLL_UNITS", NULL);
+ return TK_SCROLL_ERROR;
+ }
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "unknown option \"%s\": must be moveto or scroll", argv[2]));
+ Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "INDEX", "option", argv[2],
+ NULL);
+ return TK_SCROLL_ERROR;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_GetScrollInfoObj --
+ *
+ * This function 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(
+ 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. */
+{
+ const char *arg = Tcl_GetString(objv[2]);
+ size_t length = objv[2]->length;
+
+#define ArgPfxEq(str) \
+ ((arg[0] == str[0]) && !strncmp(arg, str, (unsigned)length))
+
+ if (ArgPfxEq("moveto")) {
+ 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 (ArgPfxEq("scroll")) {
+ 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;
+ }
+
+ arg = Tcl_GetString(objv[4]);
+ length = objv[4]->length;
+ if (ArgPfxEq("pages")) {
+ return TK_SCROLL_PAGES;
+ } else if (ArgPfxEq("units")) {
+ return TK_SCROLL_UNITS;
+ }
+
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "bad argument \"%s\": must be units or pages", arg));
+ Tcl_SetErrorCode(interp, "TK", "VALUE", "SCROLL_UNITS", NULL);
+ return TK_SCROLL_ERROR;
+ }
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "unknown option \"%s\": must be moveto or scroll", arg));
+ Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "INDEX", "option", arg, NULL);
+ return TK_SCROLL_ERROR;
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * TkComputeAnchor --
+ *
+ * Determine where to place a rectangle so that it will be properly
+ * anchored with respect to the given window. Used by widgets to align a
+ * box of text inside a window. When anchoring with respect to one of the
+ * sides, the rectangle be placed inside of the internal border of the
+ * window.
+ *
+ * Results:
+ * *xPtr and *yPtr set to the upper-left corner of the rectangle anchored
+ * in the window.
+ *
+ * Side effects:
+ * None.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+void
+TkComputeAnchor(
+ Tk_Anchor anchor, /* Desired anchor. */
+ Tk_Window tkwin, /* Anchored with respect to this window. */
+ int padX, int padY, /* Use this extra padding inside window, in
+ * addition to the internal border. */
+ int innerWidth, int innerHeight,
+ /* Size of rectangle to anchor in window. */
+ int *xPtr, int *yPtr) /* Returns upper-left corner of anchored
+ * rectangle. */
+{
+ /*
+ * Handle the horizontal parts.
+ */
+
+ switch (anchor) {
+ case TK_ANCHOR_NW:
+ case TK_ANCHOR_W:
+ case TK_ANCHOR_SW:
+ *xPtr = Tk_InternalBorderLeft(tkwin) + padX;
+ break;
+
+ case TK_ANCHOR_N:
+ case TK_ANCHOR_CENTER:
+ case TK_ANCHOR_S:
+ *xPtr = (Tk_Width(tkwin) - innerWidth - Tk_InternalBorderLeft(tkwin) -
+ Tk_InternalBorderRight(tkwin)) / 2 +
+ Tk_InternalBorderLeft(tkwin);
+ break;
+
+ default:
+ *xPtr = Tk_Width(tkwin) - Tk_InternalBorderRight(tkwin) - padX
+ - innerWidth;
+ break;
+ }
+
+ /*
+ * Handle the vertical parts.
+ */
+
+ switch (anchor) {
+ case TK_ANCHOR_NW:
+ case TK_ANCHOR_N:
+ case TK_ANCHOR_NE:
+ *yPtr = Tk_InternalBorderTop(tkwin) + padY;
+ break;
+
+ case TK_ANCHOR_W:
+ case TK_ANCHOR_CENTER:
+ case TK_ANCHOR_E:
+ *yPtr = (Tk_Height(tkwin) - innerHeight- Tk_InternalBorderTop(tkwin) -
+ Tk_InternalBorderBottom(tkwin)) / 2 +
+ Tk_InternalBorderTop(tkwin);
+ break;
+
+ default:
+ *yPtr = Tk_Height(tkwin) - Tk_InternalBorderBottom(tkwin) - padY
+ - innerHeight;
+ break;
+ }
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * TkFindStateString --
+ *
+ * Given a lookup table, map a number to a string in the table.
+ *
+ * Results:
+ * If numKey was equal to the numeric key of one of the elements in the
+ * table, returns the string key of that element. Returns NULL if numKey
+ * was not equal to any of the numeric keys in the table.
+ *
+ * Side effects.
+ * None.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+const char *
+TkFindStateString(
+ const TkStateMap *mapPtr, /* The state table. */
+ int numKey) /* The key to try to find in the table. */
+{
+ for (; mapPtr->strKey!=NULL ; mapPtr++) {
+ if (numKey == mapPtr->numKey) {
+ return mapPtr->strKey;
+ }
+ }
+ return NULL;
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * TkFindStateNum, TkFindStateNumObj --
+ *
+ * Given a lookup table, map a string to a number in the table.
+ *
+ * Results:
+ * If strKey was equal to the string keys of one of the elements in the
+ * table, returns the numeric key of that element. Returns the numKey
+ * associated with the last element (the NULL string one) in the table if
+ * strKey was not equal to any of the string keys in the table. In that
+ * case, an error message is also left in the interp's result (if interp
+ * is not NULL).
+ *
+ * Side effects.
+ * None.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+int
+TkFindStateNum(
+ Tcl_Interp *interp, /* Interp for error reporting. */
+ const char *option, /* String to use when constructing error. */
+ const TkStateMap *mapPtr, /* Lookup table. */
+ const char *strKey) /* String to try to find in lookup table. */
+{
+ const TkStateMap *mPtr;
+
+ /*
+ * See if the value is in the state map.
+ */
+
+ for (mPtr = mapPtr; mPtr->strKey != NULL; mPtr++) {
+ if (strcmp(strKey, mPtr->strKey) == 0) {
+ return mPtr->numKey;
+ }
+ }
+
+ /*
+ * Not there. Generate an error message (if we can) and return the
+ * default.
+ */
+
+ if (interp != NULL) {
+ Tcl_Obj *msgObj;
+
+ mPtr = mapPtr;
+ msgObj = Tcl_ObjPrintf("bad %s value \"%s\": must be %s",
+ option, strKey, mPtr->strKey);
+ for (mPtr++; mPtr->strKey != NULL; mPtr++) {
+ Tcl_AppendPrintfToObj(msgObj, ",%s %s",
+ ((mPtr[1].strKey != NULL) ? "" : "or "), mPtr->strKey);
+ }
+ Tcl_SetObjResult(interp, msgObj);
+ Tcl_SetErrorCode(interp, "TK", "LOOKUP", option, strKey, NULL);
+ }
+ return mPtr->numKey;
+}
+
+int
+TkFindStateNumObj(
+ 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;
+
+ /*
+ * See if the value is in the object cache.
+ */
+
+ if ((keyPtr->typePtr == &tkStateKeyObjType)
+ && (keyPtr->internalRep.twoPtrValue.ptr1 == mapPtr)) {
+ return PTR2INT(keyPtr->internalRep.twoPtrValue.ptr2);
+ }
+
+ /*
+ * Not there. Look in the state map.
+ */
+
+ key = Tcl_GetString(keyPtr);
+ for (mPtr = mapPtr; mPtr->strKey != NULL; mPtr++) {
+ if (strcmp(key, mPtr->strKey) == 0) {
+ typePtr = keyPtr->typePtr;
+ if ((typePtr != NULL) && (typePtr->freeIntRepProc != NULL)) {
+ typePtr->freeIntRepProc(keyPtr);
+ }
+ keyPtr->internalRep.twoPtrValue.ptr1 = (void *) mapPtr;
+ keyPtr->internalRep.twoPtrValue.ptr2 = INT2PTR(mPtr->numKey);
+ keyPtr->typePtr = &tkStateKeyObjType;
+ return mPtr->numKey;
+ }
+ }
+
+ /*
+ * Not there either. Generate an error message (if we can) and return the
+ * default.
+ */
+
+ if (interp != NULL) {
+ Tcl_Obj *msgObj;
+
+ mPtr = mapPtr;
+ msgObj = Tcl_ObjPrintf(
+ "bad %s value \"%s\": must be %s",
+ Tcl_GetString(optionPtr), key, mPtr->strKey);
+ for (mPtr++; mPtr->strKey != NULL; mPtr++) {
+ Tcl_AppendPrintfToObj(msgObj, ",%s %s",
+ ((mPtr[1].strKey != NULL) ? "" : " or"), mPtr->strKey);
+ }
+ Tcl_SetObjResult(interp, msgObj);
+ Tcl_SetErrorCode(interp, "TK", "LOOKUP", Tcl_GetString(optionPtr),
+ key, NULL);
+ }
+ return mPtr->numKey;
+}
+
+/*
+ * ----------------------------------------------------------------------
+ *
+ * TkBackgroundEvalObjv --
+ *
+ * Evaluate a command while ensuring that we do not affect the
+ * interpreters state. This is important when evaluating script
+ * during background tasks.
+ *
+ * Results:
+ * A standard Tcl result code.
+ *
+ * Side Effects:
+ * The interpreters variables and code may be modified by the script
+ * but the result will not be modified.
+ *
+ * ----------------------------------------------------------------------
+ */
+
+int
+TkBackgroundEvalObjv(
+ Tcl_Interp *interp,
+ int objc,
+ Tcl_Obj *const *objv,
+ int flags)
+{
+ Tcl_InterpState state;
+ int n, r = TCL_OK;
+
+ /*
+ * Record the state of the interpreter.
+ */
+
+ Tcl_Preserve(interp);
+ state = Tcl_SaveInterpState(interp, TCL_OK);
+
+ /*
+ * Evaluate the command and handle any error.
+ */
+
+ for (n = 0; n < objc; ++n) {
+ Tcl_IncrRefCount(objv[n]);
+ }
+ r = Tcl_EvalObjv(interp, objc, objv, flags);
+ for (n = 0; n < objc; ++n) {
+ Tcl_DecrRefCount(objv[n]);
+ }
+ if (r == TCL_ERROR) {
+ Tcl_AddErrorInfo(interp, "\n (background event handler)");
+ Tcl_BackgroundException(interp, r);
+ }
+
+ /*
+ * Restore the state of the interpreter.
+ */
+
+ (void) Tcl_RestoreInterpState(interp, state);
+ Tcl_Release(interp);
+
+ return r;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkMakeEnsemble --
+ *
+ * Create an ensemble from a table of implementation commands. This may
+ * be called recursively to create sub-ensembles.
+ *
+ * Results:
+ * Handle for the ensemble, or NULL if creation of it fails.
+ *
+ *----------------------------------------------------------------------
+ */
+
+Tcl_Command
+TkMakeEnsemble(
+ Tcl_Interp *interp,
+ const char *namespace,
+ const char *name,
+ ClientData clientData,
+ const TkEnsemble map[])
+{
+ Tcl_Namespace *namespacePtr = NULL;
+ Tcl_Command ensemble = NULL;
+ Tcl_Obj *dictObj = NULL, *nameObj;
+ Tcl_DString ds;
+ int i;
+
+ if (map == NULL) {
+ return NULL;
+ }
+
+ Tcl_DStringInit(&ds);
+
+ namespacePtr = Tcl_FindNamespace(interp, namespace, NULL, 0);
+ if (namespacePtr == NULL) {
+ namespacePtr = Tcl_CreateNamespace(interp, namespace, NULL, NULL);
+ if (namespacePtr == NULL) {
+ Tcl_Panic("failed to create namespace \"%s\"", namespace);
+ }
+ }
+
+ nameObj = Tcl_NewStringObj(name, -1);
+ ensemble = Tcl_FindEnsemble(interp, nameObj, 0);
+ Tcl_DecrRefCount(nameObj);
+ if (ensemble == NULL) {
+ ensemble = Tcl_CreateEnsemble(interp, name, namespacePtr,
+ TCL_ENSEMBLE_PREFIX);
+ if (ensemble == NULL) {
+ Tcl_Panic("failed to create ensemble \"%s\"", name);
+ }
+ }
+
+ Tcl_DStringSetLength(&ds, 0);
+ Tcl_DStringAppend(&ds, namespace, -1);
+ if (!(strlen(namespace) == 2 && namespace[1] == ':')) {
+ Tcl_DStringAppend(&ds, "::", -1);
+ }
+ Tcl_DStringAppend(&ds, name, -1);
+
+ dictObj = Tcl_NewObj();
+ for (i = 0; map[i].name != NULL ; ++i) {
+ Tcl_Obj *nameObj, *fqdnObj;
+
+ nameObj = Tcl_NewStringObj(map[i].name, -1);
+ fqdnObj = Tcl_NewStringObj(Tcl_DStringValue(&ds),
+ Tcl_DStringLength(&ds));
+ Tcl_AppendStringsToObj(fqdnObj, "::", map[i].name, NULL);
+ Tcl_DictObjPut(NULL, dictObj, nameObj, fqdnObj);
+ if (map[i].proc) {
+ Tcl_CreateObjCommand(interp, Tcl_GetString(fqdnObj),
+ map[i].proc, clientData, NULL);
+ } else if (map[i].subensemble) {
+ TkMakeEnsemble(interp, Tcl_DStringValue(&ds),
+ map[i].name, clientData, map[i].subensemble);
+ }
+ }
+
+ if (ensemble) {
+ Tcl_SetEnsembleMappingDict(interp, ensemble, dictObj);
+ }
+
+ Tcl_DStringFree(&ds);
+ return ensemble;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkSendVirtualEvent --
+ *
+ * Send a virtual event notification to the specified target window.
+ * Equivalent to:
+ * "event generate $target <<$eventName>> -data $detail"
+ *
+ * Note that we use Tk_QueueWindowEvent, not Tk_HandleEvent, so this
+ * routine does not reenter the interpreter.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TkSendVirtualEvent(
+ Tk_Window target,
+ const char *eventName,
+ Tcl_Obj *detail)
+{
+ union {XEvent general; XVirtualEvent virtual;} event;
+
+ memset(&event, 0, sizeof(event));
+ event.general.xany.type = VirtualEvent;
+ event.general.xany.serial = NextRequest(Tk_Display(target));
+ event.general.xany.send_event = False;
+ event.general.xany.window = Tk_WindowId(target);
+ event.general.xany.display = Tk_Display(target);
+ event.virtual.name = Tk_GetUid(eventName);
+ if (detail != NULL) {
+ event.virtual.user_data = detail;
+ }
+
+ Tk_QueueWindowEvent(&event.general, TCL_QUEUE_TAIL);
+}
+/*
+ * Local Variables:
+ * mode: c
+ * c-basic-offset: 4
+ * fill-column: 78
+ * End:
+ */
diff --git a/tk8.6/generic/tkVisual.c b/tk8.6/generic/tkVisual.c
new file mode 100644
index 0000000..8b0c155
--- /dev/null
+++ b/tk8.6/generic/tkVisual.c
@@ -0,0 +1,549 @@
+/*
+ * tkVisual.c --
+ *
+ * This file contains library procedures for allocating and freeing
+ * visuals and colormaps. This code is based on a prototype
+ * implementation by Paul Mackerras.
+ *
+ * Copyright (c) 1994 The Regents of the University of California.
+ * Copyright (c) 1994-1997 Sun Microsystems, Inc.
+ *
+ * See the file "license.terms" for information on usage and redistribution of
+ * this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ */
+
+#include "tkInt.h"
+
+/*
+ * The table below maps from symbolic names for visual classes to the
+ * associated X class symbols.
+ */
+
+typedef struct VisualDictionary {
+ const char *name; /* Textual name of class. */
+ int minLength; /* Minimum # characters that must be specified
+ * for an unambiguous match. */
+ int class; /* X symbol for class. */
+} VisualDictionary;
+static const VisualDictionary visualNames[] = {
+ {"best", 1, 0},
+ {"directcolor", 2, DirectColor},
+ {"grayscale", 1, GrayScale},
+ {"greyscale", 1, GrayScale},
+ {"pseudocolor", 1, PseudoColor},
+ {"staticcolor", 7, StaticColor},
+ {"staticgray", 7, StaticGray},
+ {"staticgrey", 7, StaticGray},
+ {"truecolor", 1, TrueColor},
+ {NULL, 0, 0},
+};
+
+/*
+ * One of the following structures exists for each distinct non-default
+ * colormap allocated for a display by Tk_GetColormap.
+ */
+
+struct TkColormap {
+ Colormap colormap; /* X's identifier for the colormap. */
+ Visual *visual; /* Visual for which colormap was allocated. */
+ int refCount; /* How many uses of the colormap are still
+ * outstanding (calls to Tk_GetColormap minus
+ * calls to Tk_FreeColormap). */
+ int shareable; /* 0 means this colormap was allocated by a
+ * call to Tk_GetColormap with "new", implying
+ * that the window wants it all for itself. 1
+ * means that the colormap was allocated as a
+ * default for a particular visual, so it can
+ * be shared. */
+ struct TkColormap *nextPtr; /* Next in list of colormaps for this display,
+ * or NULL for end of list. */
+};
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_GetVisual --
+ *
+ * Given a string identifying a particular kind of visual, this procedure
+ * returns a visual and depth that matches the specification.
+ *
+ * Results:
+ * The return value is normally a pointer to a visual. If an error
+ * occurred in looking up the visual, NULL is returned and an error
+ * message is left in the interp's result. The depth of the visual is
+ * returned to *depthPtr under normal returns. If colormapPtr is
+ * non-NULL, then this procedure also finds a suitable colormap for use
+ * with the visual in tkwin, and it returns that colormap in *colormapPtr
+ * unless an error occurs.
+ *
+ * Side effects:
+ * A new colormap may be allocated.
+ *
+ *----------------------------------------------------------------------
+ */
+
+Visual *
+Tk_GetVisual(
+ Tcl_Interp *interp, /* Interpreter to use for error reporting. */
+ Tk_Window tkwin, /* Window in which visual will be used. */
+ const char *string, /* String describing visual. See manual entry
+ * for details. */
+ int *depthPtr, /* The depth of the returned visual is stored
+ * here. */
+ Colormap *colormapPtr) /* If non-NULL, then a suitable colormap for
+ * visual is placed here. This colormap must
+ * eventually be freed by calling
+ * Tk_FreeColormap. */
+{
+ Tk_Window tkwin2;
+ XVisualInfo template, *visInfoList, *bestPtr;
+ long mask;
+ Visual *visual;
+ ptrdiff_t length;
+ int c, numVisuals, prio, bestPrio, i;
+ const char *p;
+ const VisualDictionary *dictPtr;
+ TkColormap *cmapPtr;
+ TkDisplay *dispPtr = ((TkWindow *) tkwin)->dispPtr;
+
+ /*
+ * Parse string and set up a template for use in searching for an
+ * appropriate visual.
+ */
+
+ c = string[0];
+ if (c == '.') {
+ /*
+ * The string must be a window name. If the window is on the same
+ * screen as tkwin, then just use its visual. Otherwise use the
+ * information about the visual as a template for the search.
+ */
+
+ tkwin2 = Tk_NameToWindow(interp, string, tkwin);
+ if (tkwin2 == NULL) {
+ return NULL;
+ }
+ visual = Tk_Visual(tkwin2);
+ if (Tk_Screen(tkwin) == Tk_Screen(tkwin2)) {
+ *depthPtr = Tk_Depth(tkwin2);
+ if (colormapPtr != NULL) {
+ /*
+ * Use the colormap from the other window too (but be sure to
+ * increment its reference count if it's one of the ones
+ * allocated here).
+ */
+
+ *colormapPtr = Tk_Colormap(tkwin2);
+ for (cmapPtr = dispPtr->cmapPtr; cmapPtr != NULL;
+ cmapPtr = cmapPtr->nextPtr) {
+ if (cmapPtr->colormap == *colormapPtr) {
+ cmapPtr->refCount += 1;
+ break;
+ }
+ }
+ }
+ return visual;
+ }
+ template.depth = Tk_Depth(tkwin2);
+ template.class = visual->class;
+ template.red_mask = visual->red_mask;
+ template.green_mask = visual->green_mask;
+ template.blue_mask = visual->blue_mask;
+ template.colormap_size = visual->map_entries;
+ template.bits_per_rgb = visual->bits_per_rgb;
+ mask = VisualDepthMask|VisualClassMask|VisualRedMaskMask
+ |VisualGreenMaskMask|VisualBlueMaskMask|VisualColormapSizeMask
+ |VisualBitsPerRGBMask;
+ } else if ((c == 0) || ((c == 'd') && (string[1] != 0)
+ && (strncmp(string, "default", strlen(string)) == 0))) {
+ /*
+ * Use the default visual for the window's screen.
+ */
+
+ if (colormapPtr != NULL) {
+ *colormapPtr = DefaultColormapOfScreen(Tk_Screen(tkwin));
+ }
+ *depthPtr = DefaultDepthOfScreen(Tk_Screen(tkwin));
+ return DefaultVisualOfScreen(Tk_Screen(tkwin));
+ } else if (isdigit(UCHAR(c))) {
+ int visualId;
+
+ /*
+ * This is a visual ID.
+ */
+
+ if (Tcl_GetInt(interp, string, &visualId) == TCL_ERROR) {
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "bad X identifier for visual: \"%s\"", string));
+ Tcl_SetErrorCode(interp, "TK", "VALUE", "VISUALID", NULL);
+ return NULL;
+ }
+ template.visualid = visualId;
+ mask = VisualIDMask;
+ } else {
+ /*
+ * Parse the string into a class name (or "best") optionally followed
+ * by whitespace and a depth.
+ */
+
+ for (p = string; *p != 0; p++) {
+ if (isspace(UCHAR(*p)) || isdigit(UCHAR(*p))) {
+ break;
+ }
+ }
+ length = p - string;
+ template.class = -1;
+ for (dictPtr = visualNames; dictPtr->name != NULL; dictPtr++) {
+ if ((dictPtr->name[0] == c) && (length >= dictPtr->minLength)
+ && (strncmp(string, dictPtr->name,
+ (size_t) length) == 0)) {
+ template.class = dictPtr->class;
+ break;
+ }
+ }
+ if (template.class == -1) {
+ Tcl_Obj *msgObj = Tcl_ObjPrintf(
+ "unknown or ambiguous visual name \"%s\": class must be ",
+ string);
+
+ for (dictPtr = visualNames; dictPtr->name != NULL; dictPtr++) {
+ Tcl_AppendPrintfToObj(msgObj, "%s, ", dictPtr->name);
+ }
+ Tcl_AppendToObj(msgObj, "or default", -1);
+ Tcl_SetObjResult(interp, msgObj);
+ Tcl_SetErrorCode(interp, "TK", "LOOKUP", "VISUAL", string, NULL);
+ return NULL;
+ }
+ while (isspace(UCHAR(*p))) {
+ p++;
+ }
+ if (*p == 0) {
+ template.depth = 10000;
+ } else if (Tcl_GetInt(interp, p, &template.depth) != TCL_OK) {
+ return NULL;
+ }
+ if (c == 'b') {
+ mask = 0;
+ } else {
+ mask = VisualClassMask;
+ }
+ }
+
+ /*
+ * Find all visuals that match the template we've just created, and return
+ * an error if there are none that match.
+ */
+
+ template.screen = Tk_ScreenNumber(tkwin);
+ mask |= VisualScreenMask;
+ visInfoList = XGetVisualInfo(Tk_Display(tkwin), mask, &template,
+ &numVisuals);
+ if (visInfoList == NULL) {
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "couldn't find an appropriate visual", -1));
+ Tcl_SetErrorCode(interp, "TK", "VISUAL", "INAPPROPRIATE", NULL);
+ return NULL;
+ }
+
+ /*
+ * Search through the visuals that were returned to find the best one.
+ * The choice is based on the following criteria, in decreasing order of
+ * importance:
+ *
+ * 1. Depth: choose a visual with exactly the desired depth, else one with
+ * more bits than requested but as few bits as possible, else one with
+ * fewer bits but as many as possible.
+ * 2. Class: some visual classes are more desirable than others; pick the
+ * visual with the most desirable class.
+ * 3. Default: the default visual for the screen gets preference over
+ * other visuals, all else being equal.
+ */
+
+ bestPrio = 0;
+ bestPtr = NULL;
+ for (i = 0; i < numVisuals; i++) {
+ switch (visInfoList[i].class) {
+ case DirectColor:
+ prio = 5; break;
+ case GrayScale:
+ prio = 1; break;
+ case PseudoColor:
+ prio = 7; break;
+ case StaticColor:
+ prio = 3; break;
+ case StaticGray:
+ prio = 1; break;
+ case TrueColor:
+ prio = 5; break;
+ default:
+ prio = 0; break;
+ }
+ if (visInfoList[i].visual
+ == DefaultVisualOfScreen(Tk_Screen(tkwin))) {
+ prio++;
+ }
+ if (bestPtr == NULL) {
+ goto newBest;
+ }
+ if (visInfoList[i].depth < bestPtr->depth) {
+ if (visInfoList[i].depth >= template.depth) {
+ goto newBest;
+ }
+ } else if (visInfoList[i].depth > bestPtr->depth) {
+ if (bestPtr->depth < template.depth) {
+ goto newBest;
+ }
+ } else {
+ if (prio > bestPrio) {
+ goto newBest;
+ }
+ }
+ continue;
+
+ newBest:
+ bestPtr = &visInfoList[i];
+ bestPrio = prio;
+ }
+ CLANG_ASSERT(bestPtr);
+ *depthPtr = bestPtr->depth;
+ visual = bestPtr->visual;
+ XFree((char *) visInfoList);
+
+ /*
+ * If we need to find a colormap for this visual, do it now. If the visual
+ * is the default visual for the screen, then use the default colormap.
+ * Otherwise search for an existing colormap that's shareable. If all else
+ * fails, create a new colormap.
+ */
+
+ if (colormapPtr != NULL) {
+ if (visual == DefaultVisualOfScreen(Tk_Screen(tkwin))) {
+ *colormapPtr = DefaultColormapOfScreen(Tk_Screen(tkwin));
+ } else {
+ for (cmapPtr = dispPtr->cmapPtr; cmapPtr != NULL;
+ cmapPtr = cmapPtr->nextPtr) {
+ if (cmapPtr->shareable && (cmapPtr->visual == visual)) {
+ *colormapPtr = cmapPtr->colormap;
+ cmapPtr->refCount += 1;
+ goto done;
+ }
+ }
+ cmapPtr = ckalloc(sizeof(TkColormap));
+ cmapPtr->colormap = XCreateColormap(Tk_Display(tkwin),
+ RootWindowOfScreen(Tk_Screen(tkwin)), visual,
+ AllocNone);
+ cmapPtr->visual = visual;
+ cmapPtr->refCount = 1;
+ cmapPtr->shareable = 1;
+ cmapPtr->nextPtr = dispPtr->cmapPtr;
+ dispPtr->cmapPtr = cmapPtr;
+ *colormapPtr = cmapPtr->colormap;
+ }
+ }
+
+ done:
+ return visual;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_GetColormap --
+ *
+ * Given a string identifying a colormap, this procedure finds an
+ * appropriate colormap.
+ *
+ * Results:
+ * The return value is normally the X resource identifier for the
+ * colormap. If an error occurs, None is returned and an error message is
+ * placed in the interp's result.
+ *
+ * Side effects:
+ * A reference count is incremented for the colormap, so Tk_FreeColormap
+ * must eventually be called exactly once for each call to
+ * Tk_GetColormap.
+ *
+ *----------------------------------------------------------------------
+ */
+
+Colormap
+Tk_GetColormap(
+ Tcl_Interp *interp, /* Interpreter to use for error reporting. */
+ Tk_Window tkwin, /* Window where colormap will be used. */
+ const char *string) /* String that identifies colormap: either
+ * "new" or the name of another window. */
+{
+ Colormap colormap;
+ TkColormap *cmapPtr;
+ TkDisplay *dispPtr = ((TkWindow *) tkwin)->dispPtr;
+ Tk_Window other;
+
+ /*
+ * Allocate a new colormap, if that's what is wanted.
+ */
+
+ if (strcmp(string, "new") == 0) {
+ cmapPtr = ckalloc(sizeof(TkColormap));
+ cmapPtr->colormap = XCreateColormap(Tk_Display(tkwin),
+ RootWindowOfScreen(Tk_Screen(tkwin)), Tk_Visual(tkwin),
+ AllocNone);
+ cmapPtr->visual = Tk_Visual(tkwin);
+ cmapPtr->refCount = 1;
+ cmapPtr->shareable = 0;
+ cmapPtr->nextPtr = dispPtr->cmapPtr;
+ dispPtr->cmapPtr = cmapPtr;
+ return cmapPtr->colormap;
+ }
+
+ /*
+ * Use a colormap from an existing window. It must have the same visual as
+ * tkwin (which means, among other things, that the other window must be
+ * on the same screen).
+ */
+
+ other = Tk_NameToWindow(interp, string, tkwin);
+ if (other == NULL) {
+ return None;
+ }
+ if (Tk_Screen(other) != Tk_Screen(tkwin)) {
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "can't use colormap for %s: not on same screen", string));
+ Tcl_SetErrorCode(interp, "TK", "COLORMAP", "SCREEN", NULL);
+ return None;
+ }
+ if (Tk_Visual(other) != Tk_Visual(tkwin)) {
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "can't use colormap for %s: incompatible visuals", string));
+ Tcl_SetErrorCode(interp, "TK", "COLORMAP", "INCOMPATIBLE", NULL);
+ return None;
+ }
+ colormap = Tk_Colormap(other);
+
+ /*
+ * If the colormap was a special one allocated by code in this file,
+ * increment its reference count.
+ */
+
+ for (cmapPtr = dispPtr->cmapPtr; cmapPtr != NULL;
+ cmapPtr = cmapPtr->nextPtr) {
+ if (cmapPtr->colormap == colormap) {
+ cmapPtr->refCount += 1;
+ }
+ }
+ return colormap;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_FreeColormap --
+ *
+ * This procedure is called to release a colormap that was previously
+ * allocated by Tk_GetColormap.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The colormap's reference count is decremented. If this was the last
+ * reference to the colormap, then the colormap is freed.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tk_FreeColormap(
+ Display *display, /* Display for which colormap was
+ * allocated. */
+ Colormap colormap) /* Colormap that is no longer needed. Must
+ * have been returned by previous call to
+ * Tk_GetColormap, or preserved by a previous
+ * call to Tk_PreserveColormap. */
+{
+ TkDisplay *dispPtr;
+ TkColormap *cmapPtr, *prevPtr;
+
+ /*
+ * Find Tk's information about the display, then see if this colormap is a
+ * non-default one (if it's a default one, there won't be an entry for it
+ * in the display's list).
+ */
+
+ dispPtr = TkGetDisplay(display);
+ if (dispPtr == NULL) {
+ Tcl_Panic("unknown display passed to Tk_FreeColormap");
+ }
+ for (prevPtr = NULL, cmapPtr = dispPtr->cmapPtr; cmapPtr != NULL;
+ prevPtr = cmapPtr, cmapPtr = cmapPtr->nextPtr) {
+ if (cmapPtr->colormap == colormap) {
+ cmapPtr->refCount -= 1;
+ if (cmapPtr->refCount == 0) {
+ XFreeColormap(display, colormap);
+ if (prevPtr == NULL) {
+ dispPtr->cmapPtr = cmapPtr->nextPtr;
+ } else {
+ prevPtr->nextPtr = cmapPtr->nextPtr;
+ }
+ ckfree(cmapPtr);
+ }
+ return;
+ }
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_PreserveColormap --
+ *
+ * This procedure is called to indicate to Tk that the specified colormap
+ * is being referenced from another location and should not be freed
+ * until all extra references are eliminated. The colormap must have been
+ * returned by Tk_GetColormap.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The colormap's reference count is incremented, so Tk_FreeColormap must
+ * eventually be called exactly once for each call to
+ * Tk_PreserveColormap.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tk_PreserveColormap(
+ Display *display, /* Display for which colormap was
+ * allocated. */
+ Colormap colormap) /* Colormap that should be preserved. */
+{
+ TkDisplay *dispPtr;
+ TkColormap *cmapPtr;
+
+ /*
+ * Find Tk's information about the display, then see if this colormap is a
+ * non-default one (if it's a default one, there won't be an entry for it
+ * in the display's list).
+ */
+
+ dispPtr = TkGetDisplay(display);
+ if (dispPtr == NULL) {
+ Tcl_Panic("unknown display passed to Tk_PreserveColormap");
+ }
+ for (cmapPtr = dispPtr->cmapPtr; cmapPtr != NULL;
+ cmapPtr = cmapPtr->nextPtr) {
+ if (cmapPtr->colormap == colormap) {
+ cmapPtr->refCount += 1;
+ return;
+ }
+ }
+}
+
+/*
+ * Local Variables:
+ * mode: c
+ * c-basic-offset: 4
+ * fill-column: 78
+ * End:
+ */
diff --git a/tk8.6/generic/tkWindow.c b/tk8.6/generic/tkWindow.c
new file mode 100644
index 0000000..0c60321
--- /dev/null
+++ b/tk8.6/generic/tkWindow.c
@@ -0,0 +1,3395 @@
+/*
+ * tkWindow.c --
+ *
+ * This file provides basic window-manipulation functions, which are
+ * equivalent to functions in Xlib (and even invoke them) but also
+ * maintain the local Tk_Window structure.
+ *
+ * Copyright (c) 1989-1994 The Regents of the University of California.
+ * Copyright (c) 1994-1997 Sun Microsystems, Inc.
+ *
+ * See the file "license.terms" for information on usage and redistribution of
+ * this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ */
+
+#include "tkInt.h"
+
+#ifdef _WIN32
+#include "tkWinInt.h"
+#elif !defined(MAC_OSX_TK)
+#include "tkUnixInt.h"
+#endif
+
+/*
+ * Type used to keep track of Window objects that were only partially
+ * deallocated by Tk_DestroyWindow.
+ */
+
+#define HD_CLEANUP 1
+#define HD_FOCUS 2
+#define HD_MAIN_WIN 4
+#define HD_DESTROY_COUNT 8
+#define HD_DESTROY_EVENT 0x10
+
+typedef struct TkHalfdeadWindow {
+ int flags;
+ struct TkWindow *winPtr;
+ struct TkHalfdeadWindow *nextPtr;
+} TkHalfdeadWindow;
+
+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. */
+ TkHalfdeadWindow *halfdeadWindowList;
+ /* First in list of partially deallocated
+ * windows. */
+ 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;
+
+/*
+ * Default values for "changes" and "atts" fields of TkWindows. Note that Tk
+ * always requests all events for all windows, except StructureNotify events
+ * on internal windows: these events are generated internally.
+ */
+
+static const XWindowChanges defChanges = {
+ 0, 0, 1, 1, 0, 0, Above
+};
+#define ALL_EVENTS_MASK \
+ KeyPressMask|KeyReleaseMask|ButtonPressMask|ButtonReleaseMask| \
+ EnterWindowMask|LeaveWindowMask|PointerMotionMask|ExposureMask| \
+ VisibilityChangeMask|PropertyChangeMask|ColormapChangeMask
+static const XSetWindowAttributes defAtts= {
+ None, /* background_pixmap */
+ 0, /* background_pixel */
+ CopyFromParent, /* border_pixmap */
+ 0, /* border_pixel */
+ NorthWestGravity, /* bit_gravity */
+ NorthWestGravity, /* win_gravity */
+ NotUseful, /* backing_store */
+ (unsigned) ~0, /* backing_planes */
+ 0, /* backing_pixel */
+ False, /* save_under */
+ ALL_EVENTS_MASK, /* event_mask */
+ 0, /* do_not_propagate_mask */
+ False, /* override_redirect */
+ CopyFromParent, /* colormap */
+ None /* cursor */
+};
+
+/*
+ * The following structure defines all of the commands supported by Tk, and
+ * the C functions that execute them.
+ */
+
+#define ISSAFE 1
+#define PASSMAINWINDOW 2
+#define WINMACONLY 4
+#define USEINITPROC 8
+
+typedef int (TkInitProc)(Tcl_Interp *interp, ClientData clientData);
+typedef struct {
+ const char *name; /* Name of command. */
+ Tcl_ObjCmdProc *objProc; /* Command's object- (or string-) based
+ * function, or initProc. */
+ int flags;
+} TkCmd;
+
+static const TkCmd commands[] = {
+ /*
+ * Commands that are part of the intrinsics:
+ */
+
+ {"bell", Tk_BellObjCmd, PASSMAINWINDOW},
+ {"bind", Tk_BindObjCmd, PASSMAINWINDOW|ISSAFE},
+ {"bindtags", Tk_BindtagsObjCmd, PASSMAINWINDOW|ISSAFE},
+ {"clipboard", Tk_ClipboardObjCmd, PASSMAINWINDOW},
+ {"destroy", Tk_DestroyObjCmd, PASSMAINWINDOW|ISSAFE},
+ {"event", Tk_EventObjCmd, PASSMAINWINDOW|ISSAFE},
+ {"focus", Tk_FocusObjCmd, PASSMAINWINDOW|ISSAFE},
+ {"font", Tk_FontObjCmd, PASSMAINWINDOW|ISSAFE},
+ {"grab", Tk_GrabObjCmd, PASSMAINWINDOW},
+ {"grid", Tk_GridObjCmd, PASSMAINWINDOW|ISSAFE},
+ {"image", Tk_ImageObjCmd, PASSMAINWINDOW|ISSAFE},
+ {"lower", Tk_LowerObjCmd, PASSMAINWINDOW|ISSAFE},
+ {"option", Tk_OptionObjCmd, PASSMAINWINDOW|ISSAFE},
+ {"pack", Tk_PackObjCmd, PASSMAINWINDOW|ISSAFE},
+ {"place", Tk_PlaceObjCmd, PASSMAINWINDOW|ISSAFE},
+ {"raise", Tk_RaiseObjCmd, PASSMAINWINDOW|ISSAFE},
+ {"selection", Tk_SelectionObjCmd, PASSMAINWINDOW},
+ {"tk", (Tcl_ObjCmdProc *) TkInitTkCmd, USEINITPROC|PASSMAINWINDOW|ISSAFE},
+ {"tkwait", Tk_TkwaitObjCmd, PASSMAINWINDOW|ISSAFE},
+ {"update", Tk_UpdateObjCmd, PASSMAINWINDOW|ISSAFE},
+ {"winfo", Tk_WinfoObjCmd, PASSMAINWINDOW|ISSAFE},
+ {"wm", Tk_WmObjCmd, PASSMAINWINDOW},
+
+ /*
+ * Default widget class commands.
+ */
+
+ {"button", Tk_ButtonObjCmd, ISSAFE},
+ {"canvas", Tk_CanvasObjCmd, PASSMAINWINDOW|ISSAFE},
+ {"checkbutton", Tk_CheckbuttonObjCmd, ISSAFE},
+ {"entry", Tk_EntryObjCmd, ISSAFE},
+ {"frame", Tk_FrameObjCmd, ISSAFE},
+ {"label", Tk_LabelObjCmd, ISSAFE},
+ {"labelframe", Tk_LabelframeObjCmd, ISSAFE},
+ {"listbox", Tk_ListboxObjCmd, ISSAFE},
+ {"menu", Tk_MenuObjCmd, PASSMAINWINDOW},
+ {"menubutton", Tk_MenubuttonObjCmd, ISSAFE},
+ {"message", Tk_MessageObjCmd, ISSAFE},
+ {"panedwindow", Tk_PanedWindowObjCmd, ISSAFE},
+ {"radiobutton", Tk_RadiobuttonObjCmd, ISSAFE},
+ {"scale", Tk_ScaleObjCmd, ISSAFE},
+ {"scrollbar", Tk_ScrollbarObjCmd, PASSMAINWINDOW|ISSAFE},
+ {"spinbox", Tk_SpinboxObjCmd, ISSAFE},
+ {"text", Tk_TextObjCmd, PASSMAINWINDOW|ISSAFE},
+ {"toplevel", Tk_ToplevelObjCmd, 0},
+
+ /*
+ * Classic widget class commands.
+ */
+
+ {"::tk::button", Tk_ButtonObjCmd, ISSAFE},
+ {"::tk::canvas", Tk_CanvasObjCmd, PASSMAINWINDOW|ISSAFE},
+ {"::tk::checkbutton",Tk_CheckbuttonObjCmd, ISSAFE},
+ {"::tk::entry", Tk_EntryObjCmd, ISSAFE},
+ {"::tk::frame", Tk_FrameObjCmd, ISSAFE},
+ {"::tk::label", Tk_LabelObjCmd, ISSAFE},
+ {"::tk::labelframe",Tk_LabelframeObjCmd, ISSAFE},
+ {"::tk::listbox", Tk_ListboxObjCmd, ISSAFE},
+ {"::tk::menubutton",Tk_MenubuttonObjCmd, ISSAFE},
+ {"::tk::message", Tk_MessageObjCmd, ISSAFE},
+ {"::tk::panedwindow",Tk_PanedWindowObjCmd, ISSAFE},
+ {"::tk::radiobutton",Tk_RadiobuttonObjCmd, ISSAFE},
+ {"::tk::scale", Tk_ScaleObjCmd, ISSAFE},
+ {"::tk::scrollbar", Tk_ScrollbarObjCmd, PASSMAINWINDOW|ISSAFE},
+ {"::tk::spinbox", Tk_SpinboxObjCmd, ISSAFE},
+ {"::tk::text", Tk_TextObjCmd, PASSMAINWINDOW|ISSAFE},
+ {"::tk::toplevel", Tk_ToplevelObjCmd, 0},
+
+ /*
+ * Standard dialog support. Note that the Unix/X11 platform implements
+ * these commands differently (via the script library).
+ */
+
+#if defined(_WIN32) || defined(MAC_OSX_TK)
+ {"tk_chooseColor", Tk_ChooseColorObjCmd, PASSMAINWINDOW},
+ {"tk_chooseDirectory", Tk_ChooseDirectoryObjCmd,WINMACONLY|PASSMAINWINDOW},
+ {"tk_getOpenFile", Tk_GetOpenFileObjCmd, WINMACONLY|PASSMAINWINDOW},
+ {"tk_getSaveFile", Tk_GetSaveFileObjCmd, WINMACONLY|PASSMAINWINDOW},
+ {"tk_messageBox", Tk_MessageBoxObjCmd, PASSMAINWINDOW},
+#endif
+
+ /*
+ * Misc.
+ */
+
+#ifdef MAC_OSX_TK
+ {"::tk::unsupported::MacWindowStyle",
+ TkUnsupported1ObjCmd, PASSMAINWINDOW|ISSAFE},
+#endif
+ {NULL, NULL, 0}
+};
+
+/*
+ * Forward declarations to functions defined later in this file:
+ */
+
+static Tk_Window CreateTopLevelWindow(Tcl_Interp *interp,
+ Tk_Window parent, const char *name,
+ const char *screenName, unsigned int flags);
+static void DeleteWindowsExitProc(ClientData clientData);
+static TkDisplay * GetScreen(Tcl_Interp *interp, const char *screenName,
+ int *screenPtr);
+static int Initialize(Tcl_Interp *interp);
+static int NameWindow(Tcl_Interp *interp, TkWindow *winPtr,
+ TkWindow *parentPtr, const char *name);
+static void UnlinkWindow(TkWindow *winPtr);
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkCloseDisplay --
+ *
+ * Closing the display can lead to order of deletion problems. We defer
+ * it until exit handling for Mac/Win, but since Unix can use many
+ * displays, try and clean it up as best as possible.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Resources associated with the display will be free. The display may
+ * not be referenced at all after this.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+TkCloseDisplay(
+ TkDisplay *dispPtr)
+{
+ TkClipCleanup(dispPtr);
+
+ if (dispPtr->name != NULL) {
+ ckfree(dispPtr->name);
+ }
+
+ if (dispPtr->atomInit) {
+ Tcl_DeleteHashTable(&dispPtr->nameTable);
+ Tcl_DeleteHashTable(&dispPtr->atomTable);
+ dispPtr->atomInit = 0;
+ }
+
+ if (dispPtr->errorPtr != NULL) {
+ TkErrorHandler *errorPtr;
+
+ for (errorPtr = dispPtr->errorPtr;
+ errorPtr != NULL;
+ errorPtr = dispPtr->errorPtr) {
+ dispPtr->errorPtr = errorPtr->nextPtr;
+ ckfree(errorPtr);
+ }
+ }
+
+ TkGCCleanup(dispPtr);
+
+ TkpCloseDisplay(dispPtr);
+
+ /*
+ * Delete winTable after TkpCloseDisplay since special windows may need
+ * call Tk_DestroyWindow and it checks the winTable.
+ */
+
+ Tcl_DeleteHashTable(&dispPtr->winTable);
+
+ ckfree(dispPtr);
+
+ /*
+ * There is more to clean up, we leave it at this for the time being.
+ */
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * CreateTopLevelWindow --
+ *
+ * Make a new window that will be at top-level (its parent will be the
+ * root window of a screen).
+ *
+ * Results:
+ * The return value is a token for the new window, or NULL if an error
+ * prevented the new window from being created. If NULL is returned, an
+ * error message will be left in the interp's result.
+ *
+ * Side effects:
+ * A new window structure is allocated locally. An X window is NOT
+ * initially created, but will be created the first time the window is
+ * mapped.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static Tk_Window
+CreateTopLevelWindow(
+ Tcl_Interp *interp, /* Interpreter to use for error reporting. */
+ Tk_Window parent, /* Token for logical parent of new window
+ * (used for naming, options, etc.). May be
+ * NULL. */
+ const char *name, /* Name for new window; if parent is non-NULL,
+ * must be unique among parent's children. */
+ const char *screenName, /* Name of screen on which to create window.
+ * NULL means use DISPLAY environment variable
+ * to determine. Empty string means use
+ * parent's screen, or DISPLAY if no
+ * parent. */
+ unsigned int flags) /* Additional flags to set on the window. */
+{
+ register TkWindow *winPtr;
+ register TkDisplay *dispPtr;
+ int screenId;
+ ThreadSpecificData *tsdPtr =
+ Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
+
+ if (!tsdPtr->initialized) {
+ tsdPtr->initialized = 1;
+
+ /*
+ * Create built-in image types.
+ */
+
+ Tk_CreateImageType(&tkBitmapImageType);
+ Tk_CreateImageType(&tkPhotoImageType);
+
+ /*
+ * Create built-in photo image formats.
+ */
+
+ Tk_CreatePhotoImageFormat(&tkImgFmtGIF);
+ Tk_CreatePhotoImageFormat(&tkImgFmtPNG);
+ Tk_CreatePhotoImageFormat(&tkImgFmtPPM);
+ }
+
+ if ((parent != NULL) && (screenName != NULL) && (screenName[0] == '\0')) {
+ dispPtr = ((TkWindow *) parent)->dispPtr;
+ screenId = Tk_ScreenNumber(parent);
+ } else {
+ dispPtr = GetScreen(interp, screenName, &screenId);
+ if (dispPtr == NULL) {
+ return NULL;
+ }
+ }
+
+ winPtr = TkAllocWindow(dispPtr, screenId, (TkWindow *) parent);
+
+ /*
+ * Set the flags specified in the call.
+ */
+
+ winPtr->flags |= flags;
+
+ /*
+ * Force the window to use a border pixel instead of border pixmap. This
+ * is needed for the case where the window doesn't use the default visual.
+ * In this case, the default border is a pixmap inherited from the root
+ * window, which won't work because it will have the wrong visual.
+ */
+
+ winPtr->dirtyAtts |= CWBorderPixel;
+
+ /*
+ * (Need to set the TK_TOP_HIERARCHY flag immediately here; otherwise
+ * Tk_DestroyWindow will core dump if it is called before the flag has
+ * been set.)
+ */
+
+ winPtr->flags |=
+ TK_TOP_HIERARCHY|TK_TOP_LEVEL|TK_HAS_WRAPPER|TK_WIN_MANAGED;
+
+ if (parent != NULL) {
+ if (NameWindow(interp, winPtr, (TkWindow *) parent, name) != TCL_OK) {
+ Tk_DestroyWindow((Tk_Window) winPtr);
+ return NULL;
+ }
+ }
+ TkWmNewWindow(winPtr);
+
+ return (Tk_Window) winPtr;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * GetScreen --
+ *
+ * Given a string name for a display-plus-screen, find the TkDisplay
+ * structure for the display and return the screen number too.
+ *
+ * Results:
+ * The return value is a pointer to information about the display, or
+ * NULL if the display couldn't be opened. In this case, an error message
+ * is left in the interp's result. The location at *screenPtr is
+ * overwritten with the screen number parsed from screenName.
+ *
+ * Side effects:
+ * A new connection is opened to the display if there is no connection
+ * already. A new TkDisplay data structure is also setup, if necessary.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static TkDisplay *
+GetScreen(
+ Tcl_Interp *interp, /* Place to leave error message. */
+ const char *screenName, /* Name for screen. NULL or empty means use
+ * DISPLAY envariable. */
+ int *screenPtr) /* Where to store screen number. */
+{
+ register TkDisplay *dispPtr;
+ const char *p;
+ int screenId;
+ size_t length;
+ ThreadSpecificData *tsdPtr =
+ Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
+
+ /*
+ * Separate the screen number from the rest of the display name.
+ * ScreenName is assumed to have the syntax <display>.<screen> with the
+ * dot and the screen being optional.
+ */
+
+ screenName = TkGetDefaultScreenName(interp, screenName);
+ if (screenName == NULL) {
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "no display name and no $DISPLAY environment variable", -1));
+ Tcl_SetErrorCode(interp, "TK", "NO_DISPLAY", NULL);
+ return NULL;
+ }
+ length = strlen(screenName);
+ screenId = 0;
+ p = screenName+length-1;
+ while (isdigit(UCHAR(*p)) && (p != screenName)) {
+ p--;
+ }
+ if ((*p == '.') && (p[1] != '\0')) {
+ length = p - screenName;
+ screenId = strtoul(p+1, NULL, 10);
+ }
+
+ /*
+ * See if we already have a connection to this display. If not, then open
+ * a new connection.
+ */
+
+ for (dispPtr = tsdPtr->displayList; ; dispPtr = dispPtr->nextPtr) {
+ if (dispPtr == NULL) {
+ /*
+ * The private function zeros out dispPtr when it is created, so
+ * we only need to initialize the non-zero items.
+ */
+
+ dispPtr = TkpOpenDisplay(screenName);
+ if (dispPtr == NULL) {
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "couldn't connect to display \"%s\"", screenName));
+ Tcl_SetErrorCode(interp, "TK", "DISPLAY", "CONNECT", NULL);
+ return NULL;
+ }
+ dispPtr->nextPtr = tsdPtr->displayList; /* TkGetDisplayList(); */
+ tsdPtr->displayList = dispPtr;
+
+ dispPtr->lastEventTime = CurrentTime;
+ dispPtr->bindInfoStale = 1;
+ dispPtr->cursorFont = None;
+ dispPtr->warpWindow = NULL;
+ dispPtr->multipleAtom = None;
+
+ /*
+ * By default we do want to collapse motion events in
+ * Tk_QueueWindowEvent.
+ */
+
+ dispPtr->flags |= TK_DISPLAY_COLLAPSE_MOTION_EVENTS;
+
+ Tcl_InitHashTable(&dispPtr->winTable, TCL_ONE_WORD_KEYS);
+
+ dispPtr->name = ckalloc(length + 1);
+ strncpy(dispPtr->name, screenName, length);
+ dispPtr->name[length] = '\0';
+ break;
+ }
+ if ((strncmp(dispPtr->name, screenName, length) == 0)
+ && (dispPtr->name[length] == '\0')) {
+ break;
+ }
+ }
+ if (screenId >= ScreenCount(dispPtr->display)) {
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "bad screen number \"%d\"", screenId));
+ Tcl_SetErrorCode(interp, "TK", "DISPLAY", "SCREEN_NUMBER", NULL);
+ return NULL;
+ }
+ *screenPtr = screenId;
+ return dispPtr;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkGetDisplay --
+ *
+ * Given an X display, TkGetDisplay returns the TkDisplay structure for
+ * the display.
+ *
+ * Results:
+ * The return value is a pointer to information about the display, or
+ * NULL if the display did not have a TkDisplay structure.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+TkDisplay *
+TkGetDisplay(
+ Display *display) /* X's display pointer */
+{
+ TkDisplay *dispPtr;
+ ThreadSpecificData *tsdPtr =
+ Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
+
+ for (dispPtr = tsdPtr->displayList; dispPtr != NULL;
+ dispPtr = dispPtr->nextPtr) {
+ if (dispPtr->display == display) {
+ break;
+ }
+ }
+ return dispPtr;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * TkGetDisplayList --
+ *
+ * This function 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(void)
+{
+ ThreadSpecificData *tsdPtr =
+ Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
+
+ return tsdPtr->displayList;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * TkGetMainInfoList --
+ *
+ * This function 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(void)
+{
+ ThreadSpecificData *tsdPtr =
+ Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
+
+ return tsdPtr->mainWindowList;
+}
+/*
+ *--------------------------------------------------------------
+ *
+ * TkAllocWindow --
+ *
+ * This function creates and initializes a TkWindow structure.
+ *
+ * Results:
+ * The return value is a pointer to the new window.
+ *
+ * Side effects:
+ * A new window structure is allocated and all its fields are
+ * initialized.
+ *
+ *--------------------------------------------------------------
+ */
+
+TkWindow *
+TkAllocWindow(
+ TkDisplay *dispPtr, /* Display associated with new window. */
+ int screenNum, /* Index of screen for new window. */
+ TkWindow *parentPtr) /* Parent from which this window should
+ * inherit visual information. NULL means use
+ * screen defaults instead of inheriting. */
+{
+ register TkWindow *winPtr = ckalloc(sizeof(TkWindow));
+
+ winPtr->display = dispPtr->display;
+ winPtr->dispPtr = dispPtr;
+ winPtr->screenNum = screenNum;
+ if ((parentPtr != NULL) && (parentPtr->display == winPtr->display)
+ && (parentPtr->screenNum == winPtr->screenNum)) {
+ winPtr->visual = parentPtr->visual;
+ winPtr->depth = parentPtr->depth;
+ } else {
+ winPtr->visual = DefaultVisual(dispPtr->display, screenNum);
+ winPtr->depth = DefaultDepth(dispPtr->display, screenNum);
+ }
+ winPtr->window = None;
+ winPtr->childList = NULL;
+ winPtr->lastChildPtr = NULL;
+ winPtr->parentPtr = NULL;
+ winPtr->nextPtr = NULL;
+ winPtr->mainPtr = NULL;
+ winPtr->pathName = NULL;
+ winPtr->nameUid = NULL;
+ winPtr->classUid = NULL;
+ winPtr->changes = defChanges;
+ winPtr->dirtyChanges = CWX|CWY|CWWidth|CWHeight|CWBorderWidth;
+ winPtr->atts = defAtts;
+ if ((parentPtr != NULL) && (parentPtr->display == winPtr->display)
+ && (parentPtr->screenNum == winPtr->screenNum)) {
+ winPtr->atts.colormap = parentPtr->atts.colormap;
+ } else {
+ winPtr->atts.colormap = DefaultColormap(dispPtr->display, screenNum);
+ }
+ winPtr->dirtyAtts = CWEventMask|CWColormap|CWBitGravity;
+ winPtr->flags = 0;
+ winPtr->handlerList = NULL;
+#ifdef TK_USE_INPUT_METHODS
+ winPtr->inputContext = NULL;
+#endif /* TK_USE_INPUT_METHODS */
+ winPtr->tagPtr = NULL;
+ winPtr->numTags = 0;
+ winPtr->optionLevel = -1;
+ winPtr->selHandlerList = NULL;
+ winPtr->geomMgrPtr = NULL;
+ winPtr->geomData = NULL;
+ winPtr->reqWidth = winPtr->reqHeight = 1;
+ winPtr->internalBorderLeft = 0;
+ winPtr->wmInfoPtr = NULL;
+ winPtr->classProcsPtr = NULL;
+ winPtr->instanceData = NULL;
+ winPtr->privatePtr = NULL;
+ winPtr->internalBorderRight = 0;
+ winPtr->internalBorderTop = 0;
+ winPtr->internalBorderBottom = 0;
+ winPtr->minReqWidth = 0;
+ winPtr->minReqHeight = 0;
+ winPtr->geometryMaster = NULL;
+
+ return winPtr;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * NameWindow --
+ *
+ * This function is invoked to give a window a name and insert the window
+ * into the hierarchy associated with a particular application.
+ *
+ * Results:
+ * A standard Tcl return value.
+ *
+ * Side effects:
+ * See above.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+NameWindow(
+ Tcl_Interp *interp, /* Interpreter to use for error reporting. */
+ register TkWindow *winPtr, /* Window that is to be named and inserted. */
+ TkWindow *parentPtr, /* Pointer to logical parent for winPtr (used
+ * for naming, options, etc.). */
+ const char *name) /* Name for winPtr; must be unique among
+ * parentPtr's children. */
+{
+#define FIXED_SIZE 200
+ char staticSpace[FIXED_SIZE];
+ char *pathName;
+ int isNew;
+ Tcl_HashEntry *hPtr;
+ size_t length1, length2;
+
+ /*
+ * Setup all the stuff except name right away, then do the name stuff
+ * last. This is so that if the name stuff fails, everything else will be
+ * properly initialized (needed to destroy the window cleanly after the
+ * naming failure).
+ */
+
+ winPtr->parentPtr = parentPtr;
+ winPtr->nextPtr = NULL;
+ if (parentPtr->childList == NULL) {
+ parentPtr->childList = winPtr;
+ } else {
+ parentPtr->lastChildPtr->nextPtr = winPtr;
+ }
+ parentPtr->lastChildPtr = winPtr;
+ winPtr->mainPtr = parentPtr->mainPtr;
+ winPtr->mainPtr->refCount++;
+
+ /*
+ * If this is an anonymous window (ie, it has no name), just return OK
+ * now.
+ */
+
+ if (winPtr->flags & TK_ANONYMOUS_WINDOW) {
+ return TCL_OK;
+ }
+
+ /*
+ * Don't permit names that start with an upper-case letter: this will just
+ * cause confusion with class names in the option database.
+ */
+
+ if (isupper(UCHAR(name[0]))) {
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "window name starts with an upper-case letter: \"%s\"",
+ name));
+ Tcl_SetErrorCode(interp, "TK", "VALUE", "WINDOW", "NOTCLASS", NULL);
+ return TCL_ERROR;
+ }
+
+ /*
+ * For non-anonymous windows, set up the window name.
+ */
+
+ winPtr->nameUid = Tk_GetUid(name);
+
+ /*
+ * To permit names of arbitrary length, must be prepared to malloc a
+ * buffer to hold the new path name. To run fast in the common case where
+ * names are short, use a fixed-size buffer on the stack.
+ */
+
+ length1 = strlen(parentPtr->pathName);
+ length2 = strlen(name);
+ if ((length1 + length2 + 2) <= FIXED_SIZE) {
+ pathName = staticSpace;
+ } else {
+ pathName = ckalloc(length1 + length2 + 2);
+ }
+ if (length1 == 1) {
+ pathName[0] = '.';
+ strcpy(pathName+1, name);
+ } else {
+ strcpy(pathName, parentPtr->pathName);
+ pathName[length1] = '.';
+ strcpy(pathName+length1+1, name);
+ }
+ hPtr = Tcl_CreateHashEntry(&parentPtr->mainPtr->nameTable, pathName,
+ &isNew);
+ if (pathName != staticSpace) {
+ ckfree(pathName);
+ }
+ if (!isNew) {
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "window name \"%s\" already exists in parent", name));
+ Tcl_SetErrorCode(interp, "TK", "VALUE", "WINDOW", "EXISTS", NULL);
+ return TCL_ERROR;
+ }
+ Tcl_SetHashValue(hPtr, winPtr);
+ winPtr->pathName = Tcl_GetHashKey(&parentPtr->mainPtr->nameTable, hPtr);
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkCreateMainWindow --
+ *
+ * Make a new main window. A main window is a special kind of top-level
+ * window used as the outermost window in an application.
+ *
+ * Results:
+ * The return value is a token for the new window, or NULL if an error
+ * prevented the new window from being created. If NULL is returned, an
+ * error message will be left in the interp's result.
+ *
+ * Side effects:
+ * A new window structure is allocated locally; "interp" is associated
+ * with the window and registered for "send" commands under "baseName".
+ * BaseName may be extended with an instance number in the form "#2" if
+ * necessary to make it globally unique. Tk-related commands are bound
+ * into interp.
+ *
+ *----------------------------------------------------------------------
+ */
+
+Tk_Window
+TkCreateMainWindow(
+ Tcl_Interp *interp, /* Interpreter to use for error reporting. */
+ const char *screenName, /* Name of screen on which to create window.
+ * Empty or NULL string means use DISPLAY
+ * environment variable. */
+ const char *baseName) /* Base name for application; usually of the
+ * form "prog instance". */
+{
+ Tk_Window tkwin;
+ int dummy, isSafe;
+ Tcl_HashEntry *hPtr;
+ register TkMainInfo *mainPtr;
+ register TkWindow *winPtr;
+ register const TkCmd *cmdPtr;
+ ClientData clientData;
+ ThreadSpecificData *tsdPtr =
+ Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
+
+ /*
+ * Panic if someone updated the TkWindow structure without also updating
+ * the Tk_FakeWin structure (or vice versa).
+ */
+
+ if (sizeof(TkWindow) != sizeof(Tk_FakeWin)) {
+ Tcl_Panic("TkWindow and Tk_FakeWin are not the same size");
+ }
+
+ /*
+ * Create the basic TkWindow structure.
+ */
+
+ tkwin = CreateTopLevelWindow(interp, (Tk_Window) NULL, baseName,
+ screenName, /* flags */ 0);
+ if (tkwin == NULL) {
+ return NULL;
+ }
+
+ /*
+ * Create the TkMainInfo structure for this application, and set up
+ * name-related information for the new window.
+ */
+
+ winPtr = (TkWindow *) tkwin;
+ mainPtr = ckalloc(sizeof(TkMainInfo));
+ mainPtr->winPtr = winPtr;
+ mainPtr->refCount = 1;
+ mainPtr->interp = interp;
+ Tcl_InitHashTable(&mainPtr->nameTable, TCL_STRING_KEYS);
+ mainPtr->deletionEpoch = 0l;
+ TkEventInit();
+ TkBindInit(mainPtr);
+ TkFontPkgInit(mainPtr);
+ TkStylePkgInit(mainPtr);
+ mainPtr->tlFocusPtr = NULL;
+ mainPtr->displayFocusPtr = NULL;
+ mainPtr->optionRootPtr = NULL;
+ Tcl_InitHashTable(&mainPtr->imageTable, TCL_STRING_KEYS);
+ mainPtr->strictMotif = 0;
+ mainPtr->alwaysShowSelection = 0;
+ if (Tcl_LinkVar(interp, "tk_strictMotif", (char *) &mainPtr->strictMotif,
+ TCL_LINK_BOOLEAN) != TCL_OK) {
+ Tcl_ResetResult(interp);
+ }
+ if (Tcl_CreateNamespace(interp, "::tk", NULL, NULL) == NULL) {
+ Tcl_ResetResult(interp);
+ }
+ if (Tcl_LinkVar(interp, "::tk::AlwaysShowSelection",
+ (char *) &mainPtr->alwaysShowSelection,
+ TCL_LINK_BOOLEAN) != TCL_OK) {
+ Tcl_ResetResult(interp);
+ }
+ mainPtr->nextPtr = tsdPtr->mainWindowList;
+ tsdPtr->mainWindowList = mainPtr;
+ winPtr->mainPtr = mainPtr;
+ hPtr = Tcl_CreateHashEntry(&mainPtr->nameTable, ".", &dummy);
+ Tcl_SetHashValue(hPtr, winPtr);
+ winPtr->pathName = Tcl_GetHashKey(&mainPtr->nameTable, hPtr);
+ Tcl_InitHashTable(&mainPtr->busyTable, TCL_ONE_WORD_KEYS);
+
+ /*
+ * We have just created another Tk application; increment the refcount on
+ * the display pointer.
+ */
+
+ winPtr->dispPtr->refCount++;
+
+ /*
+ * Register the interpreter for "send" purposes.
+ */
+
+ winPtr->nameUid = Tk_GetUid(Tk_SetAppName(tkwin, baseName));
+
+ /*
+ * Bind in Tk's commands.
+ */
+
+ isSafe = Tcl_IsSafe(interp);
+ for (cmdPtr = commands; cmdPtr->name != NULL; cmdPtr++) {
+ if (cmdPtr->objProc == NULL) {
+ Tcl_Panic("TkCreateMainWindow: builtin command with NULL string and object procs");
+ }
+
+#if defined(_WIN32) && !defined(STATIC_BUILD)
+ if ((cmdPtr->flags & WINMACONLY) && tclStubsPtr->reserved9) {
+ /*
+ * We are running on Cygwin, so don't use the win32 dialogs.
+ */
+
+ continue;
+ }
+#endif /* _WIN32 && !STATIC_BUILD */
+
+ if (cmdPtr->flags & PASSMAINWINDOW) {
+ clientData = tkwin;
+ } else {
+ clientData = NULL;
+ }
+ if (cmdPtr->flags & USEINITPROC) {
+ ((TkInitProc *) cmdPtr->objProc)(interp, clientData);
+ } else {
+ Tcl_CreateObjCommand(interp, cmdPtr->name, cmdPtr->objProc,
+ clientData, NULL);
+ }
+ if (isSafe && !(cmdPtr->flags & ISSAFE)) {
+ Tcl_HideCommand(interp, cmdPtr->name, cmdPtr->name);
+ }
+ }
+
+ /*
+ * Set variables for the intepreter.
+ */
+
+ Tcl_SetVar2(interp, "tk_patchLevel", NULL, TK_PATCH_LEVEL, TCL_GLOBAL_ONLY);
+ Tcl_SetVar2(interp, "tk_version", NULL, TK_VERSION, TCL_GLOBAL_ONLY);
+
+ tsdPtr->numMainWindows++;
+ return tkwin;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * Tk_CreateWindow --
+ *
+ * Create a new internal or top-level window as a child of an existing
+ * window.
+ *
+ * Results:
+ * The return value is a token for the new window. This is not the same
+ * as X's token for the window. If an error occurred in creating the
+ * window (e.g. no such display or screen), then an error message is left
+ * in the interp's result and NULL is returned.
+ *
+ * Side effects:
+ * A new window structure is allocated locally. An X window is not
+ * initially created, but will be created the first time the window is
+ * mapped.
+ *
+ *--------------------------------------------------------------
+ */
+
+Tk_Window
+Tk_CreateWindow(
+ Tcl_Interp *interp, /* Interpreter to use for error reporting.
+ * the interp's result is assumed to be
+ * initialized by the caller. */
+ Tk_Window parent, /* Token for parent of new window. */
+ const char *name, /* Name for new window. Must be unique among
+ * parent's children. */
+ const char *screenName) /* If NULL, new window will be internal on
+ * same screen as its parent. If non-NULL,
+ * gives name of screen on which to create new
+ * window; window will be a top-level
+ * window. */
+{
+ TkWindow *parentPtr = (TkWindow *) parent;
+
+ if (parentPtr) {
+ if (parentPtr->flags & TK_ALREADY_DEAD) {
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "can't create window: parent has been destroyed", -1));
+ Tcl_SetErrorCode(interp, "TK", "CREATE", "DEAD_PARENT", NULL);
+ return NULL;
+ } else if (parentPtr->flags & TK_CONTAINER) {
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "can't create window: its parent has -container = yes",
+ -1));
+ Tcl_SetErrorCode(interp, "TK", "CREATE", "CONTAINER", NULL);
+ return NULL;
+ } else if (screenName == NULL) {
+ TkWindow *winPtr = TkAllocWindow(parentPtr->dispPtr,
+ parentPtr->screenNum, parentPtr);
+
+ if (NameWindow(interp, winPtr, parentPtr, name) != TCL_OK) {
+ Tk_DestroyWindow((Tk_Window) winPtr);
+ return NULL;
+ }
+ return (Tk_Window) winPtr;
+ }
+ }
+ return CreateTopLevelWindow(interp, parent, name, screenName,
+ /* flags */ 0);
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * Tk_CreateAnonymousWindow --
+ *
+ * Create a new internal or top-level window as a child of an existing
+ * window; this window will be anonymous (unnamed), so it will not be
+ * visible at the Tcl level.
+ *
+ * Results:
+ * The return value is a token for the new window. This is not the same
+ * as X's token for the window. If an error occurred in creating the
+ * window (e.g. no such display or screen), then an error message is left
+ * in the interp's result and NULL is returned.
+ *
+ * Side effects:
+ * A new window structure is allocated locally. An X window is not
+ * initially created, but will be created the first time the window is
+ * mapped.
+ *
+ *--------------------------------------------------------------
+ */
+
+Tk_Window
+Tk_CreateAnonymousWindow(
+ Tcl_Interp *interp, /* Interpreter to use for error reporting.
+ * the interp's result is assumed to be
+ * initialized by the caller. */
+ Tk_Window parent, /* Token for parent of new window. */
+ const char *screenName) /* If NULL, new window will be internal on
+ * same screen as its parent. If non-NULL,
+ * gives name of screen on which to create new
+ * window; window will be a top-level
+ * window. */
+{
+ TkWindow *parentPtr = (TkWindow *) parent;
+
+ if (parentPtr) {
+ if (parentPtr->flags & TK_ALREADY_DEAD) {
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "can't create window: parent has been destroyed", -1));
+ Tcl_SetErrorCode(interp, "TK", "CREATE", "DEAD_PARENT", NULL);
+ return NULL;
+ } else if (parentPtr->flags & TK_CONTAINER) {
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "can't create window: its parent has -container = yes",
+ -1));
+ Tcl_SetErrorCode(interp, "TK", "CREATE", "CONTAINER", NULL);
+ return NULL;
+ } else if (screenName == NULL) {
+ TkWindow *winPtr = TkAllocWindow(parentPtr->dispPtr,
+ parentPtr->screenNum, parentPtr);
+ /*
+ * Add the anonymous window flag now, so that NameWindow will
+ * behave correctly.
+ */
+
+ winPtr->flags |= TK_ANONYMOUS_WINDOW;
+ if (NameWindow(interp, winPtr, parentPtr, NULL) != TCL_OK) {
+ Tk_DestroyWindow((Tk_Window) winPtr);
+ return NULL;
+ }
+ return (Tk_Window) winPtr;
+ }
+ }
+ return CreateTopLevelWindow(interp, parent, NULL, screenName,
+ TK_ANONYMOUS_WINDOW);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_CreateWindowFromPath --
+ *
+ * This function is similar to Tk_CreateWindow except that it uses a path
+ * name to create the window, rather than a parent and a child name.
+ *
+ * Results:
+ * The return value is a token for the new window. This is not the same
+ * as X's token for the window. If an error occurred in creating the
+ * window (e.g. no such display or screen), then an error message is left
+ * in the interp's result and NULL is returned.
+ *
+ * Side effects:
+ * A new window structure is allocated locally. An X window is not
+ * initially created, but will be created the first time the window is
+ * mapped.
+ *
+ *----------------------------------------------------------------------
+ */
+
+Tk_Window
+Tk_CreateWindowFromPath(
+ Tcl_Interp *interp, /* Interpreter to use for error reporting.
+ * the interp's result is assumed to be
+ * initialized by the caller. */
+ Tk_Window tkwin, /* Token for any window in application that is
+ * to contain new window. */
+ const char *pathName, /* Path name for new window within the
+ * application of tkwin. The parent of this
+ * window must already exist, but the window
+ * itself must not exist. */
+ const char *screenName) /* If NULL, new window will be on same screen
+ * as its parent. If non-NULL, gives name of
+ * screen on which to create new window;
+ * window will be a top-level window. */
+{
+#define FIXED_SPACE 5
+ char fixedSpace[FIXED_SPACE+1];
+ char *p;
+ Tk_Window parent;
+ int numChars;
+
+ /*
+ * Strip the parent's name out of pathName (it's everything up to the last
+ * dot). There are two tricky parts: (a) must copy the parent's name
+ * somewhere else to avoid modifying the pathName string (for large names,
+ * space for the copy will have to be malloc'ed); (b) must special-case
+ * the situation where the parent is ".".
+ */
+
+ p = strrchr(pathName, '.');
+ if (p == NULL) {
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "bad window path name \"%s\"", pathName));
+ Tcl_SetErrorCode(interp, "TK", "VALUE", "WINDOW_PATH", NULL);
+ return NULL;
+ }
+ numChars = (int) (p-pathName);
+ if (numChars > FIXED_SPACE) {
+ p = ckalloc(numChars + 1);
+ } else {
+ p = fixedSpace;
+ }
+ if (numChars == 0) {
+ *p = '.';
+ p[1] = '\0';
+ } else {
+ strncpy(p, pathName, (size_t) numChars);
+ p[numChars] = '\0';
+ }
+
+ /*
+ * Find the parent window.
+ */
+
+ parent = Tk_NameToWindow(interp, p, tkwin);
+ if (p != fixedSpace) {
+ ckfree(p);
+ }
+ if (parent == NULL) {
+ return NULL;
+ }
+ if (((TkWindow *) parent)->flags & TK_ALREADY_DEAD) {
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "can't create window: parent has been destroyed", -1));
+ Tcl_SetErrorCode(interp, "TK", "CREATE", "DEAD_PARENT", NULL);
+ return NULL;
+ } else if (((TkWindow *) parent)->flags & TK_CONTAINER) {
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "can't create window: its parent has -container = yes", -1));
+ Tcl_SetErrorCode(interp, "TK", "CREATE", "CONTAINER", NULL);
+ return NULL;
+ }
+
+ /*
+ * Create the window.
+ */
+
+ if (screenName == NULL) {
+ TkWindow *parentPtr = (TkWindow *) parent;
+ TkWindow *winPtr;
+
+ winPtr = TkAllocWindow(parentPtr->dispPtr, parentPtr->screenNum,
+ parentPtr);
+ if (NameWindow(interp, winPtr, parentPtr, pathName+numChars+1)
+ != TCL_OK) {
+ Tk_DestroyWindow((Tk_Window) winPtr);
+ return NULL;
+ }
+ return (Tk_Window) winPtr;
+ }
+
+ return CreateTopLevelWindow(interp, parent, pathName+numChars+1,
+ screenName, /* flags */ 0);
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * Tk_DestroyWindow --
+ *
+ * Destroy an existing window. After this call, the caller should never
+ * again use the token. Note that this function can be reentered to
+ * destroy a window that was only partially destroyed before a call to
+ * exit.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The window is deleted, along with all of its children. Relevant
+ * callback functions are invoked.
+ *
+ *--------------------------------------------------------------
+ */
+
+void
+Tk_DestroyWindow(
+ Tk_Window tkwin) /* Window to destroy. */
+{
+ TkWindow *winPtr = (TkWindow *) tkwin;
+ TkDisplay *dispPtr = winPtr->dispPtr;
+ XEvent event;
+ TkHalfdeadWindow *halfdeadPtr, *prev_halfdeadPtr;
+ ThreadSpecificData *tsdPtr =
+ Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
+
+ if (winPtr->flags & TK_ALREADY_DEAD) {
+ /*
+ * A destroy event binding caused the window to be destroyed again.
+ * Ignore the request.
+ */
+
+ return;
+ }
+ winPtr->flags |= TK_ALREADY_DEAD;
+
+ /*
+ * Unless we are cleaning up a half dead window from
+ * DeleteWindowsExitProc, add this window to the half dead list.
+ */
+
+ if (tsdPtr->halfdeadWindowList &&
+ (tsdPtr->halfdeadWindowList->flags & HD_CLEANUP) &&
+ (tsdPtr->halfdeadWindowList->winPtr == winPtr)) {
+ halfdeadPtr = tsdPtr->halfdeadWindowList;
+ } else {
+ halfdeadPtr = ckalloc(sizeof(TkHalfdeadWindow));
+ halfdeadPtr->flags = 0;
+ halfdeadPtr->winPtr = winPtr;
+ halfdeadPtr->nextPtr = tsdPtr->halfdeadWindowList;
+ tsdPtr->halfdeadWindowList = halfdeadPtr;
+ }
+
+ /*
+ * Some cleanup needs to be done immediately, rather than later, because
+ * it needs information that will be destoyed before we get to the main
+ * cleanup point. For example, TkFocusDeadWindow needs to access the
+ * parentPtr field from a window, but if a Destroy event handler deletes
+ * the window's parent this field will be NULL before the main cleanup
+ * point is reached.
+ */
+
+ if (!(halfdeadPtr->flags & HD_FOCUS)) {
+ halfdeadPtr->flags |= HD_FOCUS;
+ TkFocusDeadWindow(winPtr);
+ }
+
+ /*
+ * If this is a main window, remove it from the list of main windows.
+ * This needs to be done now (rather than later with all the other main
+ * window cleanup) to handle situations where a destroy binding for a
+ * window calls "exit". In this case the child window cleanup isn't
+ * complete when exit is called. This situation is dealt with using the
+ * half dead window list. Windows that are half dead gets cleaned up
+ * during exit.
+ *
+ * Also decrement the display refcount so that if this is the last Tk
+ * application in this process on this display, the display can be closed
+ * and its data structures deleted.
+ */
+
+ if (!(halfdeadPtr->flags & HD_MAIN_WIN) &&
+ winPtr->mainPtr != NULL && winPtr->mainPtr->winPtr == winPtr) {
+ halfdeadPtr->flags |= HD_MAIN_WIN;
+ dispPtr->refCount--;
+ if (tsdPtr->mainWindowList == winPtr->mainPtr) {
+ tsdPtr->mainWindowList = winPtr->mainPtr->nextPtr;
+ } else {
+ TkMainInfo *prevPtr;
+
+ for (prevPtr = tsdPtr->mainWindowList;
+ prevPtr->nextPtr != winPtr->mainPtr;
+ prevPtr = prevPtr->nextPtr) {
+ /* Empty loop body. */
+ }
+ prevPtr->nextPtr = winPtr->mainPtr->nextPtr;
+ }
+ tsdPtr->numMainWindows--;
+ }
+
+ /*
+ * Recursively destroy children. Note that this child window block may
+ * need to be run multiple times in the case where a child window has a
+ * Destroy binding that calls exit.
+ */
+
+ if (!(halfdeadPtr->flags & HD_DESTROY_COUNT)) {
+ halfdeadPtr->flags |= HD_DESTROY_COUNT;
+ }
+
+ while (winPtr->childList != NULL) {
+ TkWindow *childPtr = winPtr->childList;
+
+ childPtr->flags |= TK_DONT_DESTROY_WINDOW;
+ Tk_DestroyWindow((Tk_Window) childPtr);
+ if (winPtr->childList == childPtr) {
+ /*
+ * The child didn't remove itself from the child list, so let's
+ * remove it here. This can happen in some strange conditions,
+ * such as when a Destroy event handler for a window destroys the
+ * window's parent.
+ */
+
+ winPtr->childList = childPtr->nextPtr;
+ childPtr->parentPtr = NULL;
+ }
+ }
+ if ((winPtr->flags & (TK_CONTAINER|TK_BOTH_HALVES))
+ == (TK_CONTAINER|TK_BOTH_HALVES)) {
+ /*
+ * This is the container for an embedded application, and the embedded
+ * application is also in this process. Delete the embedded window
+ * in-line here, for the same reasons we delete children in-line
+ * (otherwise, for example, the Tk window may appear to exist even
+ * though its X window is gone; this could cause errors). Special
+ * note: it's possible that the embedded window has already been
+ * deleted, in which case TkpGetOtherWindow will return NULL.
+ */
+
+ TkWindow *childPtr = TkpGetOtherWindow(winPtr);
+
+ if (childPtr != NULL) {
+ childPtr->flags |= TK_DONT_DESTROY_WINDOW;
+ Tk_DestroyWindow((Tk_Window) childPtr);
+ }
+ }
+
+ /*
+ * Generate a DestroyNotify event. In order for the DestroyNotify event to
+ * be processed correctly, need to make sure the window exists. This is a
+ * bit of a kludge, and may be unnecessarily expensive, but without it no
+ * event handlers will get called for windows that don't exist yet.
+ *
+ * Note: if the window's pathName is NULL and the window is not an
+ * anonymous window, it means that the window was not successfully
+ * initialized in the first place, so we should not make the window exist
+ * or generate the event.
+ */
+
+ if (!(halfdeadPtr->flags & HD_DESTROY_EVENT) &&
+ winPtr->pathName != NULL &&
+ !(winPtr->flags & TK_ANONYMOUS_WINDOW)) {
+ halfdeadPtr->flags |= HD_DESTROY_EVENT;
+ if (winPtr->window == None) {
+ Tk_MakeWindowExist(tkwin);
+ }
+ event.type = DestroyNotify;
+ event.xdestroywindow.serial =
+ LastKnownRequestProcessed(winPtr->display);
+ event.xdestroywindow.send_event = False;
+ event.xdestroywindow.display = winPtr->display;
+ event.xdestroywindow.event = winPtr->window;
+ event.xdestroywindow.window = winPtr->window;
+ Tk_HandleEvent(&event);
+ }
+
+ /*
+ * No additional bindings that could call exit should be invoked from this
+ * point on, so it is safe to remove this window from the half dead list.
+ */
+
+ for (prev_halfdeadPtr = NULL,
+ halfdeadPtr = tsdPtr->halfdeadWindowList;
+ halfdeadPtr != NULL; ) {
+ if (halfdeadPtr->winPtr == winPtr) {
+ if (prev_halfdeadPtr == NULL) {
+ tsdPtr->halfdeadWindowList = halfdeadPtr->nextPtr;
+ } else {
+ prev_halfdeadPtr->nextPtr = halfdeadPtr->nextPtr;
+ }
+ ckfree(halfdeadPtr);
+ break;
+ }
+ prev_halfdeadPtr = halfdeadPtr;
+ halfdeadPtr = halfdeadPtr->nextPtr;
+ }
+ if (halfdeadPtr == NULL) {
+ Tcl_Panic("window not found on half dead list");
+ }
+
+ /*
+ * Cleanup the data structures associated with this window.
+ */
+
+ if (winPtr->flags & TK_WIN_MANAGED) {
+ TkWmDeadWindow(winPtr);
+ } else if (winPtr->flags & TK_WM_COLORMAP_WINDOW) {
+ TkWmRemoveFromColormapWindows(winPtr);
+ }
+ if (winPtr->window != None) {
+#if defined(MAC_OSX_TK) || defined(_WIN32)
+ XDestroyWindow(winPtr->display, winPtr->window);
+#else
+ if ((winPtr->flags & TK_TOP_HIERARCHY)
+ || !(winPtr->flags & TK_DONT_DESTROY_WINDOW)) {
+ /*
+ * The parent has already been destroyed and this isn't a
+ * top-level window, so this window will be destroyed implicitly
+ * when the parent's X window is destroyed; it's much faster not
+ * to do an explicit destroy of this X window.
+ */
+
+ XDestroyWindow(winPtr->display, winPtr->window);
+ }
+#endif
+ Tcl_DeleteHashEntry(Tcl_FindHashEntry(&dispPtr->winTable,
+ (char *) winPtr->window));
+ winPtr->window = None;
+ }
+ UnlinkWindow(winPtr);
+ TkEventDeadWindow(winPtr);
+#ifdef TK_USE_INPUT_METHODS
+ if (winPtr->inputContext != NULL) {
+ XDestroyIC(winPtr->inputContext);
+ winPtr->inputContext = NULL;
+ }
+#endif /* TK_USE_INPUT_METHODS */
+ if (winPtr->tagPtr != NULL) {
+ TkFreeBindingTags(winPtr);
+ }
+ TkOptionDeadWindow(winPtr);
+ TkSelDeadWindow(winPtr);
+ TkGrabDeadWindow(winPtr);
+ if (winPtr->geometryMaster != NULL) {
+ ckfree(winPtr->geometryMaster);
+ winPtr->geometryMaster = NULL;
+ }
+ if (winPtr->mainPtr != NULL) {
+ if (winPtr->pathName != NULL) {
+ Tk_DeleteAllBindings(winPtr->mainPtr->bindingTable,
+ winPtr->pathName);
+ Tcl_DeleteHashEntry(Tcl_FindHashEntry(&winPtr->mainPtr->nameTable,
+ winPtr->pathName));
+
+ /*
+ * The memory pointed to by pathName has been deallocated. Keep
+ * users from accessing it after the window has been destroyed by
+ * setting it to NULL.
+ */
+
+ winPtr->pathName = NULL;
+
+ /*
+ * Invalidate all objects referring to windows with the same main
+ * window.
+ */
+
+ winPtr->mainPtr->deletionEpoch++;
+ }
+ winPtr->mainPtr->refCount--;
+ if (winPtr->mainPtr->refCount == 0) {
+ register const TkCmd *cmdPtr;
+
+ /*
+ * We just deleted the last window in the application. Delete the
+ * TkMainInfo structure too and replace all of Tk's commands with
+ * dummy commands that return errors. Also delete the "send"
+ * command to unregister the interpreter.
+ *
+ * NOTE: Only replace the commands it if the interpreter is not
+ * being deleted. If it *is*, the interpreter cleanup will do all
+ * the needed work.
+ */
+
+ if ((winPtr->mainPtr->interp != NULL) &&
+ !Tcl_InterpDeleted(winPtr->mainPtr->interp)) {
+ for (cmdPtr = commands; cmdPtr->name != NULL; cmdPtr++) {
+ Tcl_CreateObjCommand(winPtr->mainPtr->interp, cmdPtr->name,
+ TkDeadAppObjCmd, NULL, NULL);
+ }
+ Tcl_CreateObjCommand(winPtr->mainPtr->interp, "send",
+ TkDeadAppObjCmd, NULL, NULL);
+ Tcl_UnlinkVar(winPtr->mainPtr->interp, "tk_strictMotif");
+ Tcl_UnlinkVar(winPtr->mainPtr->interp,
+ "::tk::AlwaysShowSelection");
+ }
+
+ Tcl_DeleteHashTable(&winPtr->mainPtr->busyTable);
+ Tcl_DeleteHashTable(&winPtr->mainPtr->nameTable);
+ TkBindFree(winPtr->mainPtr);
+ TkDeleteAllImages(winPtr->mainPtr);
+ TkFontPkgFree(winPtr->mainPtr);
+ TkFocusFree(winPtr->mainPtr);
+ TkStylePkgFree(winPtr->mainPtr);
+
+ /*
+ * When embedding Tk into other applications, make sure that all
+ * destroy events reach the server. Otherwise the embedding
+ * application may also attempt to destroy the windows, resulting
+ * in an X error
+ */
+
+ if (winPtr->flags & TK_EMBEDDED) {
+ XSync(winPtr->display, False);
+ }
+ ckfree(winPtr->mainPtr);
+
+ /*
+ * If no other applications are using the display, close the
+ * display now and relinquish its data structures.
+ */
+
+#if !defined(_WIN32) && defined(NOT_YET)
+ if (dispPtr->refCount <= 0) {
+ /*
+ * I have disabled this code because on Windows there are
+ * still order dependencies in close-down. All displays and
+ * resources will get closed down properly anyway at exit,
+ * through the exit handler. -- jyl
+ *
+ * Ideally this should be enabled, as unix Tk can use multiple
+ * displays. However, there are order issues still, as well as
+ * the handling of queued events and such that must be
+ * addressed before this can be enabled. The current cleanup
+ * works except for send event issues. -- hobbs 04/2002
+ */
+
+ TkDisplay *theDispPtr, *backDispPtr;
+
+ /*
+ * Splice this display out of the list of displays.
+ */
+
+ for (theDispPtr = tsdPtr->displayList, backDispPtr = NULL;
+ (theDispPtr!=winPtr->dispPtr) && (theDispPtr!=NULL);
+ theDispPtr = theDispPtr->nextPtr) {
+ backDispPtr = theDispPtr;
+ }
+ if (theDispPtr == NULL) {
+ Tcl_Panic("could not find display to close!");
+ }
+ if (backDispPtr == NULL) {
+ tsdPtr->displayList = theDispPtr->nextPtr;
+ } else {
+ backDispPtr->nextPtr = theDispPtr->nextPtr;
+ }
+
+ /*
+ * Calling XSync creates X server traffic, but addresses a
+ * focus issue on close (but not the send issue). -- hobbs
+ *
+ * XSync(dispPtr->display, True);
+ */
+
+ /*
+ * Found and spliced it out, now actually do the cleanup.
+ */
+
+ TkCloseDisplay(dispPtr);
+ }
+#endif /* !_WIN32 && NOT_YET */
+ }
+ }
+ Tcl_EventuallyFree(winPtr, TCL_DYNAMIC);
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * Tk_MapWindow --
+ *
+ * Map a window within its parent. This may require the window and/or its
+ * parents to actually be created.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The given window will be mapped. Windows may also be created.
+ *
+ *--------------------------------------------------------------
+ */
+
+void
+Tk_MapWindow(
+ Tk_Window tkwin) /* Token for window to map. */
+{
+ TkWindow *winPtr = (TkWindow *) tkwin;
+ XEvent event;
+
+ if (winPtr->flags & TK_MAPPED) {
+ return;
+ }
+ if (winPtr->window == None) {
+ Tk_MakeWindowExist(tkwin);
+ }
+ /*
+ * [Bug 2645457]: the previous call permits events to be processed and can
+ * lead to the destruction of the window under some conditions.
+ */
+ if (winPtr->flags & TK_ALREADY_DEAD) {
+ return;
+ }
+ if (winPtr->flags & TK_WIN_MANAGED) {
+ /*
+ * Lots of special processing has to be done for top-level windows.
+ * Let tkWm.c handle everything itself.
+ */
+
+ TkWmMapWindow(winPtr);
+ return;
+ }
+ winPtr->flags |= TK_MAPPED;
+ XMapWindow(winPtr->display, winPtr->window);
+ event.type = MapNotify;
+ event.xmap.serial = LastKnownRequestProcessed(winPtr->display);
+ event.xmap.send_event = False;
+ event.xmap.display = winPtr->display;
+ event.xmap.event = winPtr->window;
+ event.xmap.window = winPtr->window;
+ event.xmap.override_redirect = winPtr->atts.override_redirect;
+ Tk_HandleEvent(&event);
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * Tk_MakeWindowExist --
+ *
+ * Ensure that a particular window actually exists. This function should
+ * not normally need to be invoked from outside the Tk package, but may
+ * be needed if someone wants to manipulate a window before mapping it.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * When the function returns, the X window associated with tkwin is
+ * guaranteed to exist. This may require the window's ancestors to be
+ * created also.
+ *
+ *--------------------------------------------------------------
+ */
+
+void
+Tk_MakeWindowExist(
+ Tk_Window tkwin) /* Token for window. */
+{
+ register TkWindow *winPtr = (TkWindow *) tkwin;
+ TkWindow *winPtr2;
+ Window parent;
+ Tcl_HashEntry *hPtr;
+ Tk_ClassCreateProc *createProc;
+ int isNew;
+
+ if (winPtr->window != None) {
+ return;
+ }
+
+ if ((winPtr->parentPtr == NULL) || (winPtr->flags & TK_TOP_HIERARCHY)) {
+ parent = XRootWindow(winPtr->display, winPtr->screenNum);
+ } else {
+ if (winPtr->parentPtr->window == None) {
+ Tk_MakeWindowExist((Tk_Window) winPtr->parentPtr);
+ }
+ parent = winPtr->parentPtr->window;
+ }
+
+ createProc = Tk_GetClassProc(winPtr->classProcsPtr, createProc);
+ if (createProc != NULL && parent != None) {
+ winPtr->window = createProc(tkwin, parent, winPtr->instanceData);
+ } else {
+ winPtr->window = TkpMakeWindow(winPtr, parent);
+ }
+
+ hPtr = Tcl_CreateHashEntry(&winPtr->dispPtr->winTable,
+ (char *) winPtr->window, &isNew);
+ Tcl_SetHashValue(hPtr, winPtr);
+ winPtr->dirtyAtts = 0;
+ winPtr->dirtyChanges = 0;
+
+ if (!(winPtr->flags & TK_TOP_HIERARCHY)) {
+ /*
+ * If any siblings higher up in the stacking order have already been
+ * created then move this window to its rightful position in the
+ * stacking order.
+ *
+ * NOTE: this code ignores any changes anyone might have made to the
+ * sibling and stack_mode field of the window's attributes, so it
+ * really isn't safe for these to be manipulated except by calling
+ * Tk_RestackWindow.
+ */
+
+ for (winPtr2 = winPtr->nextPtr; winPtr2 != NULL;
+ winPtr2 = winPtr2->nextPtr) {
+ if ((winPtr2->window != None)
+ && !(winPtr2->flags & (TK_TOP_HIERARCHY|TK_REPARENTED))) {
+ XWindowChanges changes;
+
+ changes.sibling = winPtr2->window;
+ changes.stack_mode = Below;
+ XConfigureWindow(winPtr->display, winPtr->window,
+ CWSibling|CWStackMode, &changes);
+ break;
+ }
+ }
+
+ /*
+ * If this window has a different colormap than its parent, add the
+ * window to the WM_COLORMAP_WINDOWS property for its top-level.
+ */
+
+ if ((winPtr->parentPtr != NULL) &&
+ (winPtr->atts.colormap != winPtr->parentPtr->atts.colormap)) {
+ TkWmAddToColormapWindows(winPtr);
+ winPtr->flags |= TK_WM_COLORMAP_WINDOW;
+ }
+ }
+
+ /*
+ * Issue a ConfigureNotify event if there were deferred configuration
+ * changes (but skip it if the window is being deleted; the
+ * ConfigureNotify event could cause problems if we're being called from
+ * Tk_DestroyWindow under some conditions).
+ */
+
+ if ((winPtr->flags & TK_NEED_CONFIG_NOTIFY)
+ && !(winPtr->flags & TK_ALREADY_DEAD)) {
+ winPtr->flags &= ~TK_NEED_CONFIG_NOTIFY;
+ TkDoConfigureNotify(winPtr);
+ }
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * Tk_UnmapWindow, etc. --
+ *
+ * There are several functions under here, each of which mirrors an
+ * existing X function. In addition to performing the functions of the
+ * corresponding function, each function also updates the local window
+ * structure and synthesizes an X event (if the window's structure is
+ * being managed internally).
+ *
+ * Results:
+ * See the manual entries.
+ *
+ * Side effects:
+ * See the manual entries.
+ *
+ *--------------------------------------------------------------
+ */
+
+void
+Tk_UnmapWindow(
+ Tk_Window tkwin) /* Token for window to unmap. */
+{
+ register TkWindow *winPtr = (TkWindow *) tkwin;
+
+ if (!(winPtr->flags & TK_MAPPED) || (winPtr->flags & TK_ALREADY_DEAD)) {
+ return;
+ }
+ if (winPtr->flags & TK_WIN_MANAGED) {
+ /*
+ * Special processing has to be done for top-level windows. Let tkWm.c
+ * handle everything itself.
+ */
+
+ TkWmUnmapWindow(winPtr);
+ return;
+ }
+ winPtr->flags &= ~TK_MAPPED;
+ XUnmapWindow(winPtr->display, winPtr->window);
+ if (!(winPtr->flags & TK_TOP_HIERARCHY)) {
+ XEvent event;
+
+ event.type = UnmapNotify;
+ event.xunmap.serial = LastKnownRequestProcessed(winPtr->display);
+ event.xunmap.send_event = False;
+ event.xunmap.display = winPtr->display;
+ event.xunmap.event = winPtr->window;
+ event.xunmap.window = winPtr->window;
+ event.xunmap.from_configure = False;
+ Tk_HandleEvent(&event);
+ }
+}
+
+void
+Tk_ConfigureWindow(
+ Tk_Window tkwin, /* Window to re-configure. */
+ unsigned int valueMask, /* Mask indicating which parts of *valuePtr
+ * are to be used. */
+ XWindowChanges *valuePtr) /* New values. */
+{
+ register TkWindow *winPtr = (TkWindow *) tkwin;
+
+ if (valueMask & CWX) {
+ winPtr->changes.x = valuePtr->x;
+ }
+ if (valueMask & CWY) {
+ winPtr->changes.y = valuePtr->y;
+ }
+ if (valueMask & CWWidth) {
+ winPtr->changes.width = valuePtr->width;
+ }
+ if (valueMask & CWHeight) {
+ winPtr->changes.height = valuePtr->height;
+ }
+ if (valueMask & CWBorderWidth) {
+ winPtr->changes.border_width = valuePtr->border_width;
+ }
+ if (valueMask & (CWSibling|CWStackMode)) {
+ Tcl_Panic("Can't set sibling or stack mode from Tk_ConfigureWindow");
+ }
+
+ if (winPtr->window != None) {
+ XConfigureWindow(winPtr->display, winPtr->window,
+ valueMask, valuePtr);
+ TkDoConfigureNotify(winPtr);
+ } else {
+ winPtr->dirtyChanges |= valueMask;
+ winPtr->flags |= TK_NEED_CONFIG_NOTIFY;
+ }
+}
+
+void
+Tk_MoveWindow(
+ Tk_Window tkwin, /* Window to move. */
+ int x, int y) /* New location for window (within parent). */
+{
+ register TkWindow *winPtr = (TkWindow *) tkwin;
+
+ winPtr->changes.x = x;
+ winPtr->changes.y = y;
+ if (winPtr->window != None) {
+ XMoveWindow(winPtr->display, winPtr->window, x, y);
+ TkDoConfigureNotify(winPtr);
+ } else {
+ winPtr->dirtyChanges |= CWX|CWY;
+ winPtr->flags |= TK_NEED_CONFIG_NOTIFY;
+ }
+}
+
+void
+Tk_ResizeWindow(
+ Tk_Window tkwin, /* Window to resize. */
+ int width, int height) /* New dimensions for window. */
+{
+ register TkWindow *winPtr = (TkWindow *) tkwin;
+
+ winPtr->changes.width = (unsigned) width;
+ winPtr->changes.height = (unsigned) height;
+ if (winPtr->window != None) {
+ XResizeWindow(winPtr->display, winPtr->window, (unsigned) width,
+ (unsigned) height);
+ TkDoConfigureNotify(winPtr);
+ } else {
+ winPtr->dirtyChanges |= CWWidth|CWHeight;
+ winPtr->flags |= TK_NEED_CONFIG_NOTIFY;
+ }
+}
+
+void
+Tk_MoveResizeWindow(
+ Tk_Window tkwin, /* Window to move and resize. */
+ int x, int y, /* New location for window (within parent). */
+ int width, int height) /* New dimensions for window. */
+{
+ register TkWindow *winPtr = (TkWindow *) tkwin;
+
+ winPtr->changes.x = x;
+ winPtr->changes.y = y;
+ winPtr->changes.width = (unsigned) width;
+ winPtr->changes.height = (unsigned) height;
+ if (winPtr->window != None) {
+ XMoveResizeWindow(winPtr->display, winPtr->window, x, y,
+ (unsigned) width, (unsigned) height);
+ TkDoConfigureNotify(winPtr);
+ } else {
+ winPtr->dirtyChanges |= CWX|CWY|CWWidth|CWHeight;
+ winPtr->flags |= TK_NEED_CONFIG_NOTIFY;
+ }
+}
+
+void
+Tk_SetWindowBorderWidth(
+ Tk_Window tkwin, /* Window to modify. */
+ int width) /* New border width for window. */
+{
+ register TkWindow *winPtr = (TkWindow *) tkwin;
+
+ winPtr->changes.border_width = width;
+ if (winPtr->window != None) {
+ XSetWindowBorderWidth(winPtr->display, winPtr->window,
+ (unsigned) width);
+ TkDoConfigureNotify(winPtr);
+ } else {
+ winPtr->dirtyChanges |= CWBorderWidth;
+ winPtr->flags |= TK_NEED_CONFIG_NOTIFY;
+ }
+}
+
+void
+Tk_ChangeWindowAttributes(
+ Tk_Window tkwin, /* Window to manipulate. */
+ unsigned long valueMask, /* OR'ed combination of bits, indicating which
+ * fields of *attsPtr are to be used. */
+ register XSetWindowAttributes *attsPtr)
+ /* New values for some attributes. */
+{
+ register TkWindow *winPtr = (TkWindow *) tkwin;
+
+ if (valueMask & CWBackPixmap) {
+ winPtr->atts.background_pixmap = attsPtr->background_pixmap;
+ }
+ if (valueMask & CWBackPixel) {
+ winPtr->atts.background_pixel = attsPtr->background_pixel;
+ }
+ if (valueMask & CWBorderPixmap) {
+ winPtr->atts.border_pixmap = attsPtr->border_pixmap;
+ }
+ if (valueMask & CWBorderPixel) {
+ winPtr->atts.border_pixel = attsPtr->border_pixel;
+ }
+ if (valueMask & CWBitGravity) {
+ winPtr->atts.bit_gravity = attsPtr->bit_gravity;
+ }
+ if (valueMask & CWWinGravity) {
+ winPtr->atts.win_gravity = attsPtr->win_gravity;
+ }
+ if (valueMask & CWBackingStore) {
+ winPtr->atts.backing_store = attsPtr->backing_store;
+ }
+ if (valueMask & CWBackingPlanes) {
+ winPtr->atts.backing_planes = attsPtr->backing_planes;
+ }
+ if (valueMask & CWBackingPixel) {
+ winPtr->atts.backing_pixel = attsPtr->backing_pixel;
+ }
+ if (valueMask & CWOverrideRedirect) {
+ winPtr->atts.override_redirect = attsPtr->override_redirect;
+ }
+ if (valueMask & CWSaveUnder) {
+ winPtr->atts.save_under = attsPtr->save_under;
+ }
+ if (valueMask & CWEventMask) {
+ winPtr->atts.event_mask = attsPtr->event_mask;
+ }
+ if (valueMask & CWDontPropagate) {
+ winPtr->atts.do_not_propagate_mask
+ = attsPtr->do_not_propagate_mask;
+ }
+ if (valueMask & CWColormap) {
+ winPtr->atts.colormap = attsPtr->colormap;
+ }
+ if (valueMask & CWCursor) {
+ winPtr->atts.cursor = attsPtr->cursor;
+ }
+
+ if (winPtr->window != None) {
+ XChangeWindowAttributes(winPtr->display, winPtr->window,
+ valueMask, attsPtr);
+ } else {
+ winPtr->dirtyAtts |= valueMask;
+ }
+}
+
+void
+Tk_SetWindowBackground(
+ Tk_Window tkwin, /* Window to manipulate. */
+ unsigned long pixel) /* Pixel value to use for window's
+ * background. */
+{
+ register TkWindow *winPtr = (TkWindow *) tkwin;
+
+ winPtr->atts.background_pixel = pixel;
+
+ if (winPtr->window != None) {
+ XSetWindowBackground(winPtr->display, winPtr->window, pixel);
+ } else {
+ winPtr->dirtyAtts = (winPtr->dirtyAtts & (unsigned) ~CWBackPixmap)
+ | CWBackPixel;
+ }
+}
+
+void
+Tk_SetWindowBackgroundPixmap(
+ Tk_Window tkwin, /* Window to manipulate. */
+ Pixmap pixmap) /* Pixmap to use for window's background. */
+{
+ register TkWindow *winPtr = (TkWindow *) tkwin;
+
+ winPtr->atts.background_pixmap = pixmap;
+
+ if (winPtr->window != None) {
+ XSetWindowBackgroundPixmap(winPtr->display,
+ winPtr->window, pixmap);
+ } else {
+ winPtr->dirtyAtts = (winPtr->dirtyAtts & (unsigned) ~CWBackPixel)
+ | CWBackPixmap;
+ }
+}
+
+void
+Tk_SetWindowBorder(
+ Tk_Window tkwin, /* Window to manipulate. */
+ unsigned long pixel) /* Pixel value to use for window's border. */
+{
+ register TkWindow *winPtr = (TkWindow *) tkwin;
+
+ winPtr->atts.border_pixel = pixel;
+
+ if (winPtr->window != None) {
+ XSetWindowBorder(winPtr->display, winPtr->window, pixel);
+ } else {
+ winPtr->dirtyAtts = (winPtr->dirtyAtts & (unsigned) ~CWBorderPixmap)
+ | CWBorderPixel;
+ }
+}
+
+void
+Tk_SetWindowBorderPixmap(
+ Tk_Window tkwin, /* Window to manipulate. */
+ Pixmap pixmap) /* Pixmap to use for window's border. */
+{
+ register TkWindow *winPtr = (TkWindow *) tkwin;
+
+ winPtr->atts.border_pixmap = pixmap;
+
+ if (winPtr->window != None) {
+ XSetWindowBorderPixmap(winPtr->display,
+ winPtr->window, pixmap);
+ } else {
+ winPtr->dirtyAtts = (winPtr->dirtyAtts & (unsigned) ~CWBorderPixel)
+ | CWBorderPixmap;
+ }
+}
+
+void
+Tk_DefineCursor(
+ Tk_Window tkwin, /* Window to manipulate. */
+ Tk_Cursor cursor) /* Cursor to use for window (may be None). */
+{
+ register TkWindow *winPtr = (TkWindow *) tkwin;
+
+#if defined(MAC_OSX_TK)
+ winPtr->atts.cursor = (XCursor) cursor;
+#else
+ winPtr->atts.cursor = (Cursor) cursor;
+#endif
+
+ if (winPtr->window != None) {
+ XDefineCursor(winPtr->display, winPtr->window, winPtr->atts.cursor);
+ } else {
+ winPtr->dirtyAtts = winPtr->dirtyAtts | CWCursor;
+ }
+}
+
+void
+Tk_UndefineCursor(
+ Tk_Window tkwin) /* Window to manipulate. */
+{
+ Tk_DefineCursor(tkwin, None);
+}
+
+void
+Tk_SetWindowColormap(
+ Tk_Window tkwin, /* Window to manipulate. */
+ Colormap colormap) /* Colormap to use for window. */
+{
+ register TkWindow *winPtr = (TkWindow *) tkwin;
+
+ winPtr->atts.colormap = colormap;
+
+ if (winPtr->window != None) {
+ XSetWindowColormap(winPtr->display, winPtr->window, colormap);
+ if (!(winPtr->flags & TK_WIN_MANAGED)) {
+ TkWmAddToColormapWindows(winPtr);
+ winPtr->flags |= TK_WM_COLORMAP_WINDOW;
+ }
+ } else {
+ winPtr->dirtyAtts |= CWColormap;
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_SetWindowVisual --
+ *
+ * This function is called to specify a visual to be used for a Tk window
+ * when it is created. This function, if called at all, must be called
+ * before the X window is created (i.e. before Tk_MakeWindowExist is
+ * called).
+ *
+ * Results:
+ * The return value is 1 if successful, or 0 if the X window has been
+ * already created.
+ *
+ * Side effects:
+ * The information given is stored for when the window is created.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tk_SetWindowVisual(
+ Tk_Window tkwin, /* Window to manipulate. */
+ Visual *visual, /* New visual for window. */
+ int depth, /* New depth for window. */
+ Colormap colormap) /* An appropriate colormap for the visual. */
+{
+ register TkWindow *winPtr = (TkWindow *) tkwin;
+
+ if (winPtr->window != None) {
+ /* Too late! */
+ return 0;
+ }
+
+ winPtr->visual = visual;
+ winPtr->depth = depth;
+ winPtr->atts.colormap = colormap;
+ winPtr->dirtyAtts |= CWColormap;
+
+ /*
+ * The following code is needed to make sure that the window doesn't
+ * inherit the parent's border pixmap, which would result in a BadMatch
+ * error.
+ */
+
+ if (!(winPtr->dirtyAtts & CWBorderPixmap)) {
+ winPtr->dirtyAtts |= CWBorderPixel;
+ }
+ return 1;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkDoConfigureNotify --
+ *
+ * Generate a ConfigureNotify event describing the current configuration
+ * of a window.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * An event is generated and processed by Tk_HandleEvent.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TkDoConfigureNotify(
+ register TkWindow *winPtr) /* Window whose configuration was just
+ * changed. */
+{
+ XEvent event;
+
+ event.type = ConfigureNotify;
+ event.xconfigure.serial = LastKnownRequestProcessed(winPtr->display);
+ event.xconfigure.send_event = False;
+ event.xconfigure.display = winPtr->display;
+ event.xconfigure.event = winPtr->window;
+ event.xconfigure.window = winPtr->window;
+ event.xconfigure.x = winPtr->changes.x;
+ event.xconfigure.y = winPtr->changes.y;
+ event.xconfigure.width = winPtr->changes.width;
+ event.xconfigure.height = winPtr->changes.height;
+ event.xconfigure.border_width = winPtr->changes.border_width;
+ if (winPtr->changes.stack_mode == Above) {
+ event.xconfigure.above = winPtr->changes.sibling;
+ } else {
+ event.xconfigure.above = None;
+ }
+ event.xconfigure.override_redirect = winPtr->atts.override_redirect;
+ Tk_HandleEvent(&event);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_SetClass --
+ *
+ * This function is used to give a window a class.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * A new class is stored for tkwin, replacing any existing class for it.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tk_SetClass(
+ Tk_Window tkwin, /* Token for window to assign class. */
+ const char *className) /* New class for tkwin. */
+{
+ register TkWindow *winPtr = (TkWindow *) tkwin;
+
+ winPtr->classUid = Tk_GetUid(className);
+ if (winPtr->flags & TK_WIN_MANAGED) {
+ TkWmSetClass(winPtr);
+ }
+ TkOptionClassChanged(winPtr);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_SetClassProcs --
+ *
+ * This function is used to set the class functions and instance data for
+ * a window.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * A new set of class functions and instance data is stored for tkwin,
+ * replacing any existing values.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tk_SetClassProcs(
+ Tk_Window tkwin, /* Token for window to modify. */
+ const Tk_ClassProcs *procs, /* Class procs structure. */
+ ClientData instanceData) /* Data to be passed to class functions. */
+{
+ register TkWindow *winPtr = (TkWindow *) tkwin;
+
+ winPtr->classProcsPtr = procs;
+ winPtr->instanceData = instanceData;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_NameToWindow --
+ *
+ * Given a string name for a window, this function returns the token for
+ * the window, if there exists a window corresponding to the given name.
+ *
+ * Results:
+ * The return result is either a token for the window corresponding to
+ * "name", or else NULL to indicate that there is no such window. In this
+ * case, an error message is left in the interp's result, unless interp
+ * is NULL.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+Tk_Window
+Tk_NameToWindow(
+ Tcl_Interp *interp, /* Where to report errors. */
+ const char *pathName, /* Path name of window. */
+ Tk_Window tkwin) /* Token for window: name is assumed to belong
+ * to the same main window as tkwin. */
+{
+ Tcl_HashEntry *hPtr;
+
+ if (tkwin == NULL) {
+ /*
+ * Either we're not really in Tk, or the main window was destroyed and
+ * we're on our way out of the application.
+ */
+
+ if (interp != NULL) {
+ Tcl_SetObjResult(interp, Tcl_NewStringObj("NULL main window",-1));
+ Tcl_SetErrorCode(interp, "TK", "NO_MAIN_WINDOW", NULL);
+ }
+ return NULL;
+ }
+
+ hPtr = Tcl_FindHashEntry(&((TkWindow *) tkwin)->mainPtr->nameTable,
+ pathName);
+ if (hPtr == NULL) {
+ if (interp != NULL) {
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "bad window path name \"%s\"", pathName));
+ Tcl_SetErrorCode(interp, "TK", "LOOKUP", "WINDOW", pathName,
+ NULL);
+ }
+ return NULL;
+ }
+ return Tcl_GetHashValue(hPtr);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_IdToWindow --
+ *
+ * Given an X display and window ID, this function returns the Tk token
+ * for the window, if there exists a Tk window corresponding to the given
+ * ID.
+ *
+ * Results:
+ * The return result is either a token for the window corresponding to
+ * the given X id, or else NULL to indicate that there is no such window.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+Tk_Window
+Tk_IdToWindow(
+ Display *display, /* X display containing the window. */
+ Window window) /* X window window id. */
+{
+ TkDisplay *dispPtr;
+ Tcl_HashEntry *hPtr;
+
+ for (dispPtr = TkGetDisplayList(); ; dispPtr = dispPtr->nextPtr) {
+ if (dispPtr == NULL) {
+ return NULL;
+ }
+ if (dispPtr->display == display) {
+ break;
+ }
+ }
+ if (window == None) {
+ return NULL;
+ }
+
+ hPtr = Tcl_FindHashEntry(&dispPtr->winTable, (char *) window);
+ if (hPtr == NULL) {
+ return NULL;
+ }
+ return Tcl_GetHashValue(hPtr);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_DisplayName --
+ *
+ * Return the textual name of a window's display.
+ *
+ * Results:
+ * The return value is the string name of the display associated with
+ * tkwin.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+const char *
+Tk_DisplayName(
+ Tk_Window tkwin) /* Window whose display name is desired. */
+{
+ return ((TkWindow *) tkwin)->dispPtr->name;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_Interp --
+ *
+ * Get the Tcl interpreter from a Tk window.
+ *
+ * Results:
+ * A pointer to the interpreter or NULL.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+Tcl_Interp *
+Tk_Interp(
+ Tk_Window tkwin)
+{
+ if (tkwin != NULL && ((TkWindow *) tkwin)->mainPtr != NULL) {
+ return ((TkWindow *) tkwin)->mainPtr->interp;
+ }
+ return NULL;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * UnlinkWindow --
+ *
+ * This function removes a window from the childList of its parent.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The window is unlinked from its childList.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+UnlinkWindow(
+ TkWindow *winPtr) /* Child window to be unlinked. */
+{
+ TkWindow *prevPtr;
+
+ if (winPtr->parentPtr == NULL) {
+ return;
+ }
+ prevPtr = winPtr->parentPtr->childList;
+ if (prevPtr == winPtr) {
+ winPtr->parentPtr->childList = winPtr->nextPtr;
+ if (winPtr->nextPtr == NULL) {
+ winPtr->parentPtr->lastChildPtr = NULL;
+ }
+ } else {
+ while (prevPtr->nextPtr != winPtr) {
+ prevPtr = prevPtr->nextPtr;
+ if (prevPtr == NULL) {
+ Tcl_Panic("UnlinkWindow couldn't find child in parent");
+ }
+ }
+ prevPtr->nextPtr = winPtr->nextPtr;
+ if (winPtr->nextPtr == NULL) {
+ winPtr->parentPtr->lastChildPtr = prevPtr;
+ }
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_RestackWindow --
+ *
+ * Change a window's position in the stacking order.
+ *
+ * Results:
+ * TCL_OK is normally returned. If other is not a descendant of tkwin's
+ * parent then TCL_ERROR is returned and tkwin is not repositioned.
+ *
+ * Side effects:
+ * Tkwin is repositioned in the stacking order.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tk_RestackWindow(
+ Tk_Window tkwin, /* Token for window whose position in the
+ * stacking order is to change. */
+ int aboveBelow, /* Indicates new position of tkwin relative to
+ * other; must be Above or Below. */
+ Tk_Window other) /* Tkwin will be moved to a position that puts
+ * it just above or below this window. If NULL
+ * then tkwin goes above or below all windows
+ * in the same parent. */
+{
+ TkWindow *winPtr = (TkWindow *) tkwin;
+ TkWindow *otherPtr = (TkWindow *) other;
+
+ /*
+ * Special case: if winPtr is a top-level window then just find the
+ * top-level ancestor of otherPtr and restack winPtr above otherPtr
+ * without changing any of Tk's childLists.
+ */
+
+ if (winPtr->flags & TK_WIN_MANAGED) {
+ while ((otherPtr != NULL) && !(otherPtr->flags & TK_TOP_HIERARCHY)) {
+ otherPtr = otherPtr->parentPtr;
+ }
+ TkWmRestackToplevel(winPtr, aboveBelow, otherPtr);
+ return TCL_OK;
+ }
+
+ /*
+ * Find an ancestor of otherPtr that is a sibling of winPtr.
+ */
+
+ if (winPtr->parentPtr == NULL) {
+ /*
+ * Window is going to be deleted shortly; don't do anything.
+ */
+
+ return TCL_OK;
+ }
+ if (otherPtr == NULL) {
+ if (aboveBelow == Above) {
+ otherPtr = winPtr->parentPtr->lastChildPtr;
+ } else {
+ otherPtr = winPtr->parentPtr->childList;
+ }
+ } else {
+ while (winPtr->parentPtr != otherPtr->parentPtr) {
+ if ((otherPtr == NULL) || (otherPtr->flags & TK_TOP_HIERARCHY)) {
+ return TCL_ERROR;
+ }
+ otherPtr = otherPtr->parentPtr;
+ }
+ }
+ if (otherPtr == winPtr) {
+ return TCL_OK;
+ }
+
+ /*
+ * Reposition winPtr in the stacking order.
+ */
+
+ UnlinkWindow(winPtr);
+ if (aboveBelow == Above) {
+ winPtr->nextPtr = otherPtr->nextPtr;
+ if (winPtr->nextPtr == NULL) {
+ winPtr->parentPtr->lastChildPtr = winPtr;
+ }
+ otherPtr->nextPtr = winPtr;
+ } else {
+ TkWindow *prevPtr;
+
+ prevPtr = winPtr->parentPtr->childList;
+ if (prevPtr == otherPtr) {
+ winPtr->parentPtr->childList = winPtr;
+ } else {
+ while (prevPtr->nextPtr != otherPtr) {
+ prevPtr = prevPtr->nextPtr;
+ }
+ prevPtr->nextPtr = winPtr;
+ }
+ winPtr->nextPtr = otherPtr;
+ }
+
+ /*
+ * Notify the X server of the change. If winPtr hasn't yet been created
+ * then there's no need to tell the X server now, since the stacking order
+ * will be handled properly when the window is finally created.
+ */
+
+ if (winPtr->window != None) {
+ XWindowChanges changes;
+ unsigned int mask = CWStackMode;
+
+ changes.stack_mode = Above;
+ for (otherPtr = winPtr->nextPtr; otherPtr != NULL;
+ otherPtr = otherPtr->nextPtr) {
+ if ((otherPtr->window != None)
+ && !(otherPtr->flags & (TK_TOP_HIERARCHY|TK_REPARENTED))){
+ changes.sibling = otherPtr->window;
+ changes.stack_mode = Below;
+ mask = CWStackMode|CWSibling;
+ break;
+ }
+ }
+ XConfigureWindow(winPtr->display, winPtr->window, mask, &changes);
+ }
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_MainWindow --
+ *
+ * Returns the main window for an application.
+ *
+ * Results:
+ * If interp has a Tk application associated with it, the main window for
+ * the application is returned. Otherwise NULL is returned and an error
+ * message is left in the interp's result.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+Tk_Window
+Tk_MainWindow(
+ Tcl_Interp *interp) /* Interpreter that embodies the application.
+ * Used for error reporting also. */
+{
+ TkMainInfo *mainPtr;
+ ThreadSpecificData *tsdPtr;
+
+ if (interp == NULL) {
+ return NULL;
+ }
+#ifdef USE_TCL_STUBS
+ if (tclStubsPtr == NULL) {
+ return NULL;
+ }
+#endif
+ tsdPtr = Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
+
+ for (mainPtr = tsdPtr->mainWindowList; mainPtr != NULL;
+ mainPtr = mainPtr->nextPtr) {
+ if (mainPtr->interp == interp) {
+ return (Tk_Window) mainPtr->winPtr;
+ }
+ }
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "this isn't a Tk application", -1));
+ Tcl_SetErrorCode(interp, "TK", "NO_MAIN_WINDOW", NULL);
+ return NULL;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_StrictMotif --
+ *
+ * Indicates whether strict Motif compliance has been specified for the
+ * given window.
+ *
+ * Results:
+ * The return value is 1 if strict Motif compliance has been requested
+ * for tkwin's application by setting the tk_strictMotif variable in its
+ * interpreter to a true value. 0 is returned if tk_strictMotif has a
+ * false value.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tk_StrictMotif(
+ Tk_Window tkwin) /* Window whose application is to be
+ * checked. */
+{
+ return ((TkWindow *) tkwin)->mainPtr->strictMotif;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_GetNumMainWindows --
+ *
+ * This function returns the number of main windows currently open in
+ * this process.
+ *
+ * Results:
+ * The number of main windows open in this process.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tk_GetNumMainWindows(void)
+{
+ ThreadSpecificData *tsdPtr;
+
+#ifdef USE_TCL_STUBS
+ if (tclStubsPtr == NULL) {
+ return 0;
+ }
+#endif
+
+ tsdPtr = Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
+
+ return tsdPtr->numMainWindows;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkpAlwaysShowSelection --
+ *
+ * Indicates whether text/entry widgets should always display
+ * their selection, regardless of window focus.
+ *
+ * Results:
+ * The return value is 1 if always showing the selection has been
+ * requested for tkwin's application by setting the
+ * ::tk::AlwaysShowSelection variable in its interpreter to a true value.
+ * 0 is returned if it has a false value.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TkpAlwaysShowSelection(
+ Tk_Window tkwin) /* Window whose application is to be
+ * checked. */
+{
+ return ((TkWindow *) tkwin)->mainPtr->alwaysShowSelection;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * DeleteWindowsExitProc --
+ *
+ * This function is invoked as an exit handler. It deletes all of the
+ * main windows in the current thread. We really should be using a thread
+ * local exit handler to delete windows and a process exit handler to
+ * close the display but Tcl does not provide support for this usage.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+DeleteWindowsExitProc(
+ ClientData clientData) /* tsdPtr when handler was created. */
+{
+ TkDisplay *dispPtr, *nextPtr;
+ Tcl_Interp *interp;
+ ThreadSpecificData *tsdPtr = clientData;
+
+ if (tsdPtr == NULL) {
+ return;
+ }
+
+ /*
+ * Finish destroying any windows that are in a half-dead state. We must
+ * protect the interpreter while destroying the window, because of
+ * <Destroy> bindings which could destroy the interpreter while the window
+ * is being deleted. This would leave frames on the call stack pointing at
+ * deleted memory, causing core dumps.
+ */
+
+ while (tsdPtr->halfdeadWindowList != NULL) {
+ interp = tsdPtr->halfdeadWindowList->winPtr->mainPtr->interp;
+ Tcl_Preserve(interp);
+ tsdPtr->halfdeadWindowList->flags |= HD_CLEANUP;
+ tsdPtr->halfdeadWindowList->winPtr->flags &= ~TK_ALREADY_DEAD;
+ Tk_DestroyWindow((Tk_Window) tsdPtr->halfdeadWindowList->winPtr);
+ Tcl_Release(interp);
+ }
+
+ /*
+ * Destroy any remaining main windows.
+ */
+
+ while (tsdPtr->mainWindowList != NULL) {
+ interp = tsdPtr->mainWindowList->interp;
+ Tcl_Preserve(interp);
+ Tk_DestroyWindow((Tk_Window) tsdPtr->mainWindowList->winPtr);
+ Tcl_Release(interp);
+ }
+
+ /*
+ * Iterate destroying the displays until no more displays remain. It is
+ * possible for displays to get recreated during exit by any code that
+ * calls GetScreen, so we must destroy these new displays as well as the
+ * old ones.
+ */
+
+ for (dispPtr = tsdPtr->displayList; dispPtr != NULL;
+ dispPtr = tsdPtr->displayList) {
+ /*
+ * Now iterate over the current list of open displays, and first set
+ * the global pointer to NULL so we will be able to notice if any new
+ * displays got created during deletion of the current set. We must
+ * also do this to ensure that Tk_IdToWindow does not find the old
+ * display as it is being destroyed, when it wants to see if it needs
+ * to dispatch a message.
+ */
+
+ for (tsdPtr->displayList = NULL; dispPtr != NULL; dispPtr = nextPtr) {
+ nextPtr = dispPtr->nextPtr;
+ TkCloseDisplay(dispPtr);
+ }
+ }
+
+ tsdPtr->numMainWindows = 0;
+ tsdPtr->mainWindowList = NULL;
+ tsdPtr->initialized = 0;
+}
+
+#if defined(_WIN32)
+
+static HMODULE tkcygwindll = NULL;
+
+/*
+ * Run Tk_MainEx from libtk8.?.dll
+ *
+ * This function is only ever called from wish8.4.exe, the cygwin port of Tcl.
+ * This means that the system encoding is utf-8, so we don't have to do any
+ * encoding conversions.
+ */
+
+int
+TkCygwinMainEx(
+ 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)
+{
+ TCHAR name[MAX_PATH];
+ int len;
+ void (*tkmainex)(int, char **, Tcl_AppInitProc *, Tcl_Interp *);
+
+ /* construct "<path>/libtk8.?.dll", from "<path>/tk8?.dll" */
+ len = GetModuleFileNameW(Tk_GetHINSTANCE(), name, MAX_PATH);
+ name[len-2] = TEXT('.');
+ name[len-1] = name[len-5];
+ _tcscpy(name+len, TEXT(".dll"));
+ memcpy(name+len-8, TEXT("libtk8"), 6 * sizeof(TCHAR));
+
+ tkcygwindll = LoadLibrary(name);
+ if (!tkcygwindll) {
+ /* dll is not present */
+ return 0;
+ }
+ tkmainex = (void (*)(int, char **, Tcl_AppInitProc *, Tcl_Interp *))
+ GetProcAddress(tkcygwindll, "Tk_MainEx");
+ if (!tkmainex) {
+ return 0;
+ }
+ tkmainex(argc, argv, appInitProc, interp);
+ return 1;
+}
+#endif /* _WIN32 */
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_Init --
+ *
+ * This function is invoked to add Tk to an interpreter. It incorporates
+ * all of Tk's commands into the interpreter and creates the main window
+ * for a new Tk application. If the interpreter contains a variable
+ * "argv", this function extracts several arguments from that variable,
+ * uses them to configure the main window, and modifies argv to exclude
+ * the arguments (see the "wish" documentation for a list of the
+ * arguments that are extracted).
+ *
+ * Results:
+ * Returns a standard Tcl completion code and sets the interp's result if
+ * there is an error.
+ *
+ * Side effects:
+ * Depends on various initialization scripts that get invoked.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tk_Init(
+ Tcl_Interp *interp) /* Interpreter to initialize. */
+{
+#if defined(_WIN32)
+ if (tkcygwindll) {
+ int (*tkinit)(Tcl_Interp *);
+
+ tkinit = (int(*)(Tcl_Interp *)) GetProcAddress(tkcygwindll,"Tk_Init");
+ if (tkinit) {
+ return tkinit(interp);
+ }
+ }
+#endif /* _WIN32 */
+ return Initialize(interp);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_SafeInit --
+ *
+ * This function is invoked to add Tk to a safe interpreter. It invokes
+ * the internal function that does the real work.
+ *
+ * Results:
+ * Returns a standard Tcl completion code and sets the interp's result if
+ * there is an error.
+ *
+ * Side effects:
+ * Depends on various initialization scripts that are invoked.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tk_SafeInit(
+ Tcl_Interp *interp) /* Interpreter to initialize. */
+{
+ /*
+ * Initialize the interpreter with Tk, safely. This removes all the Tk
+ * commands that are unsafe.
+ *
+ * Rationale:
+ *
+ * - Toplevel and menu are unsafe because they can be used to cover the
+ * entire screen and to steal input from the user.
+ * - Continuous ringing of the bell is a nuisance.
+ * - Cannot allow access to the clipboard because a malicious script can
+ * replace the contents with the string "rm -r *" and lead to surprises
+ * when the contents of the clipboard are pasted. Similarly, the
+ * selection command is blocked.
+ * - Cannot allow send because it can be used to cause unsafe interpreters
+ * to execute commands. The tk command recreates the send command, so
+ * that too must be hidden.
+ * - Focus can be used to grab the focus away from another window, in
+ * effect stealing user input. Cannot allow that.
+ * NOTE: We currently do *not* hide focus as it would make it impossible
+ * to provide keyboard input to Tk in a safe interpreter.
+ * - Grab can be used to block the user from using any other apps on the
+ * screen.
+ * - Tkwait can block the containing process forever. Use bindings,
+ * fileevents and split the protocol into before-the-wait and
+ * after-the-wait parts. More work but necessary.
+ * - Wm is unsafe because (if toplevels are allowed, in the future) it can
+ * be used to remove decorations, move windows around, cover the entire
+ * screen etc etc.
+ *
+ * Current risks:
+ *
+ * - No CPU time limit, no memory allocation limits, no color limits.
+ * CPU time limits can be imposed by an unsafe master interpreter.
+ *
+ * The actual code called is the same as Tk_Init but Tcl_IsSafe() is
+ * checked at several places to differentiate the two initialisations.
+ */
+
+#if defined(_WIN32)
+ if (tkcygwindll) {
+ int (*tksafeinit)(Tcl_Interp *);
+
+ tksafeinit = (int (*)(Tcl_Interp *))
+ GetProcAddress(tkcygwindll, "Tk_SafeInit");
+ if (tksafeinit) {
+ return tksafeinit(interp);
+ }
+ }
+#endif /* _WIN32 */
+ return Initialize(interp);
+}
+
+MODULE_SCOPE const TkStubs tkStubs;
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Initialize --
+ *
+ * The core of the initialization code for Tk, called from Tk_Init and
+ * Tk_SafeInit.
+ *
+ * Results:
+ * A standard Tcl result. Also leaves an error message in the interp's
+ * result if there was an error.
+ *
+ * Side effects:
+ * Depends on the initialization scripts that are invoked.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+CopyValue(
+ ClientData dummy,
+ Tcl_Obj *objPtr,
+ void *dstPtr)
+{
+ *(Tcl_Obj **)dstPtr = objPtr;
+ return 1;
+}
+
+static int
+Initialize(
+ Tcl_Interp *interp) /* Interpreter to initialize. */
+{
+ int code = TCL_OK;
+ ThreadSpecificData *tsdPtr;
+ Tcl_Obj *value = NULL;
+ Tcl_Obj *cmd;
+
+ Tcl_Obj *nameObj = NULL;
+ Tcl_Obj *classObj = NULL;
+ Tcl_Obj *displayObj = NULL;
+ Tcl_Obj *colorMapObj = NULL;
+ Tcl_Obj *useObj = NULL;
+ Tcl_Obj *visualObj = NULL;
+ Tcl_Obj *geometryObj = NULL;
+
+ int sync = 0;
+
+ const Tcl_ArgvInfo table[] = {
+ {TCL_ARGV_CONSTANT, "-sync", INT2PTR(1), &sync,
+ "Use synchronous mode for display server", NULL},
+ {TCL_ARGV_FUNC, "-colormap", CopyValue, &colorMapObj,
+ "Colormap for main window", NULL},
+ {TCL_ARGV_FUNC, "-display", CopyValue, &displayObj,
+ "Display to use", NULL},
+ {TCL_ARGV_FUNC, "-geometry", CopyValue, &geometryObj,
+ "Initial geometry for window", NULL},
+ {TCL_ARGV_FUNC, "-name", CopyValue, &nameObj,
+ "Name to use for application", NULL},
+ {TCL_ARGV_FUNC, "-visual", CopyValue, &visualObj,
+ "Visual for main window", NULL},
+ {TCL_ARGV_FUNC, "-use", CopyValue, &useObj,
+ "Id of window in which to embed application", NULL},
+ TCL_ARGV_AUTO_REST, TCL_ARGV_AUTO_HELP, TCL_ARGV_TABLE_END
+ };
+
+ /*
+ * Ensure that we are getting a compatible version of Tcl.
+ */
+
+ if (Tcl_InitStubs(interp, "8.6", 0) == NULL) {
+ return TCL_ERROR;
+ }
+
+ /*
+ * Ensure that our obj-types are registered with the Tcl runtime.
+ */
+
+ TkRegisterObjTypes();
+
+ tsdPtr = Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
+
+ /*
+ * We start by resetting the result because it might not be clean.
+ */
+
+ Tcl_ResetResult(interp);
+
+ if (Tcl_IsSafe(interp)) {
+ /*
+ * Get the clearance to start Tk and the "argv" parameters from the
+ * master.
+ */
+
+ /*
+ * Step 1 : find the master and construct the interp name (could be a
+ * function if new APIs were ok). We could also construct the path
+ * while walking, but there is no API to get the name of an interp
+ * either.
+ */
+
+ Tcl_Interp *master = interp;
+
+ while (Tcl_IsSafe(master)) {
+ master = Tcl_GetMaster(master);
+ if (master == NULL) {
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "no controlling master interpreter", -1));
+ Tcl_SetErrorCode(interp, "TK", "SAFE", "NO_MASTER", NULL);
+ return TCL_ERROR;
+ }
+ }
+
+ /*
+ * Construct the name (rewalk...)
+ */
+
+ code = Tcl_GetInterpPath(master, interp);
+ if (code != TCL_OK) {
+ Tcl_Panic("Tcl_GetInterpPath broken!");
+ }
+
+ /*
+ * Build the command to eval in trusted master.
+ */
+
+ cmd = Tcl_NewListObj(2, NULL);
+ Tcl_ListObjAppendElement(NULL, cmd,
+ Tcl_NewStringObj("::safe::TkInit", -1));
+ Tcl_ListObjAppendElement(NULL, cmd, Tcl_GetObjResult(master));
+
+ /*
+ * Step 2 : Eval in the master. The argument is the *reversed* interp
+ * path of the slave.
+ */
+
+ Tcl_IncrRefCount(cmd);
+ code = Tcl_EvalObjEx(master, cmd, 0);
+ Tcl_DecrRefCount(cmd);
+ Tcl_TransferResult(master, code, interp);
+ if (code != TCL_OK) {
+ return code;
+ }
+
+ /*
+ * Use the master's result as argv. Note: We don't use the Obj
+ * interfaces to avoid dealing with cross interp refcounting and
+ * changing the code below.
+ */
+
+ value = Tcl_GetObjResult(interp);
+ } else {
+ /*
+ * If there is an "argv" variable, get its value, extract out relevant
+ * arguments from it, and rewrite the variable without the arguments
+ * that we used.
+ */
+
+ value = Tcl_GetVar2Ex(interp, "argv", NULL, TCL_GLOBAL_ONLY);
+ }
+
+ if (value) {
+ int objc;
+ Tcl_Obj **objv, **rest;
+ Tcl_Obj *parseList = Tcl_NewListObj(1, NULL);
+
+ Tcl_ListObjAppendElement(NULL, parseList, Tcl_NewObj());
+
+ Tcl_IncrRefCount(value);
+ if (TCL_OK != Tcl_ListObjAppendList(interp, parseList, value) ||
+ TCL_OK != Tcl_ListObjGetElements(NULL, parseList, &objc, &objv) ||
+ TCL_OK != Tcl_ParseArgsObjv(interp, table, &objc, objv, &rest)) {
+ Tcl_AddErrorInfo(interp,
+ "\n (processing arguments in argv variable)");
+ code = TCL_ERROR;
+ }
+ if (code == TCL_OK) {
+ Tcl_SetVar2Ex(interp, "argv", NULL,
+ Tcl_NewListObj(objc-1, rest+1), TCL_GLOBAL_ONLY);
+ Tcl_SetVar2Ex(interp, "argc", NULL,
+ Tcl_NewIntObj(objc-1), TCL_GLOBAL_ONLY);
+ ckfree(rest);
+ }
+ Tcl_DecrRefCount(parseList);
+ if (code != TCL_OK) {
+ goto done;
+ }
+ }
+
+ /*
+ * Figure out the application's name and class.
+ */
+
+ /*
+ * If we got no -name argument, fetch from TkpGetAppName().
+ */
+
+ if (nameObj == NULL) {
+ Tcl_DString nameDS;
+
+ Tcl_DStringInit(&nameDS);
+ TkpGetAppName(interp, &nameDS);
+ nameObj = Tcl_NewStringObj(Tcl_DStringValue(&nameDS),
+ Tcl_DStringLength(&nameDS));
+ Tcl_DStringFree(&nameDS);
+ }
+
+ /*
+ * The -class argument is always the ToTitle of the -name
+ */
+
+ {
+ int numBytes;
+ const char *bytes = Tcl_GetStringFromObj(nameObj, &numBytes);
+
+ classObj = Tcl_NewStringObj(bytes, numBytes);
+
+ numBytes = Tcl_UtfToTitle(Tcl_GetString(classObj));
+ Tcl_SetObjLength(classObj, numBytes);
+ }
+
+ /*
+ * Create an argument list for creating the top-level window, using the
+ * information parsed from argv, if any.
+ */
+
+ cmd = Tcl_NewStringObj("toplevel . -class", -1);
+
+ Tcl_ListObjAppendElement(NULL, cmd, classObj);
+ classObj = NULL;
+
+ if (displayObj) {
+ Tcl_ListObjAppendElement(NULL, cmd, Tcl_NewStringObj("-screen", -1));
+ Tcl_ListObjAppendElement(NULL, cmd, displayObj);
+
+ /*
+ * If this is the first application for this process, save the display
+ * name in the DISPLAY environment variable so that it will be
+ * available to subprocesses created by us.
+ */
+
+ if (tsdPtr->numMainWindows == 0) {
+ Tcl_SetVar2Ex(interp, "env", "DISPLAY", displayObj, TCL_GLOBAL_ONLY);
+ }
+ displayObj = NULL;
+ }
+ if (colorMapObj) {
+ Tcl_ListObjAppendElement(NULL, cmd, Tcl_NewStringObj("-colormap", -1));
+ Tcl_ListObjAppendElement(NULL, cmd, colorMapObj);
+ colorMapObj = NULL;
+ }
+ if (useObj) {
+ Tcl_ListObjAppendElement(NULL, cmd, Tcl_NewStringObj("-use", -1));
+ Tcl_ListObjAppendElement(NULL, cmd, useObj);
+ useObj = NULL;
+ }
+ if (visualObj) {
+ Tcl_ListObjAppendElement(NULL, cmd, Tcl_NewStringObj("-visual", -1));
+ Tcl_ListObjAppendElement(NULL, cmd, visualObj);
+ visualObj = NULL;
+ }
+
+ code = TkListCreateFrame(NULL, interp, cmd, 1, nameObj);
+
+ Tcl_DecrRefCount(cmd);
+
+ if (code != TCL_OK) {
+ goto done;
+ }
+ Tcl_ResetResult(interp);
+ if (sync) {
+ XSynchronize(Tk_Display(Tk_MainWindow(interp)), True);
+ }
+
+ /*
+ * Set the geometry of the main window, if requested. Put the requested
+ * geometry into the "geometry" variable.
+ */
+
+ if (geometryObj) {
+
+ Tcl_SetVar2Ex(interp, "geometry", NULL, geometryObj, TCL_GLOBAL_ONLY);
+
+ cmd = Tcl_NewStringObj("wm geometry .", -1);
+ Tcl_ListObjAppendElement(NULL, cmd, geometryObj);
+ Tcl_IncrRefCount(cmd);
+ code = Tcl_EvalObjEx(interp, cmd, 0);
+ Tcl_DecrRefCount(cmd);
+ geometryObj = NULL;
+ if (code != TCL_OK) {
+ goto done;
+ }
+ }
+
+ /*
+ * Provide Tk and its stub table.
+ */
+
+ code = Tcl_PkgProvideEx(interp, "Tk", TK_PATCH_LEVEL,
+ (ClientData) &tkStubs);
+ if (code != TCL_OK) {
+ goto done;
+ }
+
+ /*
+ * If we were able to provide ourselves as a package, then set the main
+ * loop function in Tcl to our main loop proc. This will cause tclsh to be
+ * event-aware when Tk is dynamically loaded. This will have no effect in
+ * wish, which already is prepared to run the event loop.
+ */
+
+ Tcl_SetMainLoop(Tk_MainLoop);
+
+ /*
+ * Initialized the themed widget set
+ */
+
+ code = Ttk_Init(interp);
+ if (code != TCL_OK) {
+ goto done;
+ }
+
+ /*
+ * Invoke platform-specific initialization. Unlock mutex before entering
+ * TkpInit, as that may run through the Tk_Init routine again for the
+ * console window interpreter.
+ */
+
+ code = TkpInit(interp);
+ if (code == TCL_OK) {
+
+ /*
+ * In order to find tk.tcl during initialization, we evaluate the
+ * following script. It calls on the Tcl command [tcl_findLibrary]
+ * to perform the search. See the docs for that command for details
+ * on where it looks.
+ *
+ * Note that this entire search mechanism can be bypassed by defining
+ * an alternate [tkInit] command before calling Tk_Init().
+ */
+
+ code = Tcl_EvalEx(interp,
+"if {[namespace which -command tkInit] eq \"\"} {\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", -1, 0);
+ }
+ if (code == TCL_OK) {
+ /*
+ * Create exit handlers to delete all windows when the application or
+ * thread exits. The handler need to be invoked before other platform
+ * specific cleanups take place to avoid panics in finalization.
+ */
+
+ TkCreateThreadExitHandler(DeleteWindowsExitProc, tsdPtr);
+ }
+ done:
+ if (value) {
+ Tcl_DecrRefCount(value);
+ value = NULL;
+ }
+ return code;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_PkgInitStubsCheck --
+ *
+ * This is a replacement routine for Tk_InitStubs() that is called
+ * from code where -DUSE_TK_STUBS has not been enabled.
+ *
+ * Results:
+ * Returns the version of a conforming Tk stubs table, or NULL, if
+ * the table version doesn't satisfy the requested requirements,
+ * according to historical practice.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+const char *
+Tk_PkgInitStubsCheck(
+ Tcl_Interp *interp,
+ const char * version,
+ int exact)
+{
+ const char *actualVersion = Tcl_PkgRequireEx(interp, "Tk", version, 0, NULL);
+
+ if (exact && actualVersion) {
+ const char *p = version;
+ int count = 0;
+
+ while (*p) {
+ count += !isdigit(UCHAR(*p++));
+ }
+ if (count == 1) {
+ if (0 != strncmp(version, actualVersion, strlen(version))) {
+ /* Construct error message */
+ Tcl_PkgPresentEx(interp, "Tk", version, 1, NULL);
+ return NULL;
+ }
+ } else {
+ return Tcl_PkgPresentEx(interp, "Tk", version, 1, NULL);
+ }
+ }
+ return actualVersion;
+}
+
+/*
+ * Local Variables:
+ * mode: c
+ * c-basic-offset: 4
+ * fill-column: 78
+ * End:
+ */
diff --git a/tk8.6/generic/ttk/ttk.decls b/tk8.6/generic/ttk/ttk.decls
new file mode 100644
index 0000000..e668a2a
--- /dev/null
+++ b/tk8.6/generic/ttk/ttk.decls
@@ -0,0 +1,150 @@
+library ttk
+interface ttk
+epoch 0
+scspec TTKAPI
+
+declare 0 {
+ Ttk_Theme Ttk_GetTheme(Tcl_Interp *interp, const char *name)
+}
+declare 1 {
+ Ttk_Theme Ttk_GetDefaultTheme(Tcl_Interp *interp)
+}
+declare 2 {
+ Ttk_Theme Ttk_GetCurrentTheme(Tcl_Interp *interp)
+}
+declare 3 {
+ Ttk_Theme Ttk_CreateTheme(
+ Tcl_Interp *interp, const char *name, Ttk_Theme parent)
+}
+declare 4 {
+ void Ttk_RegisterCleanup(
+ Tcl_Interp *interp, void *deleteData, Ttk_CleanupProc *cleanupProc)
+}
+
+declare 5 {
+ int Ttk_RegisterElementSpec(
+ Ttk_Theme theme,
+ const char *elementName,
+ Ttk_ElementSpec *elementSpec,
+ void *clientData)
+}
+
+declare 6 {
+ Ttk_ElementClass *Ttk_RegisterElement(
+ Tcl_Interp *interp,
+ Ttk_Theme theme,
+ const char *elementName,
+ Ttk_ElementSpec *elementSpec,
+ void *clientData)
+}
+
+declare 7 {
+ int Ttk_RegisterElementFactory(
+ Tcl_Interp *interp,
+ const char *name,
+ Ttk_ElementFactory factoryProc,
+ void *clientData)
+}
+
+declare 8 {
+ void Ttk_RegisterLayout(
+ Ttk_Theme theme, const char *className, Ttk_LayoutSpec layoutSpec)
+}
+
+#
+# State maps.
+#
+declare 10 {
+ int Ttk_GetStateSpecFromObj(
+ Tcl_Interp *interp, Tcl_Obj *objPtr, Ttk_StateSpec *spec_rtn)
+}
+declare 11 {
+ Tcl_Obj *Ttk_NewStateSpecObj(
+ unsigned int onbits, unsigned int offbits)
+}
+declare 12 {
+ Ttk_StateMap Ttk_GetStateMapFromObj(
+ Tcl_Interp *interp, Tcl_Obj *objPtr)
+}
+declare 13 {
+ Tcl_Obj *Ttk_StateMapLookup(
+ Tcl_Interp *interp, Ttk_StateMap map, Ttk_State state)
+}
+declare 14 {
+ int Ttk_StateTableLookup(
+ Ttk_StateTable map[], Ttk_State state)
+}
+
+
+#
+# Low-level geometry utilities.
+#
+declare 20 {
+ int Ttk_GetPaddingFromObj(
+ Tcl_Interp *interp,
+ Tk_Window tkwin,
+ Tcl_Obj *objPtr,
+ Ttk_Padding *pad_rtn)
+}
+declare 21 {
+ int Ttk_GetBorderFromObj(
+ Tcl_Interp *interp,
+ Tcl_Obj *objPtr,
+ Ttk_Padding *pad_rtn)
+}
+declare 22 {
+ int Ttk_GetStickyFromObj(
+ Tcl_Interp *interp, Tcl_Obj *objPtr, Ttk_Sticky *sticky_rtn)
+}
+declare 23 {
+ Ttk_Padding Ttk_MakePadding(
+ short l, short t, short r, short b)
+}
+declare 24 {
+ Ttk_Padding Ttk_UniformPadding(
+ short borderWidth)
+}
+declare 25 {
+ Ttk_Padding Ttk_AddPadding(Ttk_Padding pad1, Ttk_Padding pad2)
+}
+declare 26 {
+ Ttk_Padding Ttk_RelievePadding(
+ Ttk_Padding padding, int relief, int n)
+}
+declare 27 {
+ Ttk_Box Ttk_MakeBox(int x, int y, int width, int height)
+}
+declare 28 {
+ int Ttk_BoxContains(Ttk_Box box, int x, int y)
+}
+declare 29 {
+ Ttk_Box Ttk_PackBox(Ttk_Box *cavity, int w, int h, Ttk_Side side)
+}
+declare 30 {
+ Ttk_Box Ttk_StickBox(Ttk_Box parcel, int w, int h, Ttk_Sticky sticky)
+}
+declare 31 {
+ Ttk_Box Ttk_AnchorBox(Ttk_Box parcel, int w, int h, Tk_Anchor anchor)
+}
+declare 32 {
+ Ttk_Box Ttk_PadBox(Ttk_Box b, Ttk_Padding p)
+}
+declare 33 {
+ Ttk_Box Ttk_ExpandBox(Ttk_Box b, Ttk_Padding p)
+}
+declare 34 {
+ Ttk_Box Ttk_PlaceBox(
+ Ttk_Box *cavity, int w, int h, Ttk_Side side, Ttk_Sticky sticky)
+}
+declare 35 {
+ Tcl_Obj *Ttk_NewBoxObj(Ttk_Box box)
+}
+
+#
+# Utilities.
+#
+declare 40 {
+ int Ttk_GetOrientFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr, int *orient)
+}
+
+
diff --git a/tk8.6/generic/ttk/ttkBlink.c b/tk8.6/generic/ttk/ttkBlink.c
new file mode 100644
index 0000000..706a871
--- /dev/null
+++ b/tk8.6/generic/ttk/ttkBlink.c
@@ -0,0 +1,166 @@
+/*
+ * Copyright 2004, Joe English.
+ *
+ * Usage:
+ * TtkBlinkCursor(corePtr), usually called in a widget's Init hook,
+ * arranges to periodically toggle the corePtr->flags CURSOR_ON bit
+ * on and off (and schedule a redisplay) whenever the widget has focus.
+ *
+ * Note: Widgets may have additional logic to decide whether
+ * to display the cursor or not (e.g., readonly or disabled states);
+ * TtkBlinkCursor() does not account for this.
+ *
+ * TODO:
+ * Add script-level access to configure application-wide blink rate.
+ */
+
+#include <tk.h>
+#include "ttkTheme.h"
+#include "ttkWidget.h"
+
+#define DEF_CURSOR_ON_TIME 600 /* milliseconds */
+#define DEF_CURSOR_OFF_TIME 300 /* milliseconds */
+
+/* Interp-specific data for tracking cursors:
+ */
+typedef struct
+{
+ WidgetCore *owner; /* Widget that currently has cursor */
+ Tcl_TimerToken timer; /* Blink timer */
+ int onTime; /* #milliseconds to blink cursor on */
+ int offTime; /* #milliseconds to blink cursor off */
+} CursorManager;
+
+/* CursorManagerDeleteProc --
+ * InterpDeleteProc for cursor manager.
+ */
+static void CursorManagerDeleteProc(ClientData clientData, Tcl_Interp *interp)
+{
+ CursorManager *cm = (CursorManager*)clientData;
+ if (cm->timer) {
+ Tcl_DeleteTimerHandler(cm->timer);
+ }
+ ckfree(clientData);
+}
+
+/* GetCursorManager --
+ * Look up and create if necessary the interp's cursor manager.
+ */
+static CursorManager *GetCursorManager(Tcl_Interp *interp)
+{
+ static const char *cm_key = "ttk::CursorManager";
+ CursorManager *cm = Tcl_GetAssocData(interp, cm_key,0);
+
+ if (!cm) {
+ cm = ckalloc(sizeof(*cm));
+ cm->timer = 0;
+ cm->owner = 0;
+ cm->onTime = DEF_CURSOR_ON_TIME;
+ cm->offTime = DEF_CURSOR_OFF_TIME;
+ Tcl_SetAssocData(interp,cm_key,CursorManagerDeleteProc,(ClientData)cm);
+ }
+ return cm;
+}
+
+/* CursorBlinkProc --
+ * Timer handler to blink the insert cursor on and off.
+ */
+static void
+CursorBlinkProc(ClientData clientData)
+{
+ CursorManager *cm = (CursorManager*)clientData;
+ int blinkTime;
+
+ if (cm->owner->flags & CURSOR_ON) {
+ cm->owner->flags &= ~CURSOR_ON;
+ blinkTime = cm->offTime;
+ } else {
+ cm->owner->flags |= CURSOR_ON;
+ blinkTime = cm->onTime;
+ }
+ cm->timer = Tcl_CreateTimerHandler(blinkTime, CursorBlinkProc, clientData);
+ TtkRedisplayWidget(cm->owner);
+}
+
+/* LoseCursor --
+ * Turn cursor off, disable blink timer.
+ */
+static void LoseCursor(CursorManager *cm, WidgetCore *corePtr)
+{
+ if (corePtr->flags & CURSOR_ON) {
+ corePtr->flags &= ~CURSOR_ON;
+ TtkRedisplayWidget(corePtr);
+ }
+ if (cm->owner == corePtr) {
+ cm->owner = NULL;
+ }
+ if (cm->timer) {
+ Tcl_DeleteTimerHandler(cm->timer);
+ cm->timer = 0;
+ }
+}
+
+/* ClaimCursor --
+ * Claim ownership of the insert cursor and blink on.
+ */
+static void ClaimCursor(CursorManager *cm, WidgetCore *corePtr)
+{
+ if (cm->owner == corePtr)
+ return;
+ if (cm->owner)
+ LoseCursor(cm, cm->owner);
+
+ corePtr->flags |= CURSOR_ON;
+ TtkRedisplayWidget(corePtr);
+
+ cm->owner = corePtr;
+ cm->timer = Tcl_CreateTimerHandler(cm->onTime, CursorBlinkProc, cm);
+}
+
+/*
+ * CursorEventProc --
+ * Event handler for FocusIn and FocusOut events;
+ * claim/lose ownership of the insert cursor when the widget
+ * acquires/loses keyboard focus.
+ */
+
+#define CursorEventMask (FocusChangeMask|StructureNotifyMask)
+#define RealFocusEvent(d) \
+ (d == NotifyInferior || d == NotifyAncestor || d == NotifyNonlinear)
+
+static void
+CursorEventProc(ClientData clientData, XEvent *eventPtr)
+{
+ WidgetCore *corePtr = (WidgetCore *)clientData;
+ CursorManager *cm = GetCursorManager(corePtr->interp);
+
+ switch (eventPtr->type) {
+ case DestroyNotify:
+ if (cm->owner == corePtr)
+ LoseCursor(cm, corePtr);
+ Tk_DeleteEventHandler(
+ corePtr->tkwin, CursorEventMask, CursorEventProc, clientData);
+ break;
+ case FocusIn:
+ if (RealFocusEvent(eventPtr->xfocus.detail))
+ ClaimCursor(cm, corePtr);
+ break;
+ case FocusOut:
+ if (RealFocusEvent(eventPtr->xfocus.detail))
+ LoseCursor(cm, corePtr);
+ break;
+ }
+}
+
+/*
+ * TtkBlinkCursor (main routine) --
+ * Arrange to blink the cursor on and off whenever the
+ * widget has focus.
+ */
+void TtkBlinkCursor(WidgetCore *corePtr)
+{
+ Tk_CreateEventHandler(
+ corePtr->tkwin, CursorEventMask, CursorEventProc, corePtr);
+}
+
+/*EOF*/
diff --git a/tk8.6/generic/ttk/ttkButton.c b/tk8.6/generic/ttk/ttkButton.c
new file mode 100644
index 0000000..bc44f25
--- /dev/null
+++ b/tk8.6/generic/ttk/ttkButton.c
@@ -0,0 +1,853 @@
+/*
+ * Copyright (c) 2003, Joe English
+ *
+ * label, button, checkbutton, radiobutton, and menubutton widgets.
+ */
+
+#include <string.h>
+#include <tk.h>
+#include "ttkTheme.h"
+#include "ttkWidget.h"
+
+/* Bit fields for OptionSpec mask field:
+ */
+#define STATE_CHANGED (0x100) /* -state option changed */
+#define DEFAULTSTATE_CHANGED (0x200) /* -default option changed */
+
+/*------------------------------------------------------------------------
+ * +++ Base resources for labels, buttons, checkbuttons, etc:
+ */
+typedef struct
+{
+ /*
+ * Text element resources:
+ */
+ Tcl_Obj *textObj;
+ Tcl_Obj *textVariableObj;
+ Tcl_Obj *underlineObj;
+ Tcl_Obj *widthObj;
+
+ Ttk_TraceHandle *textVariableTrace;
+ Ttk_ImageSpec *imageSpec;
+
+ /*
+ * Image element resources:
+ */
+ Tcl_Obj *imageObj;
+
+ /*
+ * Compound label/image resources:
+ */
+ Tcl_Obj *compoundObj;
+ Tcl_Obj *paddingObj;
+
+ /*
+ * Compatibility/legacy options:
+ */
+ Tcl_Obj *stateObj;
+
+} BasePart;
+
+typedef struct
+{
+ WidgetCore core;
+ BasePart base;
+} Base;
+
+static Tk_OptionSpec BaseOptionSpecs[] =
+{
+ {TK_OPTION_STRING, "-text", "text", "Text", "",
+ Tk_Offset(Base,base.textObj), -1,
+ 0,0,GEOMETRY_CHANGED },
+ {TK_OPTION_STRING, "-textvariable", "textVariable", "Variable", "",
+ Tk_Offset(Base,base.textVariableObj), -1,
+ TK_OPTION_NULL_OK,0,GEOMETRY_CHANGED },
+ {TK_OPTION_INT, "-underline", "underline", "Underline",
+ "-1", Tk_Offset(Base,base.underlineObj), -1,
+ 0,0,0 },
+ /* SB: OPTION_INT, see <<NOTE-NULLOPTIONS>> */
+ {TK_OPTION_STRING, "-width", "width", "Width",
+ NULL, Tk_Offset(Base,base.widthObj), -1,
+ TK_OPTION_NULL_OK,0,GEOMETRY_CHANGED },
+
+ /*
+ * Image options
+ */
+ {TK_OPTION_STRING, "-image", "image", "Image", NULL/*default*/,
+ Tk_Offset(Base,base.imageObj), -1,
+ TK_OPTION_NULL_OK,0,GEOMETRY_CHANGED },
+
+ /*
+ * Compound base/image options
+ */
+ {TK_OPTION_STRING_TABLE, "-compound", "compound", "Compound",
+ "none", Tk_Offset(Base,base.compoundObj), -1,
+ 0,(ClientData)ttkCompoundStrings,GEOMETRY_CHANGED },
+ {TK_OPTION_STRING, "-padding", "padding", "Pad",
+ NULL, Tk_Offset(Base,base.paddingObj), -1,
+ TK_OPTION_NULL_OK,0,GEOMETRY_CHANGED},
+
+ /*
+ * Compatibility/legacy options
+ */
+ {TK_OPTION_STRING, "-state", "state", "State",
+ "normal", Tk_Offset(Base,base.stateObj), -1,
+ 0,0,STATE_CHANGED },
+
+ WIDGET_INHERIT_OPTIONS(ttkCoreOptionSpecs)
+};
+
+/*
+ * Variable trace procedure for -textvariable option:
+ */
+static void TextVariableChanged(void *clientData, const char *value)
+{
+ Base *basePtr = clientData;
+ Tcl_Obj *newText;
+
+ if (WidgetDestroyed(&basePtr->core)) {
+ return;
+ }
+
+ newText = value ? Tcl_NewStringObj(value, -1) : Tcl_NewStringObj("", 0);
+
+ Tcl_IncrRefCount(newText);
+ Tcl_DecrRefCount(basePtr->base.textObj);
+ basePtr->base.textObj = newText;
+
+ TtkResizeWidget(&basePtr->core);
+}
+
+static void
+BaseInitialize(Tcl_Interp *interp, void *recordPtr)
+{
+ Base *basePtr = recordPtr;
+ basePtr->base.textVariableTrace = 0;
+ basePtr->base.imageSpec = NULL;
+}
+
+static void
+BaseCleanup(void *recordPtr)
+{
+ Base *basePtr = recordPtr;
+ if (basePtr->base.textVariableTrace)
+ Ttk_UntraceVariable(basePtr->base.textVariableTrace);
+ if (basePtr->base.imageSpec)
+ TtkFreeImageSpec(basePtr->base.imageSpec);
+}
+
+static int BaseConfigure(Tcl_Interp *interp, void *recordPtr, int mask)
+{
+ Base *basePtr = recordPtr;
+ Tcl_Obj *textVarName = basePtr->base.textVariableObj;
+ Ttk_TraceHandle *vt = 0;
+ Ttk_ImageSpec *imageSpec = NULL;
+
+ if (textVarName != NULL && *Tcl_GetString(textVarName) != '\0') {
+ vt = Ttk_TraceVariable(interp,textVarName,TextVariableChanged,basePtr);
+ if (!vt) return TCL_ERROR;
+ }
+
+ if (basePtr->base.imageObj) {
+ imageSpec = TtkGetImageSpec(
+ interp, basePtr->core.tkwin, basePtr->base.imageObj);
+ if (!imageSpec) {
+ goto error;
+ }
+ }
+
+ if (TtkCoreConfigure(interp, recordPtr, mask) != TCL_OK) {
+error:
+ if (imageSpec) TtkFreeImageSpec(imageSpec);
+ if (vt) Ttk_UntraceVariable(vt);
+ return TCL_ERROR;
+ }
+
+ if (basePtr->base.textVariableTrace) {
+ Ttk_UntraceVariable(basePtr->base.textVariableTrace);
+ }
+ basePtr->base.textVariableTrace = vt;
+
+ if (basePtr->base.imageSpec) {
+ TtkFreeImageSpec(basePtr->base.imageSpec);
+ }
+ basePtr->base.imageSpec = imageSpec;
+
+ if (mask & STATE_CHANGED) {
+ TtkCheckStateOption(&basePtr->core, basePtr->base.stateObj);
+ }
+
+ return TCL_OK;
+}
+
+static int
+BasePostConfigure(Tcl_Interp *interp, void *recordPtr, int mask)
+{
+ Base *basePtr = recordPtr;
+ int status = TCL_OK;
+
+ if (basePtr->base.textVariableTrace) {
+ status = Ttk_FireTrace(basePtr->base.textVariableTrace);
+ }
+
+ return status;
+}
+
+/*------------------------------------------------------------------------
+ * +++ Label widget.
+ * Just a base widget that adds a few appearance-related options
+ */
+
+typedef struct
+{
+ Tcl_Obj *backgroundObj;
+ Tcl_Obj *foregroundObj;
+ Tcl_Obj *fontObj;
+ Tcl_Obj *borderWidthObj;
+ Tcl_Obj *reliefObj;
+ Tcl_Obj *anchorObj;
+ Tcl_Obj *justifyObj;
+ Tcl_Obj *wrapLengthObj;
+} LabelPart;
+
+typedef struct
+{
+ WidgetCore core;
+ BasePart base;
+ LabelPart label;
+} Label;
+
+static Tk_OptionSpec LabelOptionSpecs[] =
+{
+ {TK_OPTION_BORDER, "-background", "frameColor", "FrameColor",
+ NULL, Tk_Offset(Label,label.backgroundObj), -1,
+ TK_OPTION_NULL_OK,0,0 },
+ {TK_OPTION_COLOR, "-foreground", "textColor", "TextColor",
+ NULL, Tk_Offset(Label,label.foregroundObj), -1,
+ TK_OPTION_NULL_OK,0,0 },
+ {TK_OPTION_FONT, "-font", "font", "Font",
+ NULL, Tk_Offset(Label,label.fontObj), -1,
+ TK_OPTION_NULL_OK,0,GEOMETRY_CHANGED },
+ {TK_OPTION_PIXELS, "-borderwidth", "borderWidth", "BorderWidth",
+ NULL, Tk_Offset(Label,label.borderWidthObj), -1,
+ TK_OPTION_NULL_OK,0,GEOMETRY_CHANGED },
+ {TK_OPTION_RELIEF, "-relief", "relief", "Relief",
+ NULL, Tk_Offset(Label,label.reliefObj), -1,
+ TK_OPTION_NULL_OK,0,GEOMETRY_CHANGED },
+ {TK_OPTION_ANCHOR, "-anchor", "anchor", "Anchor",
+ NULL, Tk_Offset(Label,label.anchorObj), -1,
+ TK_OPTION_NULL_OK, 0, GEOMETRY_CHANGED},
+ {TK_OPTION_JUSTIFY, "-justify", "justify", "Justify",
+ NULL, Tk_Offset(Label, label.justifyObj), -1,
+ TK_OPTION_NULL_OK,0,GEOMETRY_CHANGED },
+ {TK_OPTION_PIXELS, "-wraplength", "wrapLength", "WrapLength",
+ NULL, Tk_Offset(Label, label.wrapLengthObj), -1,
+ TK_OPTION_NULL_OK,0,GEOMETRY_CHANGED /*SB: SIZE_CHANGED*/ },
+
+ WIDGET_TAKEFOCUS_FALSE,
+ WIDGET_INHERIT_OPTIONS(BaseOptionSpecs)
+};
+
+static const Ttk_Ensemble LabelCommands[] = {
+ { "configure", TtkWidgetConfigureCommand,0 },
+ { "cget", TtkWidgetCgetCommand,0 },
+ { "instate", TtkWidgetInstateCommand,0 },
+ { "state", TtkWidgetStateCommand,0 },
+ { "identify", TtkWidgetIdentifyCommand,0 },
+ { 0,0,0 }
+};
+
+static WidgetSpec LabelWidgetSpec =
+{
+ "TLabel", /* className */
+ sizeof(Label), /* recordSize */
+ LabelOptionSpecs, /* optionSpecs */
+ LabelCommands, /* subcommands */
+ BaseInitialize, /* initializeProc */
+ BaseCleanup, /* cleanupProc */
+ BaseConfigure, /* configureProc */
+ BasePostConfigure, /* postConfigureProc */
+ TtkWidgetGetLayout, /* getLayoutProc */
+ TtkWidgetSize, /* sizeProc */
+ TtkWidgetDoLayout, /* layoutProc */
+ TtkWidgetDisplay /* displayProc */
+};
+
+TTK_BEGIN_LAYOUT(LabelLayout)
+ TTK_GROUP("Label.border", TTK_FILL_BOTH|TTK_BORDER,
+ TTK_GROUP("Label.padding", TTK_FILL_BOTH|TTK_BORDER,
+ TTK_NODE("Label.label", TTK_FILL_BOTH)))
+TTK_END_LAYOUT
+
+/*------------------------------------------------------------------------
+ * +++ Button widget.
+ * Adds a new subcommand "invoke", and options "-command" and "-default"
+ */
+
+typedef struct
+{
+ Tcl_Obj *commandObj;
+ Tcl_Obj *defaultStateObj;
+} ButtonPart;
+
+typedef struct
+{
+ WidgetCore core;
+ BasePart base;
+ ButtonPart button;
+} Button;
+
+/*
+ * Option specifications:
+ */
+static Tk_OptionSpec ButtonOptionSpecs[] =
+{
+ {TK_OPTION_STRING, "-command", "command", "Command",
+ "", Tk_Offset(Button, button.commandObj), -1, 0,0,0},
+ {TK_OPTION_STRING_TABLE, "-default", "default", "Default",
+ "normal", Tk_Offset(Button, button.defaultStateObj), -1,
+ 0, (ClientData) ttkDefaultStrings, DEFAULTSTATE_CHANGED},
+
+ WIDGET_TAKEFOCUS_TRUE,
+ WIDGET_INHERIT_OPTIONS(BaseOptionSpecs)
+};
+
+static int ButtonConfigure(Tcl_Interp *interp, void *recordPtr, int mask)
+{
+ Button *buttonPtr = recordPtr;
+
+ if (BaseConfigure(interp, recordPtr, mask) != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ /* Handle "-default" option:
+ */
+ if (mask & DEFAULTSTATE_CHANGED) {
+ int defaultState = TTK_BUTTON_DEFAULT_DISABLED;
+ Ttk_GetButtonDefaultStateFromObj(
+ NULL, buttonPtr->button.defaultStateObj, &defaultState);
+ if (defaultState == TTK_BUTTON_DEFAULT_ACTIVE) {
+ TtkWidgetChangeState(&buttonPtr->core, TTK_STATE_ALTERNATE, 0);
+ } else {
+ TtkWidgetChangeState(&buttonPtr->core, 0, TTK_STATE_ALTERNATE);
+ }
+ }
+ return TCL_OK;
+}
+
+/* $button invoke --
+ * Evaluate the button's -command.
+ */
+static int
+ButtonInvokeCommand(
+ void *recordPtr, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[])
+{
+ Button *buttonPtr = recordPtr;
+ if (objc > 2) {
+ Tcl_WrongNumArgs(interp, 1, objv, "invoke");
+ return TCL_ERROR;
+ }
+ if (buttonPtr->core.state & TTK_STATE_DISABLED) {
+ return TCL_OK;
+ }
+ return Tcl_EvalObjEx(interp, buttonPtr->button.commandObj, TCL_EVAL_GLOBAL);
+}
+
+static const Ttk_Ensemble ButtonCommands[] = {
+ { "configure", TtkWidgetConfigureCommand,0 },
+ { "cget", TtkWidgetCgetCommand,0 },
+ { "invoke", ButtonInvokeCommand,0 },
+ { "instate", TtkWidgetInstateCommand,0 },
+ { "state", TtkWidgetStateCommand,0 },
+ { "identify", TtkWidgetIdentifyCommand,0 },
+ { 0,0,0 }
+};
+
+static WidgetSpec ButtonWidgetSpec =
+{
+ "TButton", /* className */
+ sizeof(Button), /* recordSize */
+ ButtonOptionSpecs, /* optionSpecs */
+ ButtonCommands, /* subcommands */
+ BaseInitialize, /* initializeProc */
+ BaseCleanup, /* cleanupProc */
+ ButtonConfigure, /* configureProc */
+ BasePostConfigure, /* postConfigureProc */
+ TtkWidgetGetLayout, /* getLayoutProc */
+ TtkWidgetSize, /* sizeProc */
+ TtkWidgetDoLayout, /* layoutProc */
+ TtkWidgetDisplay /* displayProc */
+};
+
+TTK_BEGIN_LAYOUT(ButtonLayout)
+ TTK_GROUP("Button.border", TTK_FILL_BOTH|TTK_BORDER,
+ TTK_GROUP("Button.focus", TTK_FILL_BOTH,
+ TTK_GROUP("Button.padding", TTK_FILL_BOTH,
+ TTK_NODE("Button.label", TTK_FILL_BOTH))))
+TTK_END_LAYOUT
+
+/*------------------------------------------------------------------------
+ * +++ Checkbutton widget.
+ */
+typedef struct
+{
+ Tcl_Obj *variableObj;
+ Tcl_Obj *onValueObj;
+ Tcl_Obj *offValueObj;
+ Tcl_Obj *commandObj;
+
+ Ttk_TraceHandle *variableTrace;
+
+} CheckbuttonPart;
+
+typedef struct
+{
+ WidgetCore core;
+ BasePart base;
+ CheckbuttonPart checkbutton;
+} Checkbutton;
+
+/*
+ * Option specifications:
+ */
+static Tk_OptionSpec CheckbuttonOptionSpecs[] =
+{
+ {TK_OPTION_STRING, "-variable", "variable", "Variable",
+ NULL, Tk_Offset(Checkbutton, checkbutton.variableObj), -1,
+ TK_OPTION_NULL_OK,0,0},
+ {TK_OPTION_STRING, "-onvalue", "onValue", "OnValue",
+ "1", Tk_Offset(Checkbutton, checkbutton.onValueObj), -1,
+ 0,0,0},
+ {TK_OPTION_STRING, "-offvalue", "offValue", "OffValue",
+ "0", Tk_Offset(Checkbutton, checkbutton.offValueObj), -1,
+ 0,0,0},
+ {TK_OPTION_STRING, "-command", "command", "Command",
+ "", Tk_Offset(Checkbutton, checkbutton.commandObj), -1,
+ 0,0,0},
+
+ WIDGET_TAKEFOCUS_TRUE,
+ WIDGET_INHERIT_OPTIONS(BaseOptionSpecs)
+};
+
+/*
+ * Variable trace procedure for checkbutton -variable option
+ */
+static void CheckbuttonVariableChanged(void *clientData, const char *value)
+{
+ Checkbutton *checkPtr = clientData;
+
+ if (WidgetDestroyed(&checkPtr->core)) {
+ return;
+ }
+
+ if (!value) {
+ TtkWidgetChangeState(&checkPtr->core, TTK_STATE_ALTERNATE, 0);
+ return;
+ }
+ /* else */
+ TtkWidgetChangeState(&checkPtr->core, 0, TTK_STATE_ALTERNATE);
+ if (!strcmp(value, Tcl_GetString(checkPtr->checkbutton.onValueObj))) {
+ TtkWidgetChangeState(&checkPtr->core, TTK_STATE_SELECTED, 0);
+ } else {
+ TtkWidgetChangeState(&checkPtr->core, 0, TTK_STATE_SELECTED);
+ }
+}
+
+static void
+CheckbuttonInitialize(Tcl_Interp *interp, void *recordPtr)
+{
+ Checkbutton *checkPtr = recordPtr;
+ Tcl_Obj *variableObj;
+
+ /* default -variable is the widget name:
+ */
+ variableObj = Tcl_NewStringObj(Tk_PathName(checkPtr->core.tkwin), -1);
+ Tcl_IncrRefCount(variableObj);
+ checkPtr->checkbutton.variableObj = variableObj;
+ BaseInitialize(interp, recordPtr);
+}
+
+static void
+CheckbuttonCleanup(void *recordPtr)
+{
+ Checkbutton *checkPtr = recordPtr;
+ Ttk_UntraceVariable(checkPtr->checkbutton.variableTrace);
+ checkPtr->checkbutton.variableTrace = 0;
+ BaseCleanup(recordPtr);
+}
+
+static int
+CheckbuttonConfigure(Tcl_Interp *interp, void *recordPtr, int mask)
+{
+ Checkbutton *checkPtr = recordPtr;
+ Ttk_TraceHandle *vt = Ttk_TraceVariable(
+ interp, checkPtr->checkbutton.variableObj,
+ CheckbuttonVariableChanged, checkPtr);
+
+ if (!vt) {
+ return TCL_ERROR;
+ }
+
+ if (BaseConfigure(interp, recordPtr, mask) != TCL_OK){
+ Ttk_UntraceVariable(vt);
+ return TCL_ERROR;
+ }
+
+ Ttk_UntraceVariable(checkPtr->checkbutton.variableTrace);
+ checkPtr->checkbutton.variableTrace = vt;
+
+ return TCL_OK;
+}
+
+static int
+CheckbuttonPostConfigure(Tcl_Interp *interp, void *recordPtr, int mask)
+{
+ Checkbutton *checkPtr = recordPtr;
+ int status = TCL_OK;
+
+ if (checkPtr->checkbutton.variableTrace)
+ status = Ttk_FireTrace(checkPtr->checkbutton.variableTrace);
+ if (status == TCL_OK && !WidgetDestroyed(&checkPtr->core))
+ status = BasePostConfigure(interp, recordPtr, mask);
+ return status;
+}
+
+/*
+ * Checkbutton 'invoke' subcommand:
+ * Toggles the checkbutton state.
+ */
+static int
+CheckbuttonInvokeCommand(
+ void *recordPtr, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[])
+{
+ Checkbutton *checkPtr = recordPtr;
+ WidgetCore *corePtr = &checkPtr->core;
+ Tcl_Obj *newValue;
+
+ if (objc > 2) {
+ Tcl_WrongNumArgs(interp, 1, objv, "invoke");
+ return TCL_ERROR;
+ }
+ if (corePtr->state & TTK_STATE_DISABLED)
+ return TCL_OK;
+
+ /*
+ * Toggle the selected state.
+ */
+ if (corePtr->state & TTK_STATE_SELECTED)
+ newValue = checkPtr->checkbutton.offValueObj;
+ else
+ newValue = checkPtr->checkbutton.onValueObj;
+
+ if (Tcl_ObjSetVar2(interp,
+ checkPtr->checkbutton.variableObj, NULL, newValue,
+ TCL_GLOBAL_ONLY|TCL_LEAVE_ERR_MSG)
+ == NULL)
+ return TCL_ERROR;
+
+ if (WidgetDestroyed(corePtr))
+ return TCL_ERROR;
+
+ return Tcl_EvalObjEx(interp,
+ checkPtr->checkbutton.commandObj, TCL_EVAL_GLOBAL);
+}
+
+static const Ttk_Ensemble CheckbuttonCommands[] = {
+ { "configure", TtkWidgetConfigureCommand,0 },
+ { "cget", TtkWidgetCgetCommand,0 },
+ { "invoke", CheckbuttonInvokeCommand,0 },
+ { "instate", TtkWidgetInstateCommand,0 },
+ { "state", TtkWidgetStateCommand,0 },
+ { "identify", TtkWidgetIdentifyCommand,0 },
+ /* MISSING: select, deselect, toggle */
+ { 0,0,0 }
+};
+
+static WidgetSpec CheckbuttonWidgetSpec =
+{
+ "TCheckbutton", /* className */
+ sizeof(Checkbutton), /* recordSize */
+ CheckbuttonOptionSpecs, /* optionSpecs */
+ CheckbuttonCommands, /* subcommands */
+ CheckbuttonInitialize, /* initializeProc */
+ CheckbuttonCleanup, /* cleanupProc */
+ CheckbuttonConfigure, /* configureProc */
+ CheckbuttonPostConfigure, /* postConfigureProc */
+ TtkWidgetGetLayout, /* getLayoutProc */
+ TtkWidgetSize, /* sizeProc */
+ TtkWidgetDoLayout, /* layoutProc */
+ TtkWidgetDisplay /* displayProc */
+};
+
+TTK_BEGIN_LAYOUT(CheckbuttonLayout)
+ TTK_GROUP("Checkbutton.padding", TTK_FILL_BOTH,
+ TTK_NODE("Checkbutton.indicator", TTK_PACK_LEFT)
+ TTK_GROUP("Checkbutton.focus", TTK_PACK_LEFT | TTK_STICK_W,
+ TTK_NODE("Checkbutton.label", TTK_FILL_BOTH)))
+TTK_END_LAYOUT
+
+/*------------------------------------------------------------------------
+ * +++ Radiobutton widget.
+ */
+
+typedef struct
+{
+ Tcl_Obj *variableObj;
+ Tcl_Obj *valueObj;
+ Tcl_Obj *commandObj;
+
+ Ttk_TraceHandle *variableTrace;
+
+} RadiobuttonPart;
+
+typedef struct
+{
+ WidgetCore core;
+ BasePart base;
+ RadiobuttonPart radiobutton;
+} Radiobutton;
+
+/*
+ * Option specifications:
+ */
+static Tk_OptionSpec RadiobuttonOptionSpecs[] =
+{
+ {TK_OPTION_STRING, "-variable", "variable", "Variable",
+ "::selectedButton", Tk_Offset(Radiobutton, radiobutton.variableObj),-1,
+ 0,0,0},
+ {TK_OPTION_STRING, "-value", "Value", "Value",
+ "1", Tk_Offset(Radiobutton, radiobutton.valueObj), -1,
+ 0,0,0},
+ {TK_OPTION_STRING, "-command", "command", "Command",
+ "", Tk_Offset(Radiobutton, radiobutton.commandObj), -1,
+ 0,0,0},
+
+ WIDGET_TAKEFOCUS_TRUE,
+ WIDGET_INHERIT_OPTIONS(BaseOptionSpecs)
+};
+
+/*
+ * Variable trace procedure for radiobuttons.
+ */
+static void
+RadiobuttonVariableChanged(void *clientData, const char *value)
+{
+ Radiobutton *radioPtr = clientData;
+
+ if (WidgetDestroyed(&radioPtr->core)) {
+ return;
+ }
+
+ if (!value) {
+ TtkWidgetChangeState(&radioPtr->core, TTK_STATE_ALTERNATE, 0);
+ return;
+ }
+ /* else */
+ TtkWidgetChangeState(&radioPtr->core, 0, TTK_STATE_ALTERNATE);
+ if (!strcmp(value, Tcl_GetString(radioPtr->radiobutton.valueObj))) {
+ TtkWidgetChangeState(&radioPtr->core, TTK_STATE_SELECTED, 0);
+ } else {
+ TtkWidgetChangeState(&radioPtr->core, 0, TTK_STATE_SELECTED);
+ }
+}
+
+static void
+RadiobuttonCleanup(void *recordPtr)
+{
+ Radiobutton *radioPtr = recordPtr;
+ Ttk_UntraceVariable(radioPtr->radiobutton.variableTrace);
+ radioPtr->radiobutton.variableTrace = 0;
+ BaseCleanup(recordPtr);
+}
+
+static int
+RadiobuttonConfigure(Tcl_Interp *interp, void *recordPtr, int mask)
+{
+ Radiobutton *radioPtr = recordPtr;
+ Ttk_TraceHandle *vt = Ttk_TraceVariable(
+ interp, radioPtr->radiobutton.variableObj,
+ RadiobuttonVariableChanged, radioPtr);
+
+ if (!vt) {
+ return TCL_ERROR;
+ }
+
+ if (BaseConfigure(interp, recordPtr, mask) != TCL_OK) {
+ Ttk_UntraceVariable(vt);
+ return TCL_ERROR;
+ }
+
+ Ttk_UntraceVariable(radioPtr->radiobutton.variableTrace);
+ radioPtr->radiobutton.variableTrace = vt;
+
+ return TCL_OK;
+}
+
+static int
+RadiobuttonPostConfigure(Tcl_Interp *interp, void *recordPtr, int mask)
+{
+ Radiobutton *radioPtr = recordPtr;
+ int status = TCL_OK;
+
+ if (radioPtr->radiobutton.variableTrace)
+ status = Ttk_FireTrace(radioPtr->radiobutton.variableTrace);
+ if (status == TCL_OK && !WidgetDestroyed(&radioPtr->core))
+ status = BasePostConfigure(interp, recordPtr, mask);
+ return status;
+}
+
+/*
+ * Radiobutton 'invoke' subcommand:
+ * Sets the radiobutton -variable to the -value, evaluates the -command.
+ */
+static int
+RadiobuttonInvokeCommand(
+ void *recordPtr, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[])
+{
+ Radiobutton *radioPtr = recordPtr;
+ WidgetCore *corePtr = &radioPtr->core;
+
+ if (objc > 2) {
+ Tcl_WrongNumArgs(interp, 1, objv, "invoke");
+ return TCL_ERROR;
+ }
+ if (corePtr->state & TTK_STATE_DISABLED)
+ return TCL_OK;
+
+ if (Tcl_ObjSetVar2(interp,
+ radioPtr->radiobutton.variableObj, NULL,
+ radioPtr->radiobutton.valueObj,
+ TCL_GLOBAL_ONLY|TCL_LEAVE_ERR_MSG)
+ == NULL)
+ return TCL_ERROR;
+
+ if (WidgetDestroyed(corePtr))
+ return TCL_ERROR;
+
+ return Tcl_EvalObjEx(interp,
+ radioPtr->radiobutton.commandObj, TCL_EVAL_GLOBAL);
+}
+
+static const Ttk_Ensemble RadiobuttonCommands[] = {
+ { "configure", TtkWidgetConfigureCommand,0 },
+ { "cget", TtkWidgetCgetCommand,0 },
+ { "invoke", RadiobuttonInvokeCommand,0 },
+ { "instate", TtkWidgetInstateCommand,0 },
+ { "state", TtkWidgetStateCommand,0 },
+ { "identify", TtkWidgetIdentifyCommand,0 },
+ /* MISSING: select, deselect */
+ { 0,0,0 }
+};
+
+static WidgetSpec RadiobuttonWidgetSpec =
+{
+ "TRadiobutton", /* className */
+ sizeof(Radiobutton), /* recordSize */
+ RadiobuttonOptionSpecs, /* optionSpecs */
+ RadiobuttonCommands, /* subcommands */
+ BaseInitialize, /* initializeProc */
+ RadiobuttonCleanup, /* cleanupProc */
+ RadiobuttonConfigure, /* configureProc */
+ RadiobuttonPostConfigure, /* postConfigureProc */
+ TtkWidgetGetLayout, /* getLayoutProc */
+ TtkWidgetSize, /* sizeProc */
+ TtkWidgetDoLayout, /* layoutProc */
+ TtkWidgetDisplay /* displayProc */
+};
+
+TTK_BEGIN_LAYOUT(RadiobuttonLayout)
+ TTK_GROUP("Radiobutton.padding", TTK_FILL_BOTH,
+ TTK_NODE("Radiobutton.indicator", TTK_PACK_LEFT)
+ TTK_GROUP("Radiobutton.focus", TTK_PACK_LEFT,
+ TTK_NODE("Radiobutton.label", TTK_FILL_BOTH)))
+TTK_END_LAYOUT
+
+/*------------------------------------------------------------------------
+ * +++ Menubutton widget.
+ */
+
+typedef struct
+{
+ Tcl_Obj *menuObj;
+ Tcl_Obj *directionObj;
+} MenubuttonPart;
+
+typedef struct
+{
+ WidgetCore core;
+ BasePart base;
+ MenubuttonPart menubutton;
+} Menubutton;
+
+/*
+ * Option specifications:
+ */
+static const char *const directionStrings[] = {
+ "above", "below", "left", "right", "flush", NULL
+};
+static Tk_OptionSpec MenubuttonOptionSpecs[] =
+{
+ {TK_OPTION_STRING, "-menu", "menu", "Menu",
+ "", Tk_Offset(Menubutton, menubutton.menuObj), -1, 0,0,0},
+ {TK_OPTION_STRING_TABLE, "-direction", "direction", "Direction",
+ "below", Tk_Offset(Menubutton, menubutton.directionObj), -1,
+ 0,(ClientData)directionStrings,GEOMETRY_CHANGED},
+
+ WIDGET_TAKEFOCUS_TRUE,
+ WIDGET_INHERIT_OPTIONS(BaseOptionSpecs)
+};
+
+static const Ttk_Ensemble MenubuttonCommands[] = {
+ { "configure", TtkWidgetConfigureCommand,0 },
+ { "cget", TtkWidgetCgetCommand,0 },
+ { "instate", TtkWidgetInstateCommand,0 },
+ { "state", TtkWidgetStateCommand,0 },
+ { "identify", TtkWidgetIdentifyCommand,0 },
+ { 0,0,0 }
+};
+
+static WidgetSpec MenubuttonWidgetSpec =
+{
+ "TMenubutton", /* className */
+ sizeof(Menubutton), /* recordSize */
+ MenubuttonOptionSpecs, /* optionSpecs */
+ MenubuttonCommands, /* subcommands */
+ BaseInitialize, /* initializeProc */
+ BaseCleanup, /* cleanupProc */
+ BaseConfigure, /* configureProc */
+ BasePostConfigure, /* postConfigureProc */
+ TtkWidgetGetLayout, /* getLayoutProc */
+ TtkWidgetSize, /* sizeProc */
+ TtkWidgetDoLayout, /* layoutProc */
+ TtkWidgetDisplay /* displayProc */
+};
+
+TTK_BEGIN_LAYOUT(MenubuttonLayout)
+ TTK_GROUP("Menubutton.border", TTK_FILL_BOTH,
+ TTK_GROUP("Menubutton.focus", TTK_FILL_BOTH,
+ TTK_NODE("Menubutton.indicator", TTK_PACK_RIGHT)
+ TTK_GROUP("Menubutton.padding", TTK_PACK_LEFT|TTK_EXPAND|TTK_FILL_X,
+ TTK_NODE("Menubutton.label", TTK_PACK_LEFT))))
+TTK_END_LAYOUT
+
+/*------------------------------------------------------------------------
+ * +++ Initialization.
+ */
+
+MODULE_SCOPE
+void TtkButton_Init(Tcl_Interp *interp)
+{
+ Ttk_Theme theme = Ttk_GetDefaultTheme(interp);
+
+ Ttk_RegisterLayout(theme, "TLabel", LabelLayout);
+ Ttk_RegisterLayout(theme, "TButton", ButtonLayout);
+ Ttk_RegisterLayout(theme, "TCheckbutton", CheckbuttonLayout);
+ Ttk_RegisterLayout(theme, "TRadiobutton", RadiobuttonLayout);
+ Ttk_RegisterLayout(theme, "TMenubutton", MenubuttonLayout);
+
+ RegisterWidget(interp, "ttk::label", &LabelWidgetSpec);
+ RegisterWidget(interp, "ttk::button", &ButtonWidgetSpec);
+ RegisterWidget(interp, "ttk::checkbutton", &CheckbuttonWidgetSpec);
+ RegisterWidget(interp, "ttk::radiobutton", &RadiobuttonWidgetSpec);
+ RegisterWidget(interp, "ttk::menubutton", &MenubuttonWidgetSpec);
+}
diff --git a/tk8.6/generic/ttk/ttkCache.c b/tk8.6/generic/ttk/ttkCache.c
new file mode 100644
index 0000000..0ae2372
--- /dev/null
+++ b/tk8.6/generic/ttk/ttkCache.c
@@ -0,0 +1,350 @@
+/*
+ * Theme engine resource cache.
+ *
+ * Copyright (c) 2004, Joe English
+ *
+ * The problem:
+ *
+ * Tk maintains reference counts for fonts, colors, and images,
+ * and deallocates them when the reference count goes to zero.
+ * With the theme engine, resources are allocated right before
+ * drawing an element and released immediately after.
+ * This causes a severe performance penalty, and on PseudoColor
+ * visuals it causes colormap cycling as colormap entries are
+ * released and reused.
+ *
+ * Solution: Acquire fonts, colors, and objects from a
+ * resource cache instead of directly from Tk; the cache
+ * holds a semipermanent reference to the resource to keep
+ * it from being deallocated.
+ *
+ * The plumbing and control flow here is quite contorted;
+ * it would be better to address this problem in the core instead.
+ *
+ * @@@ BUGS/TODO: Need distinct caches for each combination
+ * of display, visual, and colormap.
+ *
+ * @@@ Colormap flashing on PseudoColor visuals is still possible,
+ * but this will be a transient effect.
+ */
+
+#include <stdio.h> /* for sprintf */
+#include <tk.h>
+#include "ttkTheme.h"
+
+struct Ttk_ResourceCache_ {
+ Tcl_Interp *interp; /* Interpreter for error reporting */
+ Tk_Window tkwin; /* Cache window. */
+ Tcl_HashTable fontTable; /* Entries: Tcl_Obj* holding FontObjs */
+ Tcl_HashTable colorTable; /* Entries: Tcl_Obj* holding ColorObjs */
+ Tcl_HashTable borderTable; /* Entries: Tcl_Obj* holding BorderObjs */
+ Tcl_HashTable imageTable; /* Entries: Tk_Images */
+
+ Tcl_HashTable namedColors; /* Entries: RGB values as Tcl_StringObjs */
+};
+
+/*
+ * Ttk_CreateResourceCache --
+ * Initialize a new resource cache.
+ */
+Ttk_ResourceCache Ttk_CreateResourceCache(Tcl_Interp *interp)
+{
+ Ttk_ResourceCache cache = ckalloc(sizeof(*cache));
+
+ cache->tkwin = NULL; /* initialized later */
+ cache->interp = interp;
+ Tcl_InitHashTable(&cache->fontTable, TCL_STRING_KEYS);
+ Tcl_InitHashTable(&cache->colorTable, TCL_STRING_KEYS);
+ Tcl_InitHashTable(&cache->borderTable, TCL_STRING_KEYS);
+ Tcl_InitHashTable(&cache->imageTable, TCL_STRING_KEYS);
+ Tcl_InitHashTable(&cache->namedColors, TCL_STRING_KEYS);
+
+ return cache;
+}
+
+/*
+ * Ttk_ClearCache --
+ * Release references to all cached resources.
+ */
+static void Ttk_ClearCache(Ttk_ResourceCache cache)
+{
+ Tcl_HashSearch search;
+ Tcl_HashEntry *entryPtr;
+
+ /*
+ * Free fonts:
+ */
+ entryPtr = Tcl_FirstHashEntry(&cache->fontTable, &search);
+ while (entryPtr != NULL) {
+ Tcl_Obj *fontObj = Tcl_GetHashValue(entryPtr);
+ if (fontObj) {
+ Tk_FreeFontFromObj(cache->tkwin, fontObj);
+ Tcl_DecrRefCount(fontObj);
+ }
+ entryPtr = Tcl_NextHashEntry(&search);
+ }
+ Tcl_DeleteHashTable(&cache->fontTable);
+ Tcl_InitHashTable(&cache->fontTable, TCL_STRING_KEYS);
+
+ /*
+ * Free colors:
+ */
+ entryPtr = Tcl_FirstHashEntry(&cache->colorTable, &search);
+ while (entryPtr != NULL) {
+ Tcl_Obj *colorObj = Tcl_GetHashValue(entryPtr);
+ if (colorObj) {
+ Tk_FreeColorFromObj(cache->tkwin, colorObj);
+ Tcl_DecrRefCount(colorObj);
+ }
+ entryPtr = Tcl_NextHashEntry(&search);
+ }
+ Tcl_DeleteHashTable(&cache->colorTable);
+ Tcl_InitHashTable(&cache->colorTable, TCL_STRING_KEYS);
+
+ /*
+ * Free borders:
+ */
+ entryPtr = Tcl_FirstHashEntry(&cache->borderTable, &search);
+ while (entryPtr != NULL) {
+ Tcl_Obj *borderObj = Tcl_GetHashValue(entryPtr);
+ if (borderObj) {
+ Tk_Free3DBorderFromObj(cache->tkwin, borderObj);
+ Tcl_DecrRefCount(borderObj);
+ }
+ entryPtr = Tcl_NextHashEntry(&search);
+ }
+ Tcl_DeleteHashTable(&cache->borderTable);
+ Tcl_InitHashTable(&cache->borderTable, TCL_STRING_KEYS);
+
+ /*
+ * Free images:
+ */
+ entryPtr = Tcl_FirstHashEntry(&cache->imageTable, &search);
+ while (entryPtr != NULL) {
+ Tk_Image image = Tcl_GetHashValue(entryPtr);
+ if (image) {
+ Tk_FreeImage(image);
+ }
+ entryPtr = Tcl_NextHashEntry(&search);
+ }
+ Tcl_DeleteHashTable(&cache->imageTable);
+ Tcl_InitHashTable(&cache->imageTable, TCL_STRING_KEYS);
+
+ return;
+}
+
+/*
+ * Ttk_FreeResourceCache --
+ * Release references to all cached resources, delete the cache.
+ */
+
+void Ttk_FreeResourceCache(Ttk_ResourceCache cache)
+{
+ Tcl_HashEntry *entryPtr;
+ Tcl_HashSearch search;
+
+ Ttk_ClearCache(cache);
+
+ Tcl_DeleteHashTable(&cache->colorTable);
+ Tcl_DeleteHashTable(&cache->fontTable);
+ Tcl_DeleteHashTable(&cache->imageTable);
+
+ /*
+ * Free named colors:
+ */
+ entryPtr = Tcl_FirstHashEntry(&cache->namedColors, &search);
+ while (entryPtr != NULL) {
+ Tcl_Obj *colorNameObj = Tcl_GetHashValue(entryPtr);
+ Tcl_DecrRefCount(colorNameObj);
+ entryPtr = Tcl_NextHashEntry(&search);
+ }
+ Tcl_DeleteHashTable(&cache->namedColors);
+
+ ckfree(cache);
+}
+
+/*
+ * CacheWinEventHandler --
+ * Detect when the cache window is destroyed, clear cache.
+ */
+static void CacheWinEventHandler(ClientData clientData, XEvent *eventPtr)
+{
+ Ttk_ResourceCache cache = clientData;
+
+ if (eventPtr->type != DestroyNotify) {
+ return;
+ }
+ Tk_DeleteEventHandler(cache->tkwin, StructureNotifyMask,
+ CacheWinEventHandler, clientData);
+ Ttk_ClearCache(cache);
+ cache->tkwin = NULL;
+}
+
+/*
+ * InitCacheWindow --
+ * Specify the cache window if not already set.
+ * @@@ SHOULD: use separate caches for each combination
+ * @@@ of display, visual, and colormap.
+ */
+static void InitCacheWindow(Ttk_ResourceCache cache, Tk_Window tkwin)
+{
+ if (cache->tkwin == NULL) {
+ cache->tkwin = tkwin;
+ Tk_CreateEventHandler(tkwin, StructureNotifyMask,
+ CacheWinEventHandler, cache);
+ }
+}
+
+/*
+ * Ttk_RegisterNamedColor --
+ * Specify an RGB triplet as a named color.
+ * Overrides any previous named color specification.
+ */
+void Ttk_RegisterNamedColor(
+ Ttk_ResourceCache cache,
+ const char *colorName,
+ XColor *colorPtr)
+{
+ int newEntry;
+ Tcl_HashEntry *entryPtr;
+ char nameBuf[14];
+ Tcl_Obj *colorNameObj;
+
+ sprintf(nameBuf, "#%04X%04X%04X",
+ colorPtr->red, colorPtr->green, colorPtr->blue);
+ colorNameObj = Tcl_NewStringObj(nameBuf, -1);
+ Tcl_IncrRefCount(colorNameObj);
+
+ entryPtr = Tcl_CreateHashEntry(&cache->namedColors, colorName, &newEntry);
+ if (!newEntry) {
+ Tcl_Obj *oldColor = Tcl_GetHashValue(entryPtr);
+ Tcl_DecrRefCount(oldColor);
+ }
+
+ Tcl_SetHashValue(entryPtr, colorNameObj);
+}
+
+/*
+ * CheckNamedColor(objPtr) --
+ * If objPtr is a registered color name, return a Tcl_Obj *
+ * containing the registered color value specification.
+ * Otherwise, return the input argument.
+ */
+static Tcl_Obj *CheckNamedColor(Ttk_ResourceCache cache, Tcl_Obj *objPtr)
+{
+ Tcl_HashEntry *entryPtr =
+ Tcl_FindHashEntry(&cache->namedColors, Tcl_GetString(objPtr));
+ if (entryPtr) { /* Use named color instead */
+ objPtr = Tcl_GetHashValue(entryPtr);
+ }
+ return objPtr;
+}
+
+/*
+ * Template for allocation routines:
+ */
+typedef void *(*Allocator)(Tcl_Interp *, Tk_Window, Tcl_Obj *);
+
+static Tcl_Obj *Ttk_Use(
+ Tcl_Interp *interp,
+ Tcl_HashTable *table,
+ Allocator allocate,
+ Tk_Window tkwin,
+ Tcl_Obj *objPtr)
+{
+ int newEntry;
+ Tcl_HashEntry *entryPtr =
+ Tcl_CreateHashEntry(table,Tcl_GetString(objPtr),&newEntry);
+ Tcl_Obj *cacheObj;
+
+ if (!newEntry) {
+ return Tcl_GetHashValue(entryPtr);
+ }
+
+ cacheObj = Tcl_DuplicateObj(objPtr);
+ Tcl_IncrRefCount(cacheObj);
+
+ if (allocate(interp, tkwin, cacheObj)) {
+ Tcl_SetHashValue(entryPtr, cacheObj);
+ return cacheObj;
+ } else {
+ Tcl_DecrRefCount(cacheObj);
+ Tcl_SetHashValue(entryPtr, NULL);
+ Tcl_BackgroundException(interp, TCL_ERROR);
+ return NULL;
+ }
+}
+
+/*
+ * Ttk_UseFont --
+ * Acquire a font from the cache.
+ */
+Tcl_Obj *Ttk_UseFont(Ttk_ResourceCache cache, Tk_Window tkwin, Tcl_Obj *objPtr)
+{
+ InitCacheWindow(cache, tkwin);
+ return Ttk_Use(cache->interp,
+ &cache->fontTable,(Allocator)Tk_AllocFontFromObj, tkwin, objPtr);
+}
+
+/*
+ * Ttk_UseColor --
+ * Acquire a color from the cache.
+ */
+Tcl_Obj *Ttk_UseColor(Ttk_ResourceCache cache, Tk_Window tkwin, Tcl_Obj *objPtr)
+{
+ objPtr = CheckNamedColor(cache, objPtr);
+ InitCacheWindow(cache, tkwin);
+ return Ttk_Use(cache->interp,
+ &cache->colorTable,(Allocator)Tk_AllocColorFromObj, tkwin, objPtr);
+}
+
+/*
+ * Ttk_UseBorder --
+ * Acquire a Tk_3DBorder from the cache.
+ */
+Tcl_Obj *Ttk_UseBorder(
+ Ttk_ResourceCache cache, Tk_Window tkwin, Tcl_Obj *objPtr)
+{
+ objPtr = CheckNamedColor(cache, objPtr);
+ InitCacheWindow(cache, tkwin);
+ return Ttk_Use(cache->interp,
+ &cache->borderTable,(Allocator)Tk_Alloc3DBorderFromObj, tkwin, objPtr);
+}
+
+/* NullImageChanged --
+ * Tk_ImageChangedProc for Ttk_UseImage
+ */
+
+static void NullImageChanged(ClientData clientData,
+ int x, int y, int width, int height, int imageWidth, int imageHeight)
+{ /* No-op */ }
+
+/*
+ * Ttk_UseImage --
+ * Acquire a Tk_Image from the cache.
+ */
+Tk_Image Ttk_UseImage(Ttk_ResourceCache cache, Tk_Window tkwin, Tcl_Obj *objPtr)
+{
+ const char *imageName = Tcl_GetString(objPtr);
+ int newEntry;
+ Tcl_HashEntry *entryPtr =
+ Tcl_CreateHashEntry(&cache->imageTable,imageName,&newEntry);
+ Tk_Image image;
+
+ InitCacheWindow(cache, tkwin);
+
+ if (!newEntry) {
+ return Tcl_GetHashValue(entryPtr);
+ }
+
+ image = Tk_GetImage(cache->interp, tkwin, imageName, NullImageChanged,0);
+ Tcl_SetHashValue(entryPtr, image);
+
+ if (!image) {
+ Tcl_BackgroundException(cache->interp, TCL_ERROR);
+ }
+
+ return image;
+}
+
+/*EOF*/
diff --git a/tk8.6/generic/ttk/ttkClamTheme.c b/tk8.6/generic/ttk/ttkClamTheme.c
new file mode 100644
index 0000000..15ebcb7
--- /dev/null
+++ b/tk8.6/generic/ttk/ttkClamTheme.c
@@ -0,0 +1,971 @@
+/*
+ * Copyright (C) 2004 Joe English
+ *
+ * "clam" theme; inspired by the XFCE family of Gnome themes.
+ */
+
+#include <tk.h>
+#include "ttkTheme.h"
+
+/*
+ * Under windows, the Tk-provided XDrawLine and XDrawArc have an
+ * off-by-one error in the end point. This is especially apparent with this
+ * theme. Defining this macro as true handles this case.
+ */
+#if defined(_WIN32) && !defined(WIN32_XDRAWLINE_HACK)
+# define WIN32_XDRAWLINE_HACK 1
+#else
+# define WIN32_XDRAWLINE_HACK 0
+#endif
+
+#define STR(x) StR(x)
+#define StR(x) #x
+
+#define SCROLLBAR_THICKNESS 14
+
+#define FRAME_COLOR "#dcdad5"
+#define LIGHT_COLOR "#ffffff"
+#define DARK_COLOR "#cfcdc8"
+#define DARKER_COLOR "#bab5ab"
+#define DARKEST_COLOR "#9e9a91"
+
+/*------------------------------------------------------------------------
+ * +++ Utilities.
+ */
+
+static GC Ttk_GCForColor(Tk_Window tkwin, Tcl_Obj* colorObj, Drawable d)
+{
+ GC gc = Tk_GCForColor(Tk_GetColorFromObj(tkwin, colorObj), d);
+
+#ifdef MAC_OSX_TK
+ /*
+ * Workaround for Tk bug under Aqua where the default line width is 0.
+ */
+ Display *display = Tk_Display(tkwin);
+ unsigned long mask = 0ul;
+ XGCValues gcValues;
+
+ gcValues.line_width = 1;
+ mask = GCLineWidth;
+
+ XChangeGC(display, gc, mask, &gcValues);
+#endif
+
+ return gc;
+}
+
+static void DrawSmoothBorder(
+ Tk_Window tkwin, Drawable d, Ttk_Box b,
+ Tcl_Obj *outerColorObj, Tcl_Obj *upperColorObj, Tcl_Obj *lowerColorObj)
+{
+ Display *display = Tk_Display(tkwin);
+ int x1 = b.x, x2 = b.x + b.width - 1;
+ int y1 = b.y, y2 = b.y + b.height - 1;
+ const int w = WIN32_XDRAWLINE_HACK;
+ GC gc;
+
+ if ( outerColorObj
+ && (gc=Ttk_GCForColor(tkwin,outerColorObj,d)))
+ {
+ XDrawLine(display,d,gc, x1+1,y1, x2-1+w,y1); /* N */
+ XDrawLine(display,d,gc, x1+1,y2, x2-1+w,y2); /* S */
+ XDrawLine(display,d,gc, x1,y1+1, x1,y2-1+w); /* E */
+ XDrawLine(display,d,gc, x2,y1+1, x2,y2-1+w); /* W */
+ }
+
+ if ( upperColorObj
+ && (gc=Ttk_GCForColor(tkwin,upperColorObj,d)))
+ {
+ XDrawLine(display,d,gc, x1+1,y1+1, x2-1+w,y1+1); /* N */
+ XDrawLine(display,d,gc, x1+1,y1+1, x1+1,y2-1); /* E */
+ }
+
+ if ( lowerColorObj
+ && (gc=Ttk_GCForColor(tkwin,lowerColorObj,d)))
+ {
+ XDrawLine(display,d,gc, x2-1,y2-1, x1+1-w,y2-1); /* S */
+ XDrawLine(display,d,gc, x2-1,y2-1, x2-1,y1+1-w); /* W */
+ }
+}
+
+static GC BackgroundGC(Tk_Window tkwin, Tcl_Obj *backgroundObj)
+{
+ Tk_3DBorder bd = Tk_Get3DBorderFromObj(tkwin, backgroundObj);
+ return Tk_3DBorderGC(tkwin, bd, TK_3D_FLAT_GC);
+}
+
+/*------------------------------------------------------------------------
+ * +++ Border element.
+ */
+
+typedef struct {
+ Tcl_Obj *borderColorObj;
+ Tcl_Obj *lightColorObj;
+ Tcl_Obj *darkColorObj;
+ Tcl_Obj *reliefObj;
+ Tcl_Obj *borderWidthObj; /* See <<NOTE-BORDERWIDTH>> */
+} BorderElement;
+
+static Ttk_ElementOptionSpec BorderElementOptions[] = {
+ { "-bordercolor", TK_OPTION_COLOR,
+ Tk_Offset(BorderElement,borderColorObj), DARKEST_COLOR },
+ { "-lightcolor", TK_OPTION_COLOR,
+ Tk_Offset(BorderElement,lightColorObj), LIGHT_COLOR },
+ { "-darkcolor", TK_OPTION_COLOR,
+ Tk_Offset(BorderElement,darkColorObj), DARK_COLOR },
+ { "-relief", TK_OPTION_RELIEF,
+ Tk_Offset(BorderElement,reliefObj), "flat" },
+ { "-borderwidth", TK_OPTION_PIXELS,
+ Tk_Offset(BorderElement,borderWidthObj), "2" },
+ { NULL, 0, 0, NULL }
+};
+
+/*
+ * <<NOTE-BORDERWIDTH>>: -borderwidth is only partially supported:
+ * in this theme, borders are always exactly 2 pixels thick.
+ * With -borderwidth 0, border is not drawn at all;
+ * otherwise a 2-pixel border is used. For -borderwidth > 2,
+ * the excess is used as padding.
+ */
+
+static void BorderElementSize(
+ void *clientData, void *elementRecord, Tk_Window tkwin,
+ int *widthPtr, int *heightPtr, Ttk_Padding *paddingPtr)
+{
+ BorderElement *border = (BorderElement*)elementRecord;
+ int borderWidth = 2;
+ Tk_GetPixelsFromObj(NULL, tkwin, border->borderWidthObj, &borderWidth);
+ if (borderWidth == 1) ++borderWidth;
+ *paddingPtr = Ttk_UniformPadding((short)borderWidth);
+}
+
+static void BorderElementDraw(
+ void *clientData, void *elementRecord, Tk_Window tkwin,
+ Drawable d, Ttk_Box b, unsigned state)
+{
+ BorderElement *border = elementRecord;
+ int relief = TK_RELIEF_FLAT;
+ int borderWidth = 2;
+ Tcl_Obj *outer = 0, *upper = 0, *lower = 0;
+
+ Tk_GetReliefFromObj(NULL, border->reliefObj, &relief);
+ Tk_GetPixelsFromObj(NULL, tkwin, border->borderWidthObj, &borderWidth);
+
+ if (borderWidth == 0) return;
+
+ switch (relief) {
+ case TK_RELIEF_GROOVE :
+ case TK_RELIEF_RIDGE :
+ case TK_RELIEF_RAISED :
+ outer = border->borderColorObj;
+ upper = border->lightColorObj;
+ lower = border->darkColorObj;
+ break;
+ case TK_RELIEF_SUNKEN :
+ outer = border->borderColorObj;
+ upper = border->darkColorObj;
+ lower = border->lightColorObj;
+ break;
+ case TK_RELIEF_FLAT :
+ outer = upper = lower = 0;
+ break;
+ case TK_RELIEF_SOLID :
+ outer = upper = lower = border->borderColorObj;
+ break;
+ }
+
+ DrawSmoothBorder(tkwin, d, b, outer, upper, lower);
+}
+
+static Ttk_ElementSpec BorderElementSpec = {
+ TK_STYLE_VERSION_2,
+ sizeof(BorderElement),
+ BorderElementOptions,
+ BorderElementSize,
+ BorderElementDraw
+};
+
+/*------------------------------------------------------------------------
+ * +++ Field element.
+ */
+
+typedef struct {
+ Tcl_Obj *borderColorObj;
+ Tcl_Obj *lightColorObj;
+ Tcl_Obj *darkColorObj;
+ Tcl_Obj *backgroundObj;
+} FieldElement;
+
+static Ttk_ElementOptionSpec FieldElementOptions[] = {
+ { "-bordercolor", TK_OPTION_COLOR,
+ Tk_Offset(FieldElement,borderColorObj), DARKEST_COLOR },
+ { "-lightcolor", TK_OPTION_COLOR,
+ Tk_Offset(FieldElement,lightColorObj), LIGHT_COLOR },
+ { "-darkcolor", TK_OPTION_COLOR,
+ Tk_Offset(FieldElement,darkColorObj), DARK_COLOR },
+ { "-fieldbackground", TK_OPTION_BORDER,
+ Tk_Offset(FieldElement,backgroundObj), "white" },
+ { NULL, 0, 0, NULL }
+};
+
+static void FieldElementSize(
+ void *clientData, void *elementRecord, Tk_Window tkwin,
+ int *widthPtr, int *heightPtr, Ttk_Padding *paddingPtr)
+{
+ *paddingPtr = Ttk_UniformPadding(2);
+}
+
+static void FieldElementDraw(
+ void *clientData, void *elementRecord, Tk_Window tkwin,
+ Drawable d, Ttk_Box b, unsigned state)
+{
+ FieldElement *field = elementRecord;
+ Tk_3DBorder bg = Tk_Get3DBorderFromObj(tkwin, field->backgroundObj);
+ Ttk_Box f = Ttk_PadBox(b, Ttk_UniformPadding(2));
+ Tcl_Obj *outer = field->borderColorObj,
+ *inner = field->lightColorObj;
+
+ DrawSmoothBorder(tkwin, d, b, outer, inner, inner);
+ Tk_Fill3DRectangle(
+ tkwin, d, bg, f.x, f.y, f.width, f.height, 0, TK_RELIEF_SUNKEN);
+}
+
+static Ttk_ElementSpec FieldElementSpec = {
+ TK_STYLE_VERSION_2,
+ sizeof(FieldElement),
+ FieldElementOptions,
+ FieldElementSize,
+ FieldElementDraw
+};
+
+/*
+ * Modified field element for comboboxes:
+ * Right edge is expanded to overlap the dropdown button.
+ */
+static void ComboboxFieldElementDraw(
+ void *clientData, void *elementRecord, Tk_Window tkwin,
+ Drawable d, Ttk_Box b, unsigned state)
+{
+ FieldElement *field = elementRecord;
+ GC gc = Ttk_GCForColor(tkwin,field->borderColorObj,d);
+
+ ++b.width;
+ FieldElementDraw(clientData, elementRecord, tkwin, d, b, state);
+
+ XDrawLine(Tk_Display(tkwin), d, gc,
+ b.x + b.width - 1, b.y,
+ b.x + b.width - 1, b.y + b.height - 1 + WIN32_XDRAWLINE_HACK);
+}
+
+static Ttk_ElementSpec ComboboxFieldElementSpec = {
+ TK_STYLE_VERSION_2,
+ sizeof(FieldElement),
+ FieldElementOptions,
+ FieldElementSize,
+ ComboboxFieldElementDraw
+};
+
+/*------------------------------------------------------------------------
+ * +++ Indicator elements for check and radio buttons.
+ */
+
+typedef struct {
+ Tcl_Obj *sizeObj;
+ Tcl_Obj *marginObj;
+ Tcl_Obj *backgroundObj;
+ Tcl_Obj *foregroundObj;
+ Tcl_Obj *upperColorObj;
+ Tcl_Obj *lowerColorObj;
+} IndicatorElement;
+
+static Ttk_ElementOptionSpec IndicatorElementOptions[] = {
+ { "-indicatorsize", TK_OPTION_PIXELS,
+ Tk_Offset(IndicatorElement,sizeObj), "10" },
+ { "-indicatormargin", TK_OPTION_STRING,
+ Tk_Offset(IndicatorElement,marginObj), "1" },
+ { "-indicatorbackground", TK_OPTION_COLOR,
+ Tk_Offset(IndicatorElement,backgroundObj), "white" },
+ { "-indicatorforeground", TK_OPTION_COLOR,
+ Tk_Offset(IndicatorElement,foregroundObj), "black" },
+ { "-upperbordercolor", TK_OPTION_COLOR,
+ Tk_Offset(IndicatorElement,upperColorObj), DARKEST_COLOR },
+ { "-lowerbordercolor", TK_OPTION_COLOR,
+ Tk_Offset(IndicatorElement,lowerColorObj), DARK_COLOR },
+ { NULL, 0, 0, NULL }
+};
+
+static void IndicatorElementSize(
+ void *clientData, void *elementRecord, Tk_Window tkwin,
+ int *widthPtr, int *heightPtr, Ttk_Padding *paddingPtr)
+{
+ IndicatorElement *indicator = elementRecord;
+ Ttk_Padding margins;
+ int size = 10;
+ Ttk_GetPaddingFromObj(NULL, tkwin, indicator->marginObj, &margins);
+ Tk_GetPixelsFromObj(NULL, tkwin, indicator->sizeObj, &size);
+ *widthPtr = size + Ttk_PaddingWidth(margins);
+ *heightPtr = size + Ttk_PaddingHeight(margins);
+}
+
+static void RadioIndicatorElementDraw(
+ void *clientData, void *elementRecord, Tk_Window tkwin,
+ Drawable d, Ttk_Box b, unsigned state)
+{
+ IndicatorElement *indicator = elementRecord;
+ GC gcb=Ttk_GCForColor(tkwin,indicator->backgroundObj,d);
+ GC gcf=Ttk_GCForColor(tkwin,indicator->foregroundObj,d);
+ GC gcu=Ttk_GCForColor(tkwin,indicator->upperColorObj,d);
+ GC gcl=Ttk_GCForColor(tkwin,indicator->lowerColorObj,d);
+ Ttk_Padding padding;
+
+ Ttk_GetPaddingFromObj(NULL, tkwin, indicator->marginObj, &padding);
+ b = Ttk_PadBox(b, padding);
+
+ XFillArc(Tk_Display(tkwin),d,gcb, b.x,b.y,b.width,b.height, 0,360*64);
+ XDrawArc(Tk_Display(tkwin),d,gcl, b.x,b.y,b.width,b.height, 225*64,180*64);
+ XDrawArc(Tk_Display(tkwin),d,gcu, b.x,b.y,b.width,b.height, 45*64,180*64);
+
+ if (state & TTK_STATE_SELECTED) {
+ b = Ttk_PadBox(b,Ttk_UniformPadding(3));
+ XFillArc(Tk_Display(tkwin),d,gcf, b.x,b.y,b.width,b.height, 0,360*64);
+ XDrawArc(Tk_Display(tkwin),d,gcf, b.x,b.y,b.width,b.height, 0,360*64);
+#if WIN32_XDRAWLINE_HACK
+ XDrawArc(Tk_Display(tkwin),d,gcf, b.x,b.y,b.width,b.height, 300*64,360*64);
+#endif
+ }
+}
+
+static void CheckIndicatorElementDraw(
+ void *clientData, void *elementRecord, Tk_Window tkwin,
+ Drawable d, Ttk_Box b, unsigned state)
+{
+ Display *display = Tk_Display(tkwin);
+ IndicatorElement *indicator = elementRecord;
+ GC gcb=Ttk_GCForColor(tkwin,indicator->backgroundObj,d);
+ GC gcf=Ttk_GCForColor(tkwin,indicator->foregroundObj,d);
+ GC gcu=Ttk_GCForColor(tkwin,indicator->upperColorObj,d);
+ GC gcl=Ttk_GCForColor(tkwin,indicator->lowerColorObj,d);
+ Ttk_Padding padding;
+ const int w = WIN32_XDRAWLINE_HACK;
+
+ Ttk_GetPaddingFromObj(NULL, tkwin, indicator->marginObj, &padding);
+ b = Ttk_PadBox(b, padding);
+
+ XFillRectangle(display,d,gcb, b.x,b.y,b.width,b.height);
+ XDrawLine(display,d,gcl,b.x,b.y+b.height,b.x+b.width+w,b.y+b.height);/*S*/
+ XDrawLine(display,d,gcl,b.x+b.width,b.y,b.x+b.width,b.y+b.height+w); /*E*/
+ XDrawLine(display,d,gcu,b.x,b.y, b.x,b.y+b.height+w); /*W*/
+ XDrawLine(display,d,gcu,b.x,b.y, b.x+b.width+w,b.y); /*N*/
+
+ if (state & TTK_STATE_SELECTED) {
+ int p,q,r,s;
+
+ b = Ttk_PadBox(b,Ttk_UniformPadding(2));
+ p = b.x, q = b.y, r = b.x+b.width, s = b.y+b.height;
+
+ r+=w, s+=w;
+ XDrawLine(display, d, gcf, p, q, r, s);
+ XDrawLine(display, d, gcf, p+1, q, r, s-1);
+ XDrawLine(display, d, gcf, p, q+1, r-1, s);
+
+ s-=w, q-=w;
+ XDrawLine(display, d, gcf, p, s, r, q);
+ XDrawLine(display, d, gcf, p+1, s, r, q+1);
+ XDrawLine(display, d, gcf, p, s-1, r-1, q);
+ }
+}
+
+static Ttk_ElementSpec RadioIndicatorElementSpec = {
+ TK_STYLE_VERSION_2,
+ sizeof(IndicatorElement),
+ IndicatorElementOptions,
+ IndicatorElementSize,
+ RadioIndicatorElementDraw
+};
+
+static Ttk_ElementSpec CheckIndicatorElementSpec = {
+ TK_STYLE_VERSION_2,
+ sizeof(IndicatorElement),
+ IndicatorElementOptions,
+ IndicatorElementSize,
+ CheckIndicatorElementDraw
+};
+
+#define MENUBUTTON_ARROW_SIZE 5
+
+typedef struct {
+ Tcl_Obj *sizeObj;
+ Tcl_Obj *colorObj;
+ Tcl_Obj *paddingObj;
+} MenuIndicatorElement;
+
+static Ttk_ElementOptionSpec MenuIndicatorElementOptions[] =
+{
+ { "-arrowsize", TK_OPTION_PIXELS,
+ Tk_Offset(MenuIndicatorElement,sizeObj),
+ STR(MENUBUTTON_ARROW_SIZE)},
+ { "-arrowcolor",TK_OPTION_COLOR,
+ Tk_Offset(MenuIndicatorElement,colorObj),
+ "black" },
+ { "-arrowpadding",TK_OPTION_STRING,
+ Tk_Offset(MenuIndicatorElement,paddingObj),
+ "3" },
+ { NULL, 0, 0, NULL }
+};
+
+static void MenuIndicatorElementSize(
+ void *clientData, void *elementRecord, Tk_Window tkwin,
+ int *widthPtr, int *heightPtr, Ttk_Padding *paddingPtr)
+{
+ MenuIndicatorElement *indicator = elementRecord;
+ Ttk_Padding margins;
+ int size = MENUBUTTON_ARROW_SIZE;
+ Tk_GetPixelsFromObj(NULL, tkwin, indicator->sizeObj, &size);
+ Ttk_GetPaddingFromObj(NULL, tkwin, indicator->paddingObj, &margins);
+ TtkArrowSize(size, ARROW_DOWN, widthPtr, heightPtr);
+ *widthPtr += Ttk_PaddingWidth(margins);
+ *heightPtr += Ttk_PaddingHeight(margins);
+}
+
+static void MenuIndicatorElementDraw(
+ void *clientData, void *elementRecord, Tk_Window tkwin,
+ Drawable d, Ttk_Box b, unsigned int state)
+{
+ MenuIndicatorElement *indicator = elementRecord;
+ XColor *arrowColor = Tk_GetColorFromObj(tkwin, indicator->colorObj);
+ GC gc = Tk_GCForColor(arrowColor, d);
+ int size = MENUBUTTON_ARROW_SIZE;
+ int width, height;
+
+ Tk_GetPixelsFromObj(NULL, tkwin, indicator->sizeObj, &size);
+
+ TtkArrowSize(size, ARROW_DOWN, &width, &height);
+ b = Ttk_StickBox(b, width, height, 0);
+ TtkFillArrow(Tk_Display(tkwin), d, gc, b, ARROW_DOWN);
+}
+
+static Ttk_ElementSpec MenuIndicatorElementSpec =
+{
+ TK_STYLE_VERSION_2,
+ sizeof(MenuIndicatorElement),
+ MenuIndicatorElementOptions,
+ MenuIndicatorElementSize,
+ MenuIndicatorElementDraw
+};
+
+/*------------------------------------------------------------------------
+ * +++ Grips.
+ *
+ * TODO: factor this with ThumbElementDraw
+ */
+
+static Ttk_Orient GripClientData[] = {
+ TTK_ORIENT_HORIZONTAL, TTK_ORIENT_VERTICAL
+};
+
+typedef struct {
+ Tcl_Obj *lightColorObj;
+ Tcl_Obj *borderColorObj;
+ Tcl_Obj *gripCountObj;
+} GripElement;
+
+static Ttk_ElementOptionSpec GripElementOptions[] = {
+ { "-lightcolor", TK_OPTION_COLOR,
+ Tk_Offset(GripElement,lightColorObj), LIGHT_COLOR },
+ { "-bordercolor", TK_OPTION_COLOR,
+ Tk_Offset(GripElement,borderColorObj), DARKEST_COLOR },
+ { "-gripcount", TK_OPTION_INT,
+ Tk_Offset(GripElement,gripCountObj), "5" },
+ { NULL, 0, 0, NULL }
+};
+
+static void GripElementSize(
+ void *clientData, void *elementRecord, Tk_Window tkwin,
+ int *widthPtr, int *heightPtr, Ttk_Padding *paddingPtr)
+{
+ int horizontal = *((Ttk_Orient*)clientData) == TTK_ORIENT_HORIZONTAL;
+ GripElement *grip = elementRecord;
+ int gripCount = 0;
+
+ Tcl_GetIntFromObj(NULL, grip->gripCountObj, &gripCount);
+ if (horizontal) {
+ *widthPtr = 2*gripCount;
+ } else {
+ *heightPtr = 2*gripCount;
+ }
+}
+
+static void GripElementDraw(
+ void *clientData, void *elementRecord, Tk_Window tkwin,
+ Drawable d, Ttk_Box b, unsigned state)
+{
+ const int w = WIN32_XDRAWLINE_HACK;
+ int horizontal = *((Ttk_Orient*)clientData) == TTK_ORIENT_HORIZONTAL;
+ GripElement *grip = elementRecord;
+ GC lightGC = Ttk_GCForColor(tkwin,grip->lightColorObj,d);
+ GC darkGC = Ttk_GCForColor(tkwin,grip->borderColorObj,d);
+ int gripPad = 1, gripCount = 0;
+ int i;
+
+ Tcl_GetIntFromObj(NULL, grip->gripCountObj, &gripCount);
+
+ if (horizontal) {
+ int x = b.x + b.width / 2 - gripCount;
+ int y1 = b.y + gripPad, y2 = b.y + b.height - gripPad - 1 + w;
+ for (i=0; i<gripCount; ++i) {
+ XDrawLine(Tk_Display(tkwin), d, darkGC, x,y1, x,y2); ++x;
+ XDrawLine(Tk_Display(tkwin), d, lightGC, x,y1, x,y2); ++x;
+ }
+ } else {
+ int y = b.y + b.height / 2 - gripCount;
+ int x1 = b.x + gripPad, x2 = b.x + b.width - gripPad - 1 + w;
+ for (i=0; i<gripCount; ++i) {
+ XDrawLine(Tk_Display(tkwin), d, darkGC, x1,y, x2,y); ++y;
+ XDrawLine(Tk_Display(tkwin), d, lightGC, x1,y, x2,y); ++y;
+ }
+ }
+}
+
+static Ttk_ElementSpec GripElementSpec = {
+ TK_STYLE_VERSION_2,
+ sizeof(GripElement),
+ GripElementOptions,
+ GripElementSize,
+ GripElementDraw
+};
+
+/*------------------------------------------------------------------------
+ * +++ Scrollbar elements: trough, arrows, thumb.
+ *
+ * Notice that the trough element has 0 internal padding;
+ * that way the thumb and arrow borders overlap the trough.
+ */
+
+typedef struct { /* Common element record for scrollbar elements */
+ Tcl_Obj *orientObj;
+ Tcl_Obj *backgroundObj;
+ Tcl_Obj *borderColorObj;
+ Tcl_Obj *troughColorObj;
+ Tcl_Obj *lightColorObj;
+ Tcl_Obj *darkColorObj;
+ Tcl_Obj *arrowColorObj;
+ Tcl_Obj *arrowSizeObj;
+ Tcl_Obj *gripCountObj;
+ Tcl_Obj *sliderlengthObj;
+} ScrollbarElement;
+
+static Ttk_ElementOptionSpec ScrollbarElementOptions[] = {
+ { "-orient", TK_OPTION_ANY,
+ Tk_Offset(ScrollbarElement, orientObj), "horizontal" },
+ { "-background", TK_OPTION_BORDER,
+ Tk_Offset(ScrollbarElement,backgroundObj), FRAME_COLOR },
+ { "-bordercolor", TK_OPTION_COLOR,
+ Tk_Offset(ScrollbarElement,borderColorObj), DARKEST_COLOR },
+ { "-troughcolor", TK_OPTION_COLOR,
+ Tk_Offset(ScrollbarElement,troughColorObj), DARKER_COLOR },
+ { "-lightcolor", TK_OPTION_COLOR,
+ Tk_Offset(ScrollbarElement,lightColorObj), LIGHT_COLOR },
+ { "-darkcolor", TK_OPTION_COLOR,
+ Tk_Offset(ScrollbarElement,darkColorObj), DARK_COLOR },
+ { "-arrowcolor", TK_OPTION_COLOR,
+ Tk_Offset(ScrollbarElement,arrowColorObj), "#000000" },
+ { "-arrowsize", TK_OPTION_PIXELS,
+ Tk_Offset(ScrollbarElement,arrowSizeObj), STR(SCROLLBAR_THICKNESS) },
+ { "-gripcount", TK_OPTION_INT,
+ Tk_Offset(ScrollbarElement,gripCountObj), "5" },
+ { "-sliderlength", TK_OPTION_INT,
+ Tk_Offset(ScrollbarElement,sliderlengthObj), "30" },
+ { NULL, 0, 0, NULL }
+};
+
+static void TroughElementDraw(
+ void *clientData, void *elementRecord, Tk_Window tkwin,
+ Drawable d, Ttk_Box b, unsigned state)
+{
+ ScrollbarElement *sb = elementRecord;
+ GC gcb = Ttk_GCForColor(tkwin,sb->borderColorObj,d);
+ GC gct = Ttk_GCForColor(tkwin,sb->troughColorObj,d);
+ XFillRectangle(Tk_Display(tkwin), d, gct, b.x, b.y, b.width-1, b.height-1);
+ XDrawRectangle(Tk_Display(tkwin), d, gcb, b.x, b.y, b.width-1, b.height-1);
+}
+
+static Ttk_ElementSpec TroughElementSpec = {
+ TK_STYLE_VERSION_2,
+ sizeof(ScrollbarElement),
+ ScrollbarElementOptions,
+ TtkNullElementSize,
+ TroughElementDraw
+};
+
+static void ThumbElementSize(
+ void *clientData, void *elementRecord, Tk_Window tkwin,
+ int *widthPtr, int *heightPtr, Ttk_Padding *paddingPtr)
+{
+ ScrollbarElement *sb = elementRecord;
+ int size = SCROLLBAR_THICKNESS;
+ Tcl_GetIntFromObj(NULL, sb->arrowSizeObj, &size);
+ *widthPtr = *heightPtr = size;
+}
+
+static void ThumbElementDraw(
+ void *clientData, void *elementRecord, Tk_Window tkwin,
+ Drawable d, Ttk_Box b, unsigned state)
+{
+ ScrollbarElement *sb = elementRecord;
+ int gripCount = 0, orient = TTK_ORIENT_HORIZONTAL;
+ GC lightGC, darkGC;
+ int x1, y1, x2, y2, dx, dy, i;
+ const int w = WIN32_XDRAWLINE_HACK;
+
+ DrawSmoothBorder(tkwin, d, b,
+ sb->borderColorObj, sb->lightColorObj, sb->darkColorObj);
+ XFillRectangle(
+ Tk_Display(tkwin), d, BackgroundGC(tkwin, sb->backgroundObj),
+ b.x+2, b.y+2, b.width-4, b.height-4);
+
+ /*
+ * Draw grip:
+ */
+ Ttk_GetOrientFromObj(NULL, sb->orientObj, &orient);
+ Tcl_GetIntFromObj(NULL, sb->gripCountObj, &gripCount);
+ lightGC = Ttk_GCForColor(tkwin,sb->lightColorObj,d);
+ darkGC = Ttk_GCForColor(tkwin,sb->borderColorObj,d);
+
+ if (orient == TTK_ORIENT_HORIZONTAL) {
+ dx = 1; dy = 0;
+ x1 = x2 = b.x + b.width / 2 - gripCount;
+ y1 = b.y + 2;
+ y2 = b.y + b.height - 3 + w;
+ } else {
+ dx = 0; dy = 1;
+ y1 = y2 = b.y + b.height / 2 - gripCount;
+ x1 = b.x + 2;
+ x2 = b.x + b.width - 3 + w;
+ }
+
+ for (i=0; i<gripCount; ++i) {
+ XDrawLine(Tk_Display(tkwin), d, darkGC, x1,y1, x2,y2);
+ x1 += dx; x2 += dx; y1 += dy; y2 += dy;
+ XDrawLine(Tk_Display(tkwin), d, lightGC, x1,y1, x2,y2);
+ x1 += dx; x2 += dx; y1 += dy; y2 += dy;
+ }
+}
+
+static Ttk_ElementSpec ThumbElementSpec = {
+ TK_STYLE_VERSION_2,
+ sizeof(ScrollbarElement),
+ ScrollbarElementOptions,
+ ThumbElementSize,
+ ThumbElementDraw
+};
+
+/*------------------------------------------------------------------------
+ * +++ Slider element.
+ */
+static void SliderElementSize(
+ void *clientData, void *elementRecord, Tk_Window tkwin,
+ int *widthPtr, int *heightPtr, Ttk_Padding *paddingPtr)
+{
+ ScrollbarElement *sb = elementRecord;
+ int length, thickness, orient;
+
+ length = thickness = SCROLLBAR_THICKNESS;
+ Ttk_GetOrientFromObj(NULL, sb->orientObj, &orient);
+ Tcl_GetIntFromObj(NULL, sb->arrowSizeObj, &thickness);
+ Tk_GetPixelsFromObj(NULL, tkwin, sb->sliderlengthObj, &length);
+ if (orient == TTK_ORIENT_VERTICAL) {
+ *heightPtr = length;
+ *widthPtr = thickness;
+ } else {
+ *heightPtr = thickness;
+ *widthPtr = length;
+ }
+
+}
+
+static Ttk_ElementSpec SliderElementSpec = {
+ TK_STYLE_VERSION_2,
+ sizeof(ScrollbarElement),
+ ScrollbarElementOptions,
+ SliderElementSize,
+ ThumbElementDraw
+};
+
+/*------------------------------------------------------------------------
+ * +++ Progress bar element
+ */
+static void PbarElementSize(
+ void *clientData, void *elementRecord, Tk_Window tkwin,
+ int *widthPtr, int *heightPtr, Ttk_Padding *paddingPtr)
+{
+ SliderElementSize(clientData, elementRecord, tkwin,
+ widthPtr, heightPtr, paddingPtr);
+ *paddingPtr = Ttk_UniformPadding(2);
+ *widthPtr += 4;
+ *heightPtr += 4;
+}
+
+static void PbarElementDraw(
+ void *clientData, void *elementRecord, Tk_Window tkwin,
+ Drawable d, Ttk_Box b, unsigned state)
+{
+ ScrollbarElement *sb = elementRecord;
+
+ b = Ttk_PadBox(b, Ttk_UniformPadding(2));
+ if (b.width > 4 && b.height > 4) {
+ DrawSmoothBorder(tkwin, d, b,
+ sb->borderColorObj, sb->lightColorObj, sb->darkColorObj);
+ XFillRectangle(Tk_Display(tkwin), d,
+ BackgroundGC(tkwin, sb->backgroundObj),
+ b.x+2, b.y+2, b.width-4, b.height-4);
+ }
+}
+
+static Ttk_ElementSpec PbarElementSpec = {
+ TK_STYLE_VERSION_2,
+ sizeof(ScrollbarElement),
+ ScrollbarElementOptions,
+ PbarElementSize,
+ PbarElementDraw
+};
+
+
+/*------------------------------------------------------------------------
+ * +++ Scrollbar arrows.
+ */
+static int ArrowElements[] = { ARROW_UP, ARROW_DOWN, ARROW_LEFT, ARROW_RIGHT };
+
+static void ArrowElementSize(
+ void *clientData, void *elementRecord, Tk_Window tkwin,
+ int *widthPtr, int *heightPtr, Ttk_Padding *paddingPtr)
+{
+ ScrollbarElement *sb = elementRecord;
+ int size = SCROLLBAR_THICKNESS;
+ Tcl_GetIntFromObj(NULL, sb->arrowSizeObj, &size);
+ *widthPtr = *heightPtr = size;
+}
+
+static void ArrowElementDraw(
+ void *clientData, void *elementRecord, Tk_Window tkwin,
+ Drawable d, Ttk_Box b, unsigned state)
+{
+ ArrowDirection dir = *(ArrowDirection*)clientData;
+ ScrollbarElement *sb = elementRecord;
+ GC gc = Ttk_GCForColor(tkwin,sb->arrowColorObj, d);
+ int h, cx, cy;
+
+ DrawSmoothBorder(tkwin, d, b,
+ sb->borderColorObj, sb->lightColorObj, sb->darkColorObj);
+
+ XFillRectangle(
+ Tk_Display(tkwin), d, BackgroundGC(tkwin, sb->backgroundObj),
+ b.x+2, b.y+2, b.width-4, b.height-4);
+
+ b = Ttk_PadBox(b, Ttk_UniformPadding(3));
+ h = b.width < b.height ? b.width : b.height;
+ TtkArrowSize(h/2, dir, &cx, &cy);
+ b = Ttk_AnchorBox(b, cx, cy, TK_ANCHOR_CENTER);
+
+ TtkFillArrow(Tk_Display(tkwin), d, gc, b, dir);
+}
+
+static Ttk_ElementSpec ArrowElementSpec = {
+ TK_STYLE_VERSION_2,
+ sizeof(ScrollbarElement),
+ ScrollbarElementOptions,
+ ArrowElementSize,
+ ArrowElementDraw
+};
+
+
+/*------------------------------------------------------------------------
+ * +++ Notebook elements.
+ *
+ * Note: Tabs, except for the rightmost, overlap the neighbor to
+ * their right by one pixel.
+ */
+
+typedef struct {
+ Tcl_Obj *backgroundObj;
+ Tcl_Obj *borderColorObj;
+ Tcl_Obj *lightColorObj;
+ Tcl_Obj *darkColorObj;
+} NotebookElement;
+
+static Ttk_ElementOptionSpec NotebookElementOptions[] = {
+ { "-background", TK_OPTION_BORDER,
+ Tk_Offset(NotebookElement,backgroundObj), FRAME_COLOR },
+ { "-bordercolor", TK_OPTION_COLOR,
+ Tk_Offset(NotebookElement,borderColorObj), DARKEST_COLOR },
+ { "-lightcolor", TK_OPTION_COLOR,
+ Tk_Offset(NotebookElement,lightColorObj), LIGHT_COLOR },
+ { "-darkcolor", TK_OPTION_COLOR,
+ Tk_Offset(NotebookElement,darkColorObj), DARK_COLOR },
+ { NULL, 0, 0, NULL }
+};
+
+static void TabElementSize(
+ void *clientData, void *elementRecord, Tk_Window tkwin,
+ int *widthPtr, int *heightPtr, Ttk_Padding *paddingPtr)
+{
+ int borderWidth = 2;
+ paddingPtr->top = paddingPtr->left = paddingPtr->right = borderWidth;
+ paddingPtr->bottom = 0;
+}
+
+static void TabElementDraw(
+ void *clientData, void *elementRecord, Tk_Window tkwin,
+ Drawable d, Ttk_Box b, unsigned int state)
+{
+ NotebookElement *tab = elementRecord;
+ Tk_3DBorder border = Tk_Get3DBorderFromObj(tkwin, tab->backgroundObj);
+ Display *display = Tk_Display(tkwin);
+ int borderWidth = 2, dh = 0;
+ int x1,y1,x2,y2;
+ GC gc;
+ const int w = WIN32_XDRAWLINE_HACK;
+
+ if (state & TTK_STATE_SELECTED) {
+ dh = borderWidth;
+ }
+
+ if (state & TTK_STATE_USER2) { /* Rightmost tab */
+ --b.width;
+ }
+
+ Tk_Fill3DRectangle(tkwin, d, border,
+ b.x+2, b.y+2, b.width-1, b.height-2+dh, borderWidth, TK_RELIEF_FLAT);
+
+ x1 = b.x, x2 = b.x + b.width;
+ y1 = b.y, y2 = b.y + b.height;
+
+
+ gc=Ttk_GCForColor(tkwin,tab->borderColorObj,d);
+ XDrawLine(display,d,gc, x1,y1+1, x1,y2+w);
+ XDrawLine(display,d,gc, x2,y1+1, x2,y2+w);
+ XDrawLine(display,d,gc, x1+1,y1, x2-1+w,y1);
+
+ gc=Ttk_GCForColor(tkwin,tab->lightColorObj,d);
+ XDrawLine(display,d,gc, x1+1,y1+1, x1+1,y2-1+dh+w);
+ XDrawLine(display,d,gc, x1+1,y1+1, x2-1+w,y1+1);
+}
+
+static Ttk_ElementSpec TabElementSpec =
+{
+ TK_STYLE_VERSION_2,
+ sizeof(NotebookElement),
+ NotebookElementOptions,
+ TabElementSize,
+ TabElementDraw
+};
+
+static void ClientElementSize(
+ void *clientData, void *elementRecord, Tk_Window tkwin,
+ int *widthPtr, int *heightPtr, Ttk_Padding *paddingPtr)
+{
+ int borderWidth = 2;
+ *paddingPtr = Ttk_UniformPadding((short)borderWidth);
+}
+
+static void ClientElementDraw(
+ void *clientData, void *elementRecord, Tk_Window tkwin,
+ Drawable d, Ttk_Box b, unsigned int state)
+{
+ NotebookElement *ce = elementRecord;
+ Tk_3DBorder border = Tk_Get3DBorderFromObj(tkwin, ce->backgroundObj);
+ int borderWidth = 2;
+
+ Tk_Fill3DRectangle(tkwin, d, border,
+ b.x, b.y, b.width, b.height, borderWidth,TK_RELIEF_FLAT);
+ DrawSmoothBorder(tkwin, d, b,
+ ce->borderColorObj, ce->lightColorObj, ce->darkColorObj);
+}
+
+static Ttk_ElementSpec ClientElementSpec =
+{
+ TK_STYLE_VERSION_2,
+ sizeof(NotebookElement),
+ NotebookElementOptions,
+ ClientElementSize,
+ ClientElementDraw
+};
+
+/*------------------------------------------------------------------------
+ * +++ Modified widget layouts.
+ */
+
+TTK_BEGIN_LAYOUT_TABLE(LayoutTable)
+
+TTK_LAYOUT("TCombobox",
+ TTK_NODE("Combobox.downarrow", TTK_PACK_RIGHT|TTK_FILL_Y)
+ TTK_GROUP("Combobox.field", TTK_PACK_LEFT|TTK_FILL_BOTH|TTK_EXPAND,
+ TTK_GROUP("Combobox.padding", TTK_FILL_BOTH,
+ TTK_NODE("Combobox.textarea", TTK_FILL_BOTH))))
+
+TTK_LAYOUT("Horizontal.Sash",
+ TTK_GROUP("Sash.hsash", TTK_FILL_BOTH,
+ TTK_NODE("Sash.hgrip", TTK_FILL_BOTH)))
+
+TTK_LAYOUT("Vertical.Sash",
+ TTK_GROUP("Sash.vsash", TTK_FILL_BOTH,
+ TTK_NODE("Sash.vgrip", TTK_FILL_BOTH)))
+
+TTK_END_LAYOUT_TABLE
+
+/*------------------------------------------------------------------------
+ * +++ Initialization.
+ */
+
+MODULE_SCOPE int
+TtkClamTheme_Init(Tcl_Interp *interp)
+{
+ Ttk_Theme theme = Ttk_CreateTheme(interp, "clam", 0);
+
+ if (!theme) {
+ return TCL_ERROR;
+ }
+
+ Ttk_RegisterElement(interp,
+ theme, "border", &BorderElementSpec, NULL);
+ Ttk_RegisterElement(interp,
+ theme, "field", &FieldElementSpec, NULL);
+ Ttk_RegisterElement(interp,
+ theme, "Combobox.field", &ComboboxFieldElementSpec, NULL);
+ Ttk_RegisterElement(interp,
+ theme, "trough", &TroughElementSpec, NULL);
+ Ttk_RegisterElement(interp,
+ theme, "thumb", &ThumbElementSpec, NULL);
+ Ttk_RegisterElement(interp,
+ theme, "uparrow", &ArrowElementSpec, &ArrowElements[0]);
+ Ttk_RegisterElement(interp,
+ theme, "downarrow", &ArrowElementSpec, &ArrowElements[1]);
+ Ttk_RegisterElement(interp,
+ theme, "leftarrow", &ArrowElementSpec, &ArrowElements[2]);
+ Ttk_RegisterElement(interp,
+ theme, "rightarrow", &ArrowElementSpec, &ArrowElements[3]);
+
+ Ttk_RegisterElement(interp,
+ theme, "Radiobutton.indicator", &RadioIndicatorElementSpec, NULL);
+ Ttk_RegisterElement(interp,
+ theme, "Checkbutton.indicator", &CheckIndicatorElementSpec, NULL);
+ Ttk_RegisterElement(interp,
+ theme, "Menubutton.indicator", &MenuIndicatorElementSpec, NULL);
+
+ Ttk_RegisterElement(interp, theme, "tab", &TabElementSpec, NULL);
+ Ttk_RegisterElement(interp, theme, "client", &ClientElementSpec, NULL);
+
+ Ttk_RegisterElement(interp, theme, "slider", &SliderElementSpec, NULL);
+ Ttk_RegisterElement(interp, theme, "bar", &PbarElementSpec, NULL);
+ Ttk_RegisterElement(interp, theme, "pbar", &PbarElementSpec, NULL);
+
+ Ttk_RegisterElement(interp, theme, "hgrip",
+ &GripElementSpec, &GripClientData[0]);
+ Ttk_RegisterElement(interp, theme, "vgrip",
+ &GripElementSpec, &GripClientData[1]);
+
+ Ttk_RegisterLayouts(theme, LayoutTable);
+
+ Tcl_PkgProvide(interp, "ttk::theme::clam", TTK_VERSION);
+
+ return TCL_OK;
+}
diff --git a/tk8.6/generic/ttk/ttkClassicTheme.c b/tk8.6/generic/ttk/ttkClassicTheme.c
new file mode 100644
index 0000000..2fbcd76
--- /dev/null
+++ b/tk8.6/generic/ttk/ttkClassicTheme.c
@@ -0,0 +1,513 @@
+/*
+ * Copyright (c) 2004, Joe English
+ *
+ * "classic" theme; implements the classic Motif-like Tk look.
+ *
+ */
+
+#include <tk.h>
+#include <X11/Xlib.h>
+#include <X11/Xutil.h>
+#include "ttkTheme.h"
+
+#define DEFAULT_BORDERWIDTH "2"
+#define DEFAULT_ARROW_SIZE "15"
+
+/*----------------------------------------------------------------------
+ * +++ Highlight element implementation.
+ * Draw a solid highlight border to indicate focus.
+ */
+
+typedef struct {
+ Tcl_Obj *highlightColorObj;
+ Tcl_Obj *highlightThicknessObj;
+} HighlightElement;
+
+static Ttk_ElementOptionSpec HighlightElementOptions[] = {
+ { "-highlightcolor",TK_OPTION_COLOR,
+ Tk_Offset(HighlightElement,highlightColorObj), DEFAULT_BACKGROUND },
+ { "-highlightthickness",TK_OPTION_PIXELS,
+ Tk_Offset(HighlightElement,highlightThicknessObj), "0" },
+ { NULL, 0, 0, NULL }
+};
+
+static void HighlightElementSize(
+ void *clientData, void *elementRecord, Tk_Window tkwin,
+ int *widthPtr, int *heightPtr, Ttk_Padding *paddingPtr)
+{
+ HighlightElement *hl = elementRecord;
+ int highlightThickness = 0;
+
+ Tcl_GetIntFromObj(NULL,hl->highlightThicknessObj,&highlightThickness);
+ *paddingPtr = Ttk_UniformPadding((short)highlightThickness);
+}
+
+static void HighlightElementDraw(
+ void *clientData, void *elementRecord, Tk_Window tkwin,
+ Drawable d, Ttk_Box b, unsigned int state)
+{
+ HighlightElement *hl = elementRecord;
+ int highlightThickness = 0;
+ XColor *highlightColor = Tk_GetColorFromObj(tkwin, hl->highlightColorObj);
+
+ Tcl_GetIntFromObj(NULL,hl->highlightThicknessObj,&highlightThickness);
+ if (highlightColor && highlightThickness > 0) {
+ GC gc = Tk_GCForColor(highlightColor, d);
+ Tk_DrawFocusHighlight(tkwin, gc, highlightThickness, d);
+ }
+}
+
+static Ttk_ElementSpec HighlightElementSpec =
+{
+ TK_STYLE_VERSION_2,
+ sizeof(HighlightElement),
+ HighlightElementOptions,
+ HighlightElementSize,
+ HighlightElementDraw
+};
+
+/*------------------------------------------------------------------------
+ * +++ Button Border element:
+ *
+ * The Motif-style button border on X11 consists of (from outside-in):
+ *
+ * + focus indicator (controlled by -highlightcolor and -highlightthickness),
+ * + default ring (if -default active; blank if -default normal)
+ * + shaded border (controlled by -background, -borderwidth, and -relief)
+ */
+
+typedef struct {
+ Tcl_Obj *borderObj;
+ Tcl_Obj *borderWidthObj;
+ Tcl_Obj *reliefObj;
+ Tcl_Obj *defaultStateObj;
+} ButtonBorderElement;
+
+static Ttk_ElementOptionSpec ButtonBorderElementOptions[] =
+{
+ { "-background", TK_OPTION_BORDER,
+ Tk_Offset(ButtonBorderElement,borderObj), DEFAULT_BACKGROUND },
+ { "-borderwidth", TK_OPTION_PIXELS,
+ Tk_Offset(ButtonBorderElement,borderWidthObj), DEFAULT_BORDERWIDTH },
+ { "-relief", TK_OPTION_RELIEF,
+ Tk_Offset(ButtonBorderElement,reliefObj), "flat" },
+ { "-default", TK_OPTION_ANY,
+ Tk_Offset(ButtonBorderElement,defaultStateObj), "disabled" },
+ { NULL, 0, 0, NULL }
+};
+
+static void ButtonBorderElementSize(
+ void *clientData, void *elementRecord, Tk_Window tkwin,
+ int *widthPtr, int *heightPtr, Ttk_Padding *paddingPtr)
+{
+ ButtonBorderElement *bd = elementRecord;
+ int defaultState = TTK_BUTTON_DEFAULT_DISABLED;
+ int borderWidth = 0;
+
+ Tcl_GetIntFromObj(NULL, bd->borderWidthObj, &borderWidth);
+ Ttk_GetButtonDefaultStateFromObj(NULL, bd->defaultStateObj, &defaultState);
+
+ if (defaultState != TTK_BUTTON_DEFAULT_DISABLED) {
+ borderWidth += 5;
+ }
+ *paddingPtr = Ttk_UniformPadding((short)borderWidth);
+}
+
+/*
+ * (@@@ Note: ButtonBorderElement still still still buggy:
+ * padding for default ring is drawn in the wrong color
+ * when the button is active.)
+ */
+static void ButtonBorderElementDraw(
+ void *clientData, void *elementRecord, Tk_Window tkwin,
+ Drawable d, Ttk_Box b, unsigned int state)
+{
+ ButtonBorderElement *bd = elementRecord;
+ Tk_3DBorder border = NULL;
+ int borderWidth = 1, relief = TK_RELIEF_FLAT;
+ int defaultState = TTK_BUTTON_DEFAULT_DISABLED;
+ int inset = 0;
+
+ /*
+ * Get option values.
+ */
+ border = Tk_Get3DBorderFromObj(tkwin, bd->borderObj);
+ Tcl_GetIntFromObj(NULL, bd->borderWidthObj, &borderWidth);
+ Tk_GetReliefFromObj(NULL, bd->reliefObj, &relief);
+ Ttk_GetButtonDefaultStateFromObj(NULL, bd->defaultStateObj, &defaultState);
+
+ /*
+ * Default ring:
+ */
+ switch (defaultState)
+ {
+ case TTK_BUTTON_DEFAULT_DISABLED :
+ break;
+ case TTK_BUTTON_DEFAULT_NORMAL :
+ inset += 5;
+ break;
+ case TTK_BUTTON_DEFAULT_ACTIVE :
+ Tk_Draw3DRectangle(tkwin, d, border,
+ b.x+inset, b.y+inset, b.width - 2*inset, b.height - 2*inset,
+ 2, TK_RELIEF_FLAT);
+ inset += 2;
+ Tk_Draw3DRectangle(tkwin, d, border,
+ b.x+inset, b.y+inset, b.width - 2*inset, b.height - 2*inset,
+ 1, TK_RELIEF_SUNKEN);
+ ++inset;
+ Tk_Draw3DRectangle(tkwin, d, border,
+ b.x+inset, b.y+inset, b.width - 2*inset, b.height - 2*inset,
+ 2, TK_RELIEF_FLAT);
+ inset += 2;
+ break;
+ }
+
+ /*
+ * 3-D border:
+ */
+ if (border && borderWidth > 0) {
+ Tk_Draw3DRectangle(tkwin, d, border,
+ b.x+inset, b.y+inset, b.width - 2*inset, b.height - 2*inset,
+ borderWidth,relief);
+ }
+}
+
+static Ttk_ElementSpec ButtonBorderElementSpec =
+{
+ TK_STYLE_VERSION_2,
+ sizeof(ButtonBorderElement),
+ ButtonBorderElementOptions,
+ ButtonBorderElementSize,
+ ButtonBorderElementDraw
+};
+
+/*----------------------------------------------------------------------
+ * +++ Arrow element(s).
+ *
+ * Draws a 3-D shaded triangle.
+ * clientData is an enum ArrowDirection pointer.
+ */
+
+static int ArrowElements[] = { ARROW_UP, ARROW_DOWN, ARROW_LEFT, ARROW_RIGHT };
+typedef struct
+{
+ Tcl_Obj *sizeObj;
+ Tcl_Obj *borderObj;
+ Tcl_Obj *borderWidthObj;
+ Tcl_Obj *reliefObj;
+} ArrowElement;
+
+static Ttk_ElementOptionSpec ArrowElementOptions[] =
+{
+ { "-arrowsize", TK_OPTION_PIXELS, Tk_Offset(ArrowElement,sizeObj),
+ DEFAULT_ARROW_SIZE },
+ { "-background", TK_OPTION_BORDER, Tk_Offset(ArrowElement,borderObj),
+ DEFAULT_BACKGROUND },
+ { "-borderwidth", TK_OPTION_PIXELS, Tk_Offset(ArrowElement,borderWidthObj),
+ DEFAULT_BORDERWIDTH },
+ { "-relief", TK_OPTION_RELIEF, Tk_Offset(ArrowElement,reliefObj),"raised" },
+ { NULL, 0, 0, NULL }
+};
+
+static void ArrowElementSize(
+ void *clientData, void *elementRecord, Tk_Window tkwin,
+ int *widthPtr, int *heightPtr, Ttk_Padding *paddingPtr)
+{
+ ArrowElement *arrow = elementRecord;
+ int size = 12;
+
+ Tk_GetPixelsFromObj(NULL, tkwin, arrow->sizeObj, &size);
+ *widthPtr = *heightPtr = size;
+}
+
+static void ArrowElementDraw(
+ void *clientData, void *elementRecord, Tk_Window tkwin,
+ Drawable d, Ttk_Box b, unsigned int state)
+{
+ int direction = *(int *)clientData;
+ ArrowElement *arrow = elementRecord;
+ Tk_3DBorder border = Tk_Get3DBorderFromObj(tkwin, arrow->borderObj);
+ int borderWidth = 2;
+ int relief = TK_RELIEF_RAISED;
+ int size = b.width < b.height ? b.width : b.height;
+ XPoint points[3];
+
+ Tk_GetPixelsFromObj(NULL, tkwin, arrow->borderWidthObj, &borderWidth);
+ Tk_GetReliefFromObj(NULL, arrow->reliefObj, &relief);
+
+
+ /*
+ * @@@ There are off-by-one pixel errors in the way these are drawn;
+ * @@@ need to take a look at Tk_Fill3DPolygon and X11 to find the
+ * @@@ exact rules.
+ */
+ switch (direction)
+ {
+ case ARROW_UP:
+ points[2].x = b.x; points[2].y = b.y + size;
+ points[1].x = b.x + size/2; points[1].y = b.y;
+ points[0].x = b.x + size; points[0].y = b.y + size;
+ break;
+ case ARROW_DOWN:
+ points[0].x = b.x; points[0].y = b.y;
+ points[1].x = b.x + size/2; points[1].y = b.y + size;
+ points[2].x = b.x + size; points[2].y = b.y;
+ break;
+ case ARROW_LEFT:
+ points[0].x = b.x; points[0].y = b.y + size / 2;
+ points[1].x = b.x + size; points[1].y = b.y + size;
+ points[2].x = b.x + size; points[2].y = b.y;
+ break;
+ case ARROW_RIGHT:
+ points[0].x = b.x + size; points[0].y = b.y + size / 2;
+ points[1].x = b.x; points[1].y = b.y;
+ points[2].x = b.x; points[2].y = b.y + size;
+ break;
+ }
+
+ Tk_Fill3DPolygon(tkwin, d, border, points, 3, borderWidth, relief);
+}
+
+static Ttk_ElementSpec ArrowElementSpec =
+{
+ TK_STYLE_VERSION_2,
+ sizeof(ArrowElement),
+ ArrowElementOptions,
+ ArrowElementSize,
+ ArrowElementDraw
+};
+
+
+/*------------------------------------------------------------------------
+ * +++ Sash element (for ttk::panedwindow)
+ *
+ * NOTES:
+ *
+ * panedwindows with -orient horizontal use vertical sashes, and vice versa.
+ *
+ * Interpretation of -sashrelief 'groove' and 'ridge' are
+ * swapped wrt. the core panedwindow, which (I think) has them backwards.
+ *
+ * Default -sashrelief is sunken; the core panedwindow has default
+ * -sashrelief raised, but that looks wrong to me.
+ */
+
+static Ttk_Orient SashClientData[] = {
+ TTK_ORIENT_HORIZONTAL, TTK_ORIENT_VERTICAL
+};
+
+typedef struct {
+ Tcl_Obj *borderObj; /* background color */
+ Tcl_Obj *sashReliefObj; /* sash relief */
+ Tcl_Obj *sashThicknessObj; /* overall thickness of sash */
+ Tcl_Obj *sashPadObj; /* padding on either side of handle */
+ Tcl_Obj *handleSizeObj; /* handle width and height */
+ Tcl_Obj *handlePadObj; /* handle's distance from edge */
+} SashElement;
+
+static Ttk_ElementOptionSpec SashOptions[] = {
+ { "-background", TK_OPTION_BORDER,
+ Tk_Offset(SashElement,borderObj), DEFAULT_BACKGROUND },
+ { "-sashrelief", TK_OPTION_RELIEF,
+ Tk_Offset(SashElement,sashReliefObj), "sunken" },
+ { "-sashthickness", TK_OPTION_PIXELS,
+ Tk_Offset(SashElement,sashThicknessObj), "6" },
+ { "-sashpad", TK_OPTION_PIXELS,
+ Tk_Offset(SashElement,sashPadObj), "2" },
+ { "-handlesize", TK_OPTION_PIXELS,
+ Tk_Offset(SashElement,handleSizeObj), "8" },
+ { "-handlepad", TK_OPTION_PIXELS,
+ Tk_Offset(SashElement,handlePadObj), "8" },
+ { NULL, 0, 0, NULL }
+};
+
+static void SashElementSize(
+ void *clientData, void *elementRecord, Tk_Window tkwin,
+ int *widthPtr, int *heightPtr, Ttk_Padding *paddingPtr)
+{
+ SashElement *sash = elementRecord;
+ int sashPad = 2, sashThickness = 6, handleSize = 8;
+ int horizontal = *((Ttk_Orient*)clientData) == TTK_ORIENT_HORIZONTAL;
+
+ Tk_GetPixelsFromObj(NULL, tkwin, sash->sashThicknessObj, &sashThickness);
+ Tk_GetPixelsFromObj(NULL, tkwin, sash->handleSizeObj, &handleSize);
+ Tk_GetPixelsFromObj(NULL, tkwin, sash->sashPadObj, &sashPad);
+
+ if (sashThickness < handleSize + 2*sashPad)
+ sashThickness = handleSize + 2*sashPad;
+
+ if (horizontal)
+ *heightPtr = sashThickness;
+ else
+ *widthPtr = sashThickness;
+}
+
+static void SashElementDraw(
+ void *clientData, void *elementRecord, Tk_Window tkwin,
+ Drawable d, Ttk_Box b, Ttk_State state)
+{
+ SashElement *sash = elementRecord;
+ Tk_3DBorder border = Tk_Get3DBorderFromObj(tkwin, sash->borderObj);
+ GC gc1,gc2;
+ int relief = TK_RELIEF_RAISED;
+ int handleSize = 8, handlePad = 8;
+ int horizontal = *((Ttk_Orient*)clientData) == TTK_ORIENT_HORIZONTAL;
+ Ttk_Box hb;
+
+ Tk_GetPixelsFromObj(NULL, tkwin, sash->handleSizeObj, &handleSize);
+ Tk_GetPixelsFromObj(NULL, tkwin, sash->handlePadObj, &handlePad);
+ Tk_GetReliefFromObj(NULL, sash->sashReliefObj, &relief);
+
+ switch (relief) {
+ case TK_RELIEF_RAISED: case TK_RELIEF_RIDGE:
+ gc1 = Tk_3DBorderGC(tkwin, border, TK_3D_LIGHT_GC);
+ gc2 = Tk_3DBorderGC(tkwin, border, TK_3D_DARK_GC);
+ break;
+ case TK_RELIEF_SUNKEN: case TK_RELIEF_GROOVE:
+ gc1 = Tk_3DBorderGC(tkwin, border, TK_3D_DARK_GC);
+ gc2 = Tk_3DBorderGC(tkwin, border, TK_3D_LIGHT_GC);
+ break;
+ case TK_RELIEF_SOLID:
+ gc1 = gc2 = Tk_3DBorderGC(tkwin, border, TK_3D_DARK_GC);
+ break;
+ case TK_RELIEF_FLAT:
+ default:
+ gc1 = gc2 = Tk_3DBorderGC(tkwin, border, TK_3D_FLAT_GC);
+ break;
+ }
+
+ /* Draw sash line:
+ */
+ if (horizontal) {
+ int y = b.y + b.height/2 - 1;
+ XDrawLine(Tk_Display(tkwin), d, gc1, b.x, y, b.x+b.width, y); ++y;
+ XDrawLine(Tk_Display(tkwin), d, gc2, b.x, y, b.x+b.width, y);
+ } else {
+ int x = b.x + b.width/2 - 1;
+ XDrawLine(Tk_Display(tkwin), d, gc1, x, b.y, x, b.y+b.height); ++x;
+ XDrawLine(Tk_Display(tkwin), d, gc2, x, b.y, x, b.y+b.height);
+ }
+
+ /* Draw handle:
+ */
+ if (handleSize >= 0) {
+ if (horizontal) {
+ hb = Ttk_StickBox(b, handleSize, handleSize, TTK_STICK_W);
+ hb.x += handlePad;
+ } else {
+ hb = Ttk_StickBox(b, handleSize, handleSize, TTK_STICK_N);
+ hb.y += handlePad;
+ }
+ Tk_Fill3DRectangle(tkwin, d, border,
+ hb.x, hb.y, hb.width, hb.height, 1, TK_RELIEF_RAISED);
+ }
+}
+
+static Ttk_ElementSpec SashElementSpec = {
+ TK_STYLE_VERSION_2,
+ sizeof(SashElement),
+ SashOptions,
+ SashElementSize,
+ SashElementDraw
+};
+
+/*------------------------------------------------------------------------
+ * +++ Widget layouts.
+ */
+
+TTK_BEGIN_LAYOUT_TABLE(LayoutTable)
+
+TTK_LAYOUT("TButton",
+ TTK_GROUP("Button.highlight", TTK_FILL_BOTH,
+ TTK_GROUP("Button.border", TTK_FILL_BOTH|TTK_BORDER,
+ TTK_GROUP("Button.padding", TTK_FILL_BOTH,
+ TTK_NODE("Button.label", TTK_FILL_BOTH)))))
+
+TTK_LAYOUT("TCheckbutton",
+ TTK_GROUP("Checkbutton.highlight", TTK_FILL_BOTH,
+ TTK_GROUP("Checkbutton.border", TTK_FILL_BOTH,
+ TTK_GROUP("Checkbutton.padding", TTK_FILL_BOTH,
+ TTK_NODE("Checkbutton.indicator", TTK_PACK_LEFT)
+ TTK_NODE("Checkbutton.label", TTK_PACK_LEFT|TTK_FILL_BOTH)))))
+
+TTK_LAYOUT("TRadiobutton",
+ TTK_GROUP("Radiobutton.highlight", TTK_FILL_BOTH,
+ TTK_GROUP("Radiobutton.border", TTK_FILL_BOTH,
+ TTK_GROUP("Radiobutton.padding", TTK_FILL_BOTH,
+ TTK_NODE("Radiobutton.indicator", TTK_PACK_LEFT)
+ TTK_NODE("Radiobutton.label", TTK_PACK_LEFT|TTK_FILL_BOTH)))))
+
+TTK_LAYOUT("TMenubutton",
+ TTK_GROUP("Menubutton.highlight", TTK_FILL_BOTH,
+ TTK_GROUP("Menubutton.border", TTK_FILL_BOTH,
+ TTK_NODE("Menubutton.indicator", TTK_PACK_RIGHT)
+ TTK_GROUP("Menubutton.padding", TTK_PACK_LEFT|TTK_EXPAND|TTK_FILL_X,
+ TTK_NODE("Menubutton.label", 0)))))
+
+/* "classic" entry, includes highlight border */
+TTK_LAYOUT("TEntry",
+ TTK_GROUP("Entry.highlight", TTK_FILL_BOTH,
+ TTK_GROUP("Entry.field", TTK_FILL_BOTH|TTK_BORDER,
+ TTK_GROUP("Entry.padding", TTK_FILL_BOTH,
+ TTK_NODE("Entry.textarea", TTK_FILL_BOTH)))))
+
+/* Notebook tabs -- omit focus ring */
+TTK_LAYOUT("Tab",
+ TTK_GROUP("Notebook.tab", TTK_FILL_BOTH,
+ TTK_GROUP("Notebook.padding", TTK_FILL_BOTH,
+ TTK_NODE("Notebook.label", TTK_FILL_BOTH))))
+
+TTK_END_LAYOUT_TABLE
+
+/* POSSIBLY: include Scale layouts w/focus border
+ */
+
+/*------------------------------------------------------------------------
+ * TtkClassicTheme_Init --
+ * Install classic theme.
+ */
+
+MODULE_SCOPE int TtkClassicTheme_Init(Tcl_Interp *interp)
+{
+ Ttk_Theme theme = Ttk_CreateTheme(interp, "classic", NULL);
+
+ if (!theme) {
+ return TCL_ERROR;
+ }
+
+ /*
+ * Register elements:
+ */
+ Ttk_RegisterElement(interp, theme, "highlight",
+ &HighlightElementSpec, NULL);
+
+ Ttk_RegisterElement(interp, theme, "Button.border",
+ &ButtonBorderElementSpec, NULL);
+
+ Ttk_RegisterElement(interp, theme, "uparrow",
+ &ArrowElementSpec, &ArrowElements[0]);
+ Ttk_RegisterElement(interp, theme, "downarrow",
+ &ArrowElementSpec, &ArrowElements[1]);
+ Ttk_RegisterElement(interp, theme, "leftarrow",
+ &ArrowElementSpec, &ArrowElements[2]);
+ Ttk_RegisterElement(interp, theme, "rightarrow",
+ &ArrowElementSpec, &ArrowElements[3]);
+ Ttk_RegisterElement(interp, theme, "arrow",
+ &ArrowElementSpec, &ArrowElements[0]);
+
+ Ttk_RegisterElement(interp, theme, "hsash",
+ &SashElementSpec, &SashClientData[0]);
+ Ttk_RegisterElement(interp, theme, "vsash",
+ &SashElementSpec, &SashClientData[1]);
+
+ /*
+ * Register layouts:
+ */
+ Ttk_RegisterLayouts(theme, LayoutTable);
+
+ Tcl_PkgProvide(interp, "ttk::theme::classic", TTK_VERSION);
+
+ return TCL_OK;
+}
+
+/*EOF*/
diff --git a/tk8.6/generic/ttk/ttkDecls.h b/tk8.6/generic/ttk/ttkDecls.h
new file mode 100644
index 0000000..6701724
--- /dev/null
+++ b/tk8.6/generic/ttk/ttkDecls.h
@@ -0,0 +1,274 @@
+/*
+ * This file is (mostly) automatically generated from ttk.decls.
+ */
+
+#ifndef _TTKDECLS
+#define _TTKDECLS
+
+#if defined(USE_TTK_STUBS)
+
+extern const char *TtkInitializeStubs(
+ Tcl_Interp *, const char *version, int epoch, int revision);
+#define Ttk_InitStubs(interp) TtkInitializeStubs( \
+ interp, TTK_VERSION, TTK_STUBS_EPOCH, TTK_STUBS_REVISION)
+#else
+
+#define Ttk_InitStubs(interp) Tcl_PkgRequireEx(interp, "Ttk", TTK_VERSION, 0, NULL)
+
+#endif
+
+
+/* !BEGIN!: Do not edit below this line. */
+
+#define TTK_STUBS_EPOCH 0
+#define TTK_STUBS_REVISION 31
+
+#ifdef __cplusplus
+extern "C" {
+#endif
+
+/*
+ * Exported function declarations:
+ */
+
+/* 0 */
+TTKAPI Ttk_Theme Ttk_GetTheme(Tcl_Interp *interp, const char *name);
+/* 1 */
+TTKAPI Ttk_Theme Ttk_GetDefaultTheme(Tcl_Interp *interp);
+/* 2 */
+TTKAPI Ttk_Theme Ttk_GetCurrentTheme(Tcl_Interp *interp);
+/* 3 */
+TTKAPI Ttk_Theme Ttk_CreateTheme(Tcl_Interp *interp, const char *name,
+ Ttk_Theme parent);
+/* 4 */
+TTKAPI void Ttk_RegisterCleanup(Tcl_Interp *interp,
+ void *deleteData,
+ Ttk_CleanupProc *cleanupProc);
+/* 5 */
+TTKAPI int Ttk_RegisterElementSpec(Ttk_Theme theme,
+ const char *elementName,
+ Ttk_ElementSpec *elementSpec,
+ void *clientData);
+/* 6 */
+TTKAPI Ttk_ElementClass * Ttk_RegisterElement(Tcl_Interp *interp,
+ Ttk_Theme theme, const char *elementName,
+ Ttk_ElementSpec *elementSpec,
+ void *clientData);
+/* 7 */
+TTKAPI int Ttk_RegisterElementFactory(Tcl_Interp *interp,
+ const char *name,
+ Ttk_ElementFactory factoryProc,
+ void *clientData);
+/* 8 */
+TTKAPI void Ttk_RegisterLayout(Ttk_Theme theme,
+ const char *className,
+ Ttk_LayoutSpec layoutSpec);
+/* Slot 9 is reserved */
+/* 10 */
+TTKAPI int Ttk_GetStateSpecFromObj(Tcl_Interp *interp,
+ Tcl_Obj *objPtr, Ttk_StateSpec *spec_rtn);
+/* 11 */
+TTKAPI Tcl_Obj * Ttk_NewStateSpecObj(unsigned int onbits,
+ unsigned int offbits);
+/* 12 */
+TTKAPI Ttk_StateMap Ttk_GetStateMapFromObj(Tcl_Interp *interp,
+ Tcl_Obj *objPtr);
+/* 13 */
+TTKAPI Tcl_Obj * Ttk_StateMapLookup(Tcl_Interp *interp,
+ Ttk_StateMap map, Ttk_State state);
+/* 14 */
+TTKAPI int Ttk_StateTableLookup(Ttk_StateTable map[],
+ Ttk_State state);
+/* Slot 15 is reserved */
+/* Slot 16 is reserved */
+/* Slot 17 is reserved */
+/* Slot 18 is reserved */
+/* Slot 19 is reserved */
+/* 20 */
+TTKAPI int Ttk_GetPaddingFromObj(Tcl_Interp *interp,
+ Tk_Window tkwin, Tcl_Obj *objPtr,
+ Ttk_Padding *pad_rtn);
+/* 21 */
+TTKAPI int Ttk_GetBorderFromObj(Tcl_Interp *interp,
+ Tcl_Obj *objPtr, Ttk_Padding *pad_rtn);
+/* 22 */
+TTKAPI int Ttk_GetStickyFromObj(Tcl_Interp *interp,
+ Tcl_Obj *objPtr, Ttk_Sticky *sticky_rtn);
+/* 23 */
+TTKAPI Ttk_Padding Ttk_MakePadding(short l, short t, short r, short b);
+/* 24 */
+TTKAPI Ttk_Padding Ttk_UniformPadding(short borderWidth);
+/* 25 */
+TTKAPI Ttk_Padding Ttk_AddPadding(Ttk_Padding pad1, Ttk_Padding pad2);
+/* 26 */
+TTKAPI Ttk_Padding Ttk_RelievePadding(Ttk_Padding padding, int relief,
+ int n);
+/* 27 */
+TTKAPI Ttk_Box Ttk_MakeBox(int x, int y, int width, int height);
+/* 28 */
+TTKAPI int Ttk_BoxContains(Ttk_Box box, int x, int y);
+/* 29 */
+TTKAPI Ttk_Box Ttk_PackBox(Ttk_Box *cavity, int w, int h,
+ Ttk_Side side);
+/* 30 */
+TTKAPI Ttk_Box Ttk_StickBox(Ttk_Box parcel, int w, int h,
+ Ttk_Sticky sticky);
+/* 31 */
+TTKAPI Ttk_Box Ttk_AnchorBox(Ttk_Box parcel, int w, int h,
+ Tk_Anchor anchor);
+/* 32 */
+TTKAPI Ttk_Box Ttk_PadBox(Ttk_Box b, Ttk_Padding p);
+/* 33 */
+TTKAPI Ttk_Box Ttk_ExpandBox(Ttk_Box b, Ttk_Padding p);
+/* 34 */
+TTKAPI Ttk_Box Ttk_PlaceBox(Ttk_Box *cavity, int w, int h,
+ Ttk_Side side, Ttk_Sticky sticky);
+/* 35 */
+TTKAPI Tcl_Obj * Ttk_NewBoxObj(Ttk_Box box);
+/* Slot 36 is reserved */
+/* Slot 37 is reserved */
+/* Slot 38 is reserved */
+/* Slot 39 is reserved */
+/* 40 */
+TTKAPI int Ttk_GetOrientFromObj(Tcl_Interp *interp,
+ Tcl_Obj *objPtr, int *orient);
+
+typedef struct TtkStubs {
+ int magic;
+ int epoch;
+ int revision;
+ void *hooks;
+
+ Ttk_Theme (*ttk_GetTheme) (Tcl_Interp *interp, const char *name); /* 0 */
+ Ttk_Theme (*ttk_GetDefaultTheme) (Tcl_Interp *interp); /* 1 */
+ Ttk_Theme (*ttk_GetCurrentTheme) (Tcl_Interp *interp); /* 2 */
+ Ttk_Theme (*ttk_CreateTheme) (Tcl_Interp *interp, const char *name, Ttk_Theme parent); /* 3 */
+ void (*ttk_RegisterCleanup) (Tcl_Interp *interp, void *deleteData, Ttk_CleanupProc *cleanupProc); /* 4 */
+ int (*ttk_RegisterElementSpec) (Ttk_Theme theme, const char *elementName, Ttk_ElementSpec *elementSpec, void *clientData); /* 5 */
+ Ttk_ElementClass * (*ttk_RegisterElement) (Tcl_Interp *interp, Ttk_Theme theme, const char *elementName, Ttk_ElementSpec *elementSpec, void *clientData); /* 6 */
+ int (*ttk_RegisterElementFactory) (Tcl_Interp *interp, const char *name, Ttk_ElementFactory factoryProc, void *clientData); /* 7 */
+ void (*ttk_RegisterLayout) (Ttk_Theme theme, const char *className, Ttk_LayoutSpec layoutSpec); /* 8 */
+ void (*reserved9)(void);
+ int (*ttk_GetStateSpecFromObj) (Tcl_Interp *interp, Tcl_Obj *objPtr, Ttk_StateSpec *spec_rtn); /* 10 */
+ Tcl_Obj * (*ttk_NewStateSpecObj) (unsigned int onbits, unsigned int offbits); /* 11 */
+ Ttk_StateMap (*ttk_GetStateMapFromObj) (Tcl_Interp *interp, Tcl_Obj *objPtr); /* 12 */
+ Tcl_Obj * (*ttk_StateMapLookup) (Tcl_Interp *interp, Ttk_StateMap map, Ttk_State state); /* 13 */
+ int (*ttk_StateTableLookup) (Ttk_StateTable map[], Ttk_State state); /* 14 */
+ void (*reserved15)(void);
+ void (*reserved16)(void);
+ void (*reserved17)(void);
+ void (*reserved18)(void);
+ void (*reserved19)(void);
+ int (*ttk_GetPaddingFromObj) (Tcl_Interp *interp, Tk_Window tkwin, Tcl_Obj *objPtr, Ttk_Padding *pad_rtn); /* 20 */
+ int (*ttk_GetBorderFromObj) (Tcl_Interp *interp, Tcl_Obj *objPtr, Ttk_Padding *pad_rtn); /* 21 */
+ int (*ttk_GetStickyFromObj) (Tcl_Interp *interp, Tcl_Obj *objPtr, Ttk_Sticky *sticky_rtn); /* 22 */
+ Ttk_Padding (*ttk_MakePadding) (short l, short t, short r, short b); /* 23 */
+ Ttk_Padding (*ttk_UniformPadding) (short borderWidth); /* 24 */
+ Ttk_Padding (*ttk_AddPadding) (Ttk_Padding pad1, Ttk_Padding pad2); /* 25 */
+ Ttk_Padding (*ttk_RelievePadding) (Ttk_Padding padding, int relief, int n); /* 26 */
+ Ttk_Box (*ttk_MakeBox) (int x, int y, int width, int height); /* 27 */
+ int (*ttk_BoxContains) (Ttk_Box box, int x, int y); /* 28 */
+ Ttk_Box (*ttk_PackBox) (Ttk_Box *cavity, int w, int h, Ttk_Side side); /* 29 */
+ Ttk_Box (*ttk_StickBox) (Ttk_Box parcel, int w, int h, Ttk_Sticky sticky); /* 30 */
+ Ttk_Box (*ttk_AnchorBox) (Ttk_Box parcel, int w, int h, Tk_Anchor anchor); /* 31 */
+ Ttk_Box (*ttk_PadBox) (Ttk_Box b, Ttk_Padding p); /* 32 */
+ Ttk_Box (*ttk_ExpandBox) (Ttk_Box b, Ttk_Padding p); /* 33 */
+ Ttk_Box (*ttk_PlaceBox) (Ttk_Box *cavity, int w, int h, Ttk_Side side, Ttk_Sticky sticky); /* 34 */
+ Tcl_Obj * (*ttk_NewBoxObj) (Ttk_Box box); /* 35 */
+ void (*reserved36)(void);
+ void (*reserved37)(void);
+ void (*reserved38)(void);
+ void (*reserved39)(void);
+ int (*ttk_GetOrientFromObj) (Tcl_Interp *interp, Tcl_Obj *objPtr, int *orient); /* 40 */
+} TtkStubs;
+
+extern const TtkStubs *ttkStubsPtr;
+
+#ifdef __cplusplus
+}
+#endif
+
+#if defined(USE_TTK_STUBS)
+
+/*
+ * Inline function declarations:
+ */
+
+#define Ttk_GetTheme \
+ (ttkStubsPtr->ttk_GetTheme) /* 0 */
+#define Ttk_GetDefaultTheme \
+ (ttkStubsPtr->ttk_GetDefaultTheme) /* 1 */
+#define Ttk_GetCurrentTheme \
+ (ttkStubsPtr->ttk_GetCurrentTheme) /* 2 */
+#define Ttk_CreateTheme \
+ (ttkStubsPtr->ttk_CreateTheme) /* 3 */
+#define Ttk_RegisterCleanup \
+ (ttkStubsPtr->ttk_RegisterCleanup) /* 4 */
+#define Ttk_RegisterElementSpec \
+ (ttkStubsPtr->ttk_RegisterElementSpec) /* 5 */
+#define Ttk_RegisterElement \
+ (ttkStubsPtr->ttk_RegisterElement) /* 6 */
+#define Ttk_RegisterElementFactory \
+ (ttkStubsPtr->ttk_RegisterElementFactory) /* 7 */
+#define Ttk_RegisterLayout \
+ (ttkStubsPtr->ttk_RegisterLayout) /* 8 */
+/* Slot 9 is reserved */
+#define Ttk_GetStateSpecFromObj \
+ (ttkStubsPtr->ttk_GetStateSpecFromObj) /* 10 */
+#define Ttk_NewStateSpecObj \
+ (ttkStubsPtr->ttk_NewStateSpecObj) /* 11 */
+#define Ttk_GetStateMapFromObj \
+ (ttkStubsPtr->ttk_GetStateMapFromObj) /* 12 */
+#define Ttk_StateMapLookup \
+ (ttkStubsPtr->ttk_StateMapLookup) /* 13 */
+#define Ttk_StateTableLookup \
+ (ttkStubsPtr->ttk_StateTableLookup) /* 14 */
+/* Slot 15 is reserved */
+/* Slot 16 is reserved */
+/* Slot 17 is reserved */
+/* Slot 18 is reserved */
+/* Slot 19 is reserved */
+#define Ttk_GetPaddingFromObj \
+ (ttkStubsPtr->ttk_GetPaddingFromObj) /* 20 */
+#define Ttk_GetBorderFromObj \
+ (ttkStubsPtr->ttk_GetBorderFromObj) /* 21 */
+#define Ttk_GetStickyFromObj \
+ (ttkStubsPtr->ttk_GetStickyFromObj) /* 22 */
+#define Ttk_MakePadding \
+ (ttkStubsPtr->ttk_MakePadding) /* 23 */
+#define Ttk_UniformPadding \
+ (ttkStubsPtr->ttk_UniformPadding) /* 24 */
+#define Ttk_AddPadding \
+ (ttkStubsPtr->ttk_AddPadding) /* 25 */
+#define Ttk_RelievePadding \
+ (ttkStubsPtr->ttk_RelievePadding) /* 26 */
+#define Ttk_MakeBox \
+ (ttkStubsPtr->ttk_MakeBox) /* 27 */
+#define Ttk_BoxContains \
+ (ttkStubsPtr->ttk_BoxContains) /* 28 */
+#define Ttk_PackBox \
+ (ttkStubsPtr->ttk_PackBox) /* 29 */
+#define Ttk_StickBox \
+ (ttkStubsPtr->ttk_StickBox) /* 30 */
+#define Ttk_AnchorBox \
+ (ttkStubsPtr->ttk_AnchorBox) /* 31 */
+#define Ttk_PadBox \
+ (ttkStubsPtr->ttk_PadBox) /* 32 */
+#define Ttk_ExpandBox \
+ (ttkStubsPtr->ttk_ExpandBox) /* 33 */
+#define Ttk_PlaceBox \
+ (ttkStubsPtr->ttk_PlaceBox) /* 34 */
+#define Ttk_NewBoxObj \
+ (ttkStubsPtr->ttk_NewBoxObj) /* 35 */
+/* Slot 36 is reserved */
+/* Slot 37 is reserved */
+/* Slot 38 is reserved */
+/* Slot 39 is reserved */
+#define Ttk_GetOrientFromObj \
+ (ttkStubsPtr->ttk_GetOrientFromObj) /* 40 */
+
+#endif /* defined(USE_TTK_STUBS) */
+
+/* !END!: Do not edit above this line. */
+
+#endif /* _TTKDECLS */
diff --git a/tk8.6/generic/ttk/ttkDefaultTheme.c b/tk8.6/generic/ttk/ttkDefaultTheme.c
new file mode 100644
index 0000000..81f8126
--- /dev/null
+++ b/tk8.6/generic/ttk/ttkDefaultTheme.c
@@ -0,0 +1,1130 @@
+/*
+ * Copyright (c) 2003, Joe English
+ *
+ * Tk alternate theme, intended to match the MSUE and Gtk's (old) default theme
+ */
+
+#include <math.h>
+#include <string.h>
+
+#include <tkInt.h>
+#include <X11/Xlib.h>
+#include <X11/Xutil.h>
+#include "ttkTheme.h"
+
+#if defined(_WIN32)
+static const int WIN32_XDRAWLINE_HACK = 1;
+#else
+static const int WIN32_XDRAWLINE_HACK = 0;
+#endif
+
+#define BORDERWIDTH 2
+#define SCROLLBAR_WIDTH 14
+#define MIN_THUMB_SIZE 8
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Helper routines for border drawing:
+ *
+ * NOTE: MSUE specifies a slightly different arrangement
+ * for button borders than for other elements; "shadowColors"
+ * is for button borders.
+ *
+ * Please excuse the gross misspelling "LITE" for "LIGHT",
+ * but it makes things line up nicer.
+ */
+
+enum BorderColor { FLAT = 1, LITE = 2, DARK = 3, BRDR = 4 };
+
+/* top-left outer, top-left inner, bottom-right inner, bottom-right outer */
+static int const shadowColors[6][4] = {
+ { FLAT, FLAT, FLAT, FLAT }, /* TK_RELIEF_FLAT = 0*/
+ { DARK, LITE, DARK, LITE }, /* TK_RELIEF_GROOVE = 1*/
+ { LITE, FLAT, DARK, BRDR }, /* TK_RELIEF_RAISED = 2*/
+ { LITE, DARK, LITE, DARK }, /* TK_RELIEF_RIDGE = 3*/
+ { BRDR, BRDR, BRDR, BRDR }, /* TK_RELIEF_SOLID = 4*/
+ { BRDR, DARK, FLAT, LITE } /* TK_RELIEF_SUNKEN = 5*/
+};
+
+/* top-left, bottom-right */
+static int const thinShadowColors[6][4] = {
+ { FLAT, FLAT }, /* TK_RELIEF_FLAT = 0*/
+ { DARK, LITE }, /* TK_RELIEF_GROOVE = 1*/
+ { LITE, DARK }, /* TK_RELIEF_RAISED = 2*/
+ { LITE, DARK }, /* TK_RELIEF_RIDGE = 3*/
+ { BRDR, BRDR }, /* TK_RELIEF_SOLID = 4*/
+ { DARK, LITE } /* TK_RELIEF_SUNKEN = 5*/
+};
+
+static void DrawCorner(
+ Tk_Window tkwin,
+ Drawable d,
+ Tk_3DBorder border, /* get most GCs from here... */
+ GC borderGC, /* "window border" color GC */
+ int x,int y, int width,int height, /* where to draw */
+ int corner, /* 0 => top left; 1 => bottom right */
+ enum BorderColor color)
+{
+ XPoint points[3];
+ GC gc;
+
+ --width; --height;
+ points[0].x = x; points[0].y = y+height;
+ points[1].x = x+width*corner; points[1].y = y+height*corner;
+ points[2].x = x+width; points[2].y = y;
+
+ if (color == BRDR)
+ gc = borderGC;
+ else
+ gc = Tk_3DBorderGC(tkwin, border, (int)color);
+
+ XDrawLines(Tk_Display(tkwin), d, gc, points, 3, CoordModeOrigin);
+}
+
+static void DrawBorder(
+ Tk_Window tkwin, Drawable d, Tk_3DBorder border, XColor *borderColor,
+ Ttk_Box b, int borderWidth, int relief)
+{
+ GC borderGC = Tk_GCForColor(borderColor, d);
+
+ switch (borderWidth) {
+ case 2: /* "thick" border */
+ DrawCorner(tkwin, d, border, borderGC,
+ b.x, b.y, b.width, b.height, 0,shadowColors[relief][0]);
+ DrawCorner(tkwin, d, border, borderGC,
+ b.x+1, b.y+1, b.width-2, b.height-2, 0,shadowColors[relief][1]);
+ DrawCorner(tkwin, d, border, borderGC,
+ b.x+1, b.y+1, b.width-2, b.height-2, 1,shadowColors[relief][2]);
+ DrawCorner(tkwin, d, border, borderGC,
+ b.x, b.y, b.width, b.height, 1,shadowColors[relief][3]);
+ break;
+ case 1: /* "thin" border */
+ DrawCorner(tkwin, d, border, borderGC,
+ b.x, b.y, b.width, b.height, 0, thinShadowColors[relief][0]);
+ DrawCorner(tkwin, d, border, borderGC,
+ b.x, b.y, b.width, b.height, 1, thinShadowColors[relief][1]);
+ break;
+ case 0: /* no border -- do nothing */
+ break;
+ default: /* Fall back to Motif-style borders: */
+ Tk_Draw3DRectangle(tkwin, d, border,
+ b.x, b.y, b.width, b.height, borderWidth,relief);
+ break;
+ }
+}
+
+/* Alternate shadow colors for entry fields:
+ * NOTE: FLAT color is normally white, and the LITE color is a darker shade.
+ */
+static int fieldShadowColors[4] = { DARK, BRDR, LITE, FLAT };
+
+static void DrawFieldBorder(
+ Tk_Window tkwin, Drawable d, Tk_3DBorder border, XColor *borderColor,
+ Ttk_Box b)
+{
+ GC borderGC = Tk_GCForColor(borderColor, d);
+ DrawCorner(tkwin, d, border, borderGC,
+ b.x, b.y, b.width, b.height, 0,fieldShadowColors[0]);
+ DrawCorner(tkwin, d, border, borderGC,
+ b.x+1, b.y+1, b.width-2, b.height-2, 0,fieldShadowColors[1]);
+ DrawCorner(tkwin, d, border, borderGC,
+ b.x+1, b.y+1, b.width-2, b.height-2, 1,fieldShadowColors[2]);
+ DrawCorner(tkwin, d, border, borderGC,
+ b.x, b.y, b.width, b.height, 1,fieldShadowColors[3]);
+ return;
+}
+
+/*
+ * ArrowPoints --
+ * Compute points of arrow polygon.
+ */
+static void ArrowPoints(Ttk_Box b, ArrowDirection dir, XPoint points[4])
+{
+ int cx, cy, h;
+
+ switch (dir) {
+ case ARROW_UP:
+ h = (b.width - 1)/2;
+ cx = b.x + h;
+ cy = b.y;
+ if (b.height <= h) h = b.height - 1;
+ points[0].x = cx; points[0].y = cy;
+ points[1].x = cx - h; points[1].y = cy + h;
+ points[2].x = cx + h; points[2].y = cy + h;
+ break;
+ case ARROW_DOWN:
+ h = (b.width - 1)/2;
+ cx = b.x + h;
+ cy = b.y + b.height - 1;
+ if (b.height <= h) h = b.height - 1;
+ points[0].x = cx; points[0].y = cy;
+ points[1].x = cx - h; points[1].y = cy - h;
+ points[2].x = cx + h; points[2].y = cy - h;
+ break;
+ case ARROW_LEFT:
+ h = (b.height - 1)/2;
+ cx = b.x;
+ cy = b.y + h;
+ if (b.width <= h) h = b.width - 1;
+ points[0].x = cx; points[0].y = cy;
+ points[1].x = cx + h; points[1].y = cy - h;
+ points[2].x = cx + h; points[2].y = cy + h;
+ break;
+ case ARROW_RIGHT:
+ h = (b.height - 1)/2;
+ cx = b.x + b.width - 1;
+ cy = b.y + h;
+ if (b.width <= h) h = b.width - 1;
+ points[0].x = cx; points[0].y = cy;
+ points[1].x = cx - h; points[1].y = cy - h;
+ points[2].x = cx - h; points[2].y = cy + h;
+ break;
+ }
+
+ points[3].x = points[0].x;
+ points[3].y = points[0].y;
+}
+
+/*public*/
+void TtkArrowSize(int h, ArrowDirection dir, int *widthPtr, int *heightPtr)
+{
+ switch (dir) {
+ case ARROW_UP:
+ case ARROW_DOWN: *widthPtr = 2*h+1; *heightPtr = h+1; break;
+ case ARROW_LEFT:
+ case ARROW_RIGHT: *widthPtr = h+1; *heightPtr = 2*h+1;
+ }
+}
+
+/*
+ * TtkDrawArrow, TtkFillArrow --
+ * Draw an arrow in the indicated direction inside the specified box.
+ */
+/*public*/
+void TtkFillArrow(
+ Display *display, Drawable d, GC gc, Ttk_Box b, ArrowDirection dir)
+{
+ XPoint points[4];
+ ArrowPoints(b, dir, points);
+ XFillPolygon(display, d, gc, points, 3, Convex, CoordModeOrigin);
+ XDrawLines(display, d, gc, points, 4, CoordModeOrigin);
+}
+
+/*public*/
+void TtkDrawArrow(
+ Display *display, Drawable d, GC gc, Ttk_Box b, ArrowDirection dir)
+{
+ XPoint points[4];
+ ArrowPoints(b, dir, points);
+ XDrawLines(display, d, gc, points, 4, CoordModeOrigin);
+}
+
+/*
+ *----------------------------------------------------------------------
+ * +++ Border element implementation.
+ *
+ * This border consists of (from outside-in):
+ *
+ * + a 1-pixel thick default indicator (defaultable widgets only)
+ * + 1- or 2- pixel shaded border (controlled by -background and -relief)
+ * + 1 pixel padding (???)
+ */
+
+typedef struct {
+ Tcl_Obj *borderObj;
+ Tcl_Obj *borderColorObj; /* Extra border color */
+ Tcl_Obj *borderWidthObj;
+ Tcl_Obj *reliefObj;
+ Tcl_Obj *defaultStateObj; /* for buttons */
+} BorderElement;
+
+static Ttk_ElementOptionSpec BorderElementOptions[] = {
+ { "-background", TK_OPTION_BORDER, Tk_Offset(BorderElement,borderObj),
+ DEFAULT_BACKGROUND },
+ { "-bordercolor",TK_OPTION_COLOR,
+ Tk_Offset(BorderElement,borderColorObj), "black" },
+ { "-default", TK_OPTION_ANY, Tk_Offset(BorderElement,defaultStateObj),
+ "disabled" },
+ { "-borderwidth",TK_OPTION_PIXELS,Tk_Offset(BorderElement,borderWidthObj),
+ STRINGIFY(BORDERWIDTH) },
+ { "-relief", TK_OPTION_RELIEF, Tk_Offset(BorderElement,reliefObj),
+ "flat" },
+ { NULL, 0, 0, NULL }
+};
+
+static void BorderElementSize(
+ void *clientData, void *elementRecord, Tk_Window tkwin,
+ int *widthPtr, int *heightPtr, Ttk_Padding *paddingPtr)
+{
+ BorderElement *bd = elementRecord;
+ int borderWidth = 0;
+ int defaultState = TTK_BUTTON_DEFAULT_DISABLED;
+
+ Tcl_GetIntFromObj(NULL, bd->borderWidthObj, &borderWidth);
+ Ttk_GetButtonDefaultStateFromObj(NULL, bd->defaultStateObj, &defaultState);
+
+ if (defaultState != TTK_BUTTON_DEFAULT_DISABLED) {
+ ++borderWidth;
+ }
+
+ *paddingPtr = Ttk_UniformPadding((short)borderWidth);
+}
+
+static void BorderElementDraw(
+ void *clientData, void *elementRecord,
+ Tk_Window tkwin, Drawable d, Ttk_Box b, unsigned int state)
+{
+ BorderElement *bd = elementRecord;
+ Tk_3DBorder border = Tk_Get3DBorderFromObj(tkwin, bd->borderObj);
+ XColor *borderColor = Tk_GetColorFromObj(tkwin, bd->borderColorObj);
+ int borderWidth = 2;
+ int relief = TK_RELIEF_FLAT;
+ int defaultState = TTK_BUTTON_DEFAULT_DISABLED;
+
+ /*
+ * Get option values.
+ */
+ Tcl_GetIntFromObj(NULL, bd->borderWidthObj, &borderWidth);
+ Tk_GetReliefFromObj(NULL, bd->reliefObj, &relief);
+ Ttk_GetButtonDefaultStateFromObj(NULL, bd->defaultStateObj, &defaultState);
+
+ if (defaultState == TTK_BUTTON_DEFAULT_ACTIVE) {
+ GC gc = Tk_GCForColor(borderColor, d);
+ XDrawRectangle(Tk_Display(tkwin), d, gc,
+ b.x, b.y, b.width-1, b.height-1);
+ }
+ if (defaultState != TTK_BUTTON_DEFAULT_DISABLED) {
+ /* Space for default ring: */
+ b = Ttk_PadBox(b, Ttk_UniformPadding(1));
+ }
+
+ DrawBorder(tkwin, d, border, borderColor, b, borderWidth, relief);
+}
+
+static Ttk_ElementSpec BorderElementSpec = {
+ TK_STYLE_VERSION_2,
+ sizeof(BorderElement),
+ BorderElementOptions,
+ BorderElementSize,
+ BorderElementDraw
+};
+
+/*----------------------------------------------------------------------
+ * +++ Field element:
+ * Used for editable fields.
+ */
+typedef struct {
+ Tcl_Obj *borderObj;
+ Tcl_Obj *borderColorObj; /* Extra border color */
+} FieldElement;
+
+static Ttk_ElementOptionSpec FieldElementOptions[] = {
+ { "-fieldbackground", TK_OPTION_BORDER, Tk_Offset(FieldElement,borderObj),
+ "white" },
+ { "-bordercolor",TK_OPTION_COLOR, Tk_Offset(FieldElement,borderColorObj),
+ "black" },
+ { NULL, 0, 0, NULL }
+};
+
+static void FieldElementSize(
+ void *clientData, void *elementRecord, Tk_Window tkwin,
+ int *widthPtr, int *heightPtr, Ttk_Padding *paddingPtr)
+{
+ *paddingPtr = Ttk_UniformPadding(2);
+}
+
+static void FieldElementDraw(
+ void *clientData, void *elementRecord, Tk_Window tkwin,
+ Drawable d, Ttk_Box b, unsigned int state)
+{
+ FieldElement *field = elementRecord;
+ Tk_3DBorder border = Tk_Get3DBorderFromObj(tkwin, field->borderObj);
+ XColor *borderColor = Tk_GetColorFromObj(tkwin, field->borderColorObj);
+
+ Tk_Fill3DRectangle(
+ tkwin, d, border, b.x, b.y, b.width, b.height, 0, TK_RELIEF_SUNKEN);
+ DrawFieldBorder(tkwin, d, border, borderColor, b);
+}
+
+static Ttk_ElementSpec FieldElementSpec = {
+ TK_STYLE_VERSION_2,
+ sizeof(FieldElement),
+ FieldElementOptions,
+ FieldElementSize,
+ FieldElementDraw
+};
+
+/*------------------------------------------------------------------------
+ * Indicators --
+ *
+ * Code derived (probably incorrectly) from TIP 109 implementation,
+ * unix/tkUnixButton.c r 1.15.
+ */
+
+/*
+ * Indicator bitmap descriptor:
+ */
+typedef struct {
+ int width; /* Width of each image */
+ int height; /* Height of each image */
+ int nimages; /* #images / row */
+ const char *const *pixels; /* array[height] of char[width*nimage] */
+ Ttk_StateTable *map;/* used to look up image index by state */
+} IndicatorSpec;
+
+#if 0
+/*XPM*/
+static const char *const button_images[] = {
+ /* width height ncolors chars_per_pixel */
+ "52 13 8 1",
+ /* colors */
+ "A c #808000000000 s shadow",
+ "B c #000080800000 s highlight",
+ "C c #808080800000 s 3dlight",
+ "D c #000000008080 s window",
+ "E c #808000008080 s 3ddark",
+ "F c #000080808080 s frame",
+ "G c #000000000000 s foreground",
+ "H c #000080800000 s disabledfg",
+};
+#endif
+
+static Ttk_StateTable checkbutton_states[] = {
+ { 0, 0, TTK_STATE_SELECTED|TTK_STATE_DISABLED },
+ { 1, TTK_STATE_SELECTED, TTK_STATE_DISABLED },
+ { 2, TTK_STATE_DISABLED, TTK_STATE_SELECTED },
+ { 3, TTK_STATE_SELECTED|TTK_STATE_DISABLED, 0 },
+ { 0, 0, 0 }
+};
+
+static const char *const checkbutton_pixels[] = {
+ "AAAAAAAAAAAABAAAAAAAAAAAABAAAAAAAAAAAABAAAAAAAAAAAAB",
+ "AEEEEEEEEEECBAEEEEEEEEEECBAEEEEEEEEEECBAEEEEEEEEEECB",
+ "AEDDDDDDDDDCBAEDDDDDDDDDCBAEFFFFFFFFFCBAEFFFFFFFFFCB",
+ "AEDDDDDDDDDCBAEDDDDDDDGDCBAEFFFFFFFFFCBAEFFFFFFFHFCB",
+ "AEDDDDDDDDDCBAEDDDDDDGGDCBAEFFFFFFFFFCBAEFFFFFFHHFCB",
+ "AEDDDDDDDDDCBAEDGDDDGGGDCBAEFFFFFFFFFCBAEFHFFFHHHFCB",
+ "AEDDDDDDDDDCBAEDGGDGGGDDCBAEFFFFFFFFFCBAEFHHFHHHFFCB",
+ "AEDDDDDDDDDCBAEDGGGGGDDDCBAEFFFFFFFFFCBAEFHHHHHFFFCB",
+ "AEDDDDDDDDDCBAEDDGGGDDDDCBAEFFFFFFFFFCBAEFFHHHFFFFCB",
+ "AEDDDDDDDDDCBAEDDDGDDDDDCBAEFFFFFFFFFCBAEFFFHFFFFFCB",
+ "AEDDDDDDDDDCBAEDDDDDDDDDCBAEFFFFFFFFFCBAEFFFFFFFFFCB",
+ "ACCCCCCCCCCCBACCCCCCCCCCCBACCCCCCCCCCCBACCCCCCCCCCCB",
+ "BBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBB",
+};
+
+static IndicatorSpec checkbutton_spec = {
+ 13, 13, 4, /* width, height, nimages */
+ checkbutton_pixels,
+ checkbutton_states
+};
+
+static Ttk_StateTable radiobutton_states[] = {
+ { 0, 0, TTK_STATE_SELECTED|TTK_STATE_DISABLED },
+ { 1, TTK_STATE_SELECTED, TTK_STATE_DISABLED },
+ { 2, TTK_STATE_DISABLED, TTK_STATE_SELECTED },
+ { 3, TTK_STATE_SELECTED|TTK_STATE_DISABLED, 0 },
+ { 0, 0, 0 }
+};
+
+static const char *const radiobutton_pixels[] = {
+ "FFFFAAAAFFFFFFFFFAAAAFFFFFFFFFAAAAFFFFFFFFFAAAAFFFFF",
+ "FFAAEEEEAAFFFFFAAEEEEAAFFFFFAAEEEEAAFFFFFAAEEEEAAFFF",
+ "FAEEDDDDEEBFFFAEEDDDDEEBFFFAEEFFFFEEBFFFAEEFFFFEEBFF",
+ "FAEDDDDDDCBFFFAEDDDDDDCBFFFAEFFFFFFCBFFFAEFFFFFFCBFF",
+ "AEDDDDDDDDCBFAEDDDGGDDDCBFAEFFFFFFFFCBFAEFFFHHFFFCBF",
+ "AEDDDDDDDDCBFAEDDGGGGDDCBFAEFFFFFFFFCBFAEFFHHHHFFCBF",
+ "AEDDDDDDDDCBFAEDDGGGGDDCBFAEFFFFFFFFCBFAEFFHHHHFFCBF",
+ "AEDDDDDDDDCBFAEDDDGGDDDCBFAEFFFFFFFFCBFAEFFFHHFFFCBF",
+ "FAEDDDDDDCBFFFAEDDDDDDCBFFFAEFFFFFFCBFFFAEFFFFFFCBFF",
+ "FACCDDDDCCBFFFACCDDDDCCBFFFACCFFFFCCBFFFACCFFFFCCBFF",
+ "FFBBCCCCBBFFFFFBBCCCCBBFFFFFBBCCCCBBFFFFFBBCCCCBBFFF",
+ "FFFFBBBBFFFFFFFFFBBBBFFFFFFFFFBBBBFFFFFFFFFBBBBFFFFF",
+ "FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF",
+};
+
+static IndicatorSpec radiobutton_spec = {
+ 13, 13, 4, /* width, height, nimages */
+ radiobutton_pixels,
+ radiobutton_states
+};
+
+typedef struct {
+ Tcl_Obj *backgroundObj;
+ Tcl_Obj *foregroundObj;
+ Tcl_Obj *colorObj;
+ Tcl_Obj *lightColorObj;
+ Tcl_Obj *shadeColorObj;
+ Tcl_Obj *borderColorObj;
+ Tcl_Obj *marginObj;
+} IndicatorElement;
+
+static Ttk_ElementOptionSpec IndicatorElementOptions[] = {
+ { "-background", TK_OPTION_COLOR,
+ Tk_Offset(IndicatorElement,backgroundObj), DEFAULT_BACKGROUND },
+ { "-foreground", TK_OPTION_COLOR,
+ Tk_Offset(IndicatorElement,foregroundObj), DEFAULT_FOREGROUND },
+ { "-indicatorcolor", TK_OPTION_COLOR,
+ Tk_Offset(IndicatorElement,colorObj), "#FFFFFF" },
+ { "-lightcolor", TK_OPTION_COLOR,
+ Tk_Offset(IndicatorElement,lightColorObj), "#DDDDDD" },
+ { "-shadecolor", TK_OPTION_COLOR,
+ Tk_Offset(IndicatorElement,shadeColorObj), "#888888" },
+ { "-bordercolor", TK_OPTION_COLOR,
+ Tk_Offset(IndicatorElement,borderColorObj), "black" },
+ { "-indicatormargin", TK_OPTION_STRING,
+ Tk_Offset(IndicatorElement,marginObj), "0 2 4 2" },
+ { NULL, 0, 0, NULL }
+};
+
+static void IndicatorElementSize(
+ void *clientData, void *elementRecord, Tk_Window tkwin,
+ int *widthPtr, int *heightPtr, Ttk_Padding *paddingPtr)
+{
+ IndicatorSpec *spec = clientData;
+ IndicatorElement *indicator = elementRecord;
+ Ttk_Padding margins;
+ Ttk_GetPaddingFromObj(NULL, tkwin, indicator->marginObj, &margins);
+ *widthPtr = spec->width + Ttk_PaddingWidth(margins);
+ *heightPtr = spec->height + Ttk_PaddingHeight(margins);
+}
+
+static void IndicatorElementDraw(
+ void *clientData, void *elementRecord, Tk_Window tkwin,
+ Drawable d, Ttk_Box b, unsigned int state)
+{
+ IndicatorSpec *spec = clientData;
+ IndicatorElement *indicator = elementRecord;
+ Display *display = Tk_Display(tkwin);
+ Ttk_Padding padding;
+ XColor *fgColor, *frameColor, *shadeColor, *indicatorColor, *borderColor;
+
+ int index, ix, iy;
+ XGCValues gcValues;
+ GC copyGC;
+ unsigned long imgColors[8];
+ XImage *img;
+
+ Ttk_GetPaddingFromObj(NULL, tkwin, indicator->marginObj, &padding);
+ b = Ttk_PadBox(b, padding);
+
+ if ( b.x < 0
+ || b.y < 0
+ || Tk_Width(tkwin) < b.x + spec->width
+ || Tk_Height(tkwin) < b.y + spec->height)
+ {
+ /* Oops! not enough room to display the image.
+ * Don't draw anything.
+ */
+ return;
+ }
+
+ /*
+ * Fill in imgColors palette:
+ *
+ * (SHOULD: take light and shade colors from the border object,
+ * but Tk doesn't provide easy access to these in the public API.)
+ */
+ fgColor = Tk_GetColorFromObj(tkwin, indicator->foregroundObj);
+ frameColor = Tk_GetColorFromObj(tkwin, indicator->backgroundObj);
+ shadeColor = Tk_GetColorFromObj(tkwin, indicator->shadeColorObj);
+ indicatorColor = Tk_GetColorFromObj(tkwin, indicator->colorObj);
+ borderColor = Tk_GetColorFromObj(tkwin, indicator->borderColorObj);
+
+ imgColors[0 /*A*/] = shadeColor->pixel;
+ imgColors[1 /*B*/] = indicatorColor->pixel;
+ imgColors[2 /*C*/] = frameColor->pixel;
+ imgColors[3 /*D*/] = indicatorColor->pixel;
+ imgColors[4 /*E*/] = borderColor->pixel;
+ imgColors[5 /*F*/] = frameColor->pixel;
+ imgColors[6 /*G*/] = fgColor->pixel;
+ imgColors[7 /*H*/] = fgColor->pixel;
+
+ /*
+ * Create a scratch buffer to store the image:
+ */
+ img = XGetImage(display,d, 0, 0,
+ (unsigned int)spec->width, (unsigned int)spec->height,
+ AllPlanes, ZPixmap);
+ if (img == NULL)
+ return;
+
+ /*
+ * Create the image, painting it into an XImage one pixel at a time.
+ */
+ index = Ttk_StateTableLookup(spec->map, state);
+ for (iy=0 ; iy<spec->height ; iy++) {
+ for (ix=0 ; ix<spec->width ; ix++) {
+ XPutPixel(img, ix, iy,
+ imgColors[spec->pixels[iy][index*spec->width+ix] - 'A'] );
+ }
+ }
+
+ /*
+ * Copy onto our target drawable surface.
+ */
+ memset(&gcValues, 0, sizeof(gcValues));
+ copyGC = Tk_GetGC(tkwin, 0, &gcValues);
+
+ TkPutImage(NULL, 0, display, d, copyGC, img, 0, 0, b.x, b.y,
+ spec->width, spec->height);
+
+ /*
+ * Tidy up.
+ */
+ Tk_FreeGC(display, copyGC);
+ XDestroyImage(img);
+}
+
+static Ttk_ElementSpec IndicatorElementSpec = {
+ TK_STYLE_VERSION_2,
+ sizeof(IndicatorElement),
+ IndicatorElementOptions,
+ IndicatorElementSize,
+ IndicatorElementDraw
+};
+
+/*----------------------------------------------------------------------
+ * +++ Arrow element(s).
+ *
+ * Draws a solid triangle, inside a box.
+ * clientData is an enum ArrowDirection pointer.
+ */
+
+static int ArrowElements[] = { ARROW_UP, ARROW_DOWN, ARROW_LEFT, ARROW_RIGHT };
+typedef struct {
+ Tcl_Obj *sizeObj;
+ Tcl_Obj *borderObj;
+ Tcl_Obj *borderColorObj; /* Extra color for borders */
+ Tcl_Obj *reliefObj;
+ Tcl_Obj *colorObj; /* Arrow color */
+} ArrowElement;
+
+static Ttk_ElementOptionSpec ArrowElementOptions[] = {
+ { "-arrowsize", TK_OPTION_PIXELS,
+ Tk_Offset(ArrowElement,sizeObj), STRINGIFY(SCROLLBAR_WIDTH) },
+ { "-background", TK_OPTION_BORDER,
+ Tk_Offset(ArrowElement,borderObj), DEFAULT_BACKGROUND },
+ { "-bordercolor", TK_OPTION_COLOR,
+ Tk_Offset(ArrowElement,borderColorObj), "black" },
+ { "-relief", TK_OPTION_RELIEF,
+ Tk_Offset(ArrowElement,reliefObj),"raised"},
+ { "-arrowcolor", TK_OPTION_COLOR,
+ Tk_Offset(ArrowElement,colorObj),"black"},
+ { NULL, 0, 0, NULL }
+};
+
+/*
+ * Note asymmetric padding:
+ * top/left padding is 1 less than bottom/right,
+ * since in this theme 2-pixel borders are asymmetric.
+ */
+static Ttk_Padding ArrowPadding = { 3,3,4,4 };
+
+static void ArrowElementSize(
+ void *clientData, void *elementRecord, Tk_Window tkwin,
+ int *widthPtr, int *heightPtr, Ttk_Padding *paddingPtr)
+{
+ ArrowElement *arrow = elementRecord;
+ int direction = *(int *)clientData;
+ int width = SCROLLBAR_WIDTH;
+
+ Tk_GetPixelsFromObj(NULL, tkwin, arrow->sizeObj, &width);
+ width -= Ttk_PaddingWidth(ArrowPadding);
+ TtkArrowSize(width/2, direction, widthPtr, heightPtr);
+ *widthPtr += Ttk_PaddingWidth(ArrowPadding);
+ *heightPtr += Ttk_PaddingHeight(ArrowPadding);
+}
+
+static void ArrowElementDraw(
+ void *clientData, void *elementRecord, Tk_Window tkwin,
+ Drawable d, Ttk_Box b, unsigned int state)
+{
+ int direction = *(int *)clientData;
+ ArrowElement *arrow = elementRecord;
+ Tk_3DBorder border = Tk_Get3DBorderFromObj(tkwin, arrow->borderObj);
+ XColor *borderColor = Tk_GetColorFromObj(tkwin, arrow->borderColorObj);
+ XColor *arrowColor = Tk_GetColorFromObj(tkwin, arrow->colorObj);
+ int relief = TK_RELIEF_RAISED;
+ int borderWidth = 2;
+
+ Tk_GetReliefFromObj(NULL, arrow->reliefObj, &relief);
+
+ Tk_Fill3DRectangle(
+ tkwin, d, border, b.x, b.y, b.width, b.height, 0, TK_RELIEF_FLAT);
+ DrawBorder(tkwin,d,border,borderColor,b,borderWidth,relief);
+
+ TtkFillArrow(Tk_Display(tkwin), d, Tk_GCForColor(arrowColor, d),
+ Ttk_PadBox(b, ArrowPadding), direction);
+}
+
+static Ttk_ElementSpec ArrowElementSpec = {
+ TK_STYLE_VERSION_2,
+ sizeof(ArrowElement),
+ ArrowElementOptions,
+ ArrowElementSize,
+ ArrowElementDraw
+};
+
+/*----------------------------------------------------------------------
+ * +++ Menubutton indicator:
+ * Draw an arrow in the direction where the menu will be posted.
+ */
+
+#define MENUBUTTON_ARROW_SIZE 5
+
+typedef struct {
+ Tcl_Obj *directionObj;
+ Tcl_Obj *sizeObj;
+ Tcl_Obj *colorObj;
+} MenubuttonArrowElement;
+
+static const char *directionStrings[] = { /* See also: button.c */
+ "above", "below", "left", "right", "flush", NULL
+};
+enum { POST_ABOVE, POST_BELOW, POST_LEFT, POST_RIGHT, POST_FLUSH };
+
+static Ttk_ElementOptionSpec MenubuttonArrowElementOptions[] = {
+ { "-direction", TK_OPTION_STRING,
+ Tk_Offset(MenubuttonArrowElement,directionObj), "below" },
+ { "-arrowsize", TK_OPTION_PIXELS,
+ Tk_Offset(MenubuttonArrowElement,sizeObj), STRINGIFY(MENUBUTTON_ARROW_SIZE)},
+ { "-arrowcolor",TK_OPTION_COLOR,
+ Tk_Offset(MenubuttonArrowElement,colorObj), "black"},
+ { NULL, 0, 0, NULL }
+};
+
+static Ttk_Padding MenubuttonArrowPadding = { 3, 0, 3, 0 };
+
+static void MenubuttonArrowElementSize(
+ void *clientData, void *elementRecord, Tk_Window tkwin,
+ int *widthPtr, int *heightPtr, Ttk_Padding *paddingPtr)
+{
+ MenubuttonArrowElement *arrow = elementRecord;
+ int size = MENUBUTTON_ARROW_SIZE;
+ Tk_GetPixelsFromObj(NULL, tkwin, arrow->sizeObj, &size);
+ *widthPtr = *heightPtr = 2 * size + 1;
+ *widthPtr += Ttk_PaddingWidth(MenubuttonArrowPadding);
+ *heightPtr += Ttk_PaddingHeight(MenubuttonArrowPadding);
+}
+
+static void MenubuttonArrowElementDraw(
+ void *clientData, void *elementRecord, Tk_Window tkwin,
+ Drawable d, Ttk_Box b, unsigned int state)
+{
+ MenubuttonArrowElement *arrow = elementRecord;
+ XColor *arrowColor = Tk_GetColorFromObj(tkwin, arrow->colorObj);
+ GC gc = Tk_GCForColor(arrowColor, d);
+ int size = MENUBUTTON_ARROW_SIZE;
+ int postDirection = POST_BELOW;
+ ArrowDirection arrowDirection = ARROW_DOWN;
+ int width = 0, height = 0;
+
+ Tk_GetPixelsFromObj(NULL, tkwin, arrow->sizeObj, &size);
+ Tcl_GetIndexFromObjStruct(NULL, arrow->directionObj, directionStrings,
+ sizeof(char *), ""/*message*/, 0/*flags*/, &postDirection);
+
+ /* ... this might not be such a great idea ... */
+ switch (postDirection) {
+ case POST_ABOVE: arrowDirection = ARROW_UP; break;
+ case POST_BELOW: arrowDirection = ARROW_DOWN; break;
+ case POST_LEFT: arrowDirection = ARROW_LEFT; break;
+ case POST_RIGHT: arrowDirection = ARROW_RIGHT; break;
+ case POST_FLUSH: arrowDirection = ARROW_DOWN; break;
+ }
+
+ TtkArrowSize(size, arrowDirection, &width, &height);
+ b = Ttk_PadBox(b, MenubuttonArrowPadding);
+ b = Ttk_AnchorBox(b, width, height, TK_ANCHOR_CENTER);
+ TtkFillArrow(Tk_Display(tkwin), d, gc, b, arrowDirection);
+}
+
+static Ttk_ElementSpec MenubuttonArrowElementSpec = {
+ TK_STYLE_VERSION_2,
+ sizeof(MenubuttonArrowElement),
+ MenubuttonArrowElementOptions,
+ MenubuttonArrowElementSize,
+ MenubuttonArrowElementDraw
+};
+
+/*----------------------------------------------------------------------
+ * +++ Trough element
+ *
+ * Used in scrollbars and the scale.
+ *
+ * The -groovewidth option can be used to set the size of the short axis
+ * for the drawn area. This will not affect the geometry, but can be used
+ * to draw a thin centered trough inside the packet alloted. This is used
+ * to show a win32-style scale widget. Use -1 or a large number to use the
+ * full area (default).
+ *
+ */
+
+typedef struct {
+ Tcl_Obj *colorObj;
+ Tcl_Obj *borderWidthObj;
+ Tcl_Obj *reliefObj;
+ Tcl_Obj *grooveWidthObj;
+ Tcl_Obj *orientObj;
+} TroughElement;
+
+static Ttk_ElementOptionSpec TroughElementOptions[] = {
+ { "-orient", TK_OPTION_ANY,
+ Tk_Offset(TroughElement, orientObj), "horizontal" },
+ { "-troughborderwidth", TK_OPTION_PIXELS,
+ Tk_Offset(TroughElement,borderWidthObj), "1" },
+ { "-troughcolor", TK_OPTION_BORDER,
+ Tk_Offset(TroughElement,colorObj), DEFAULT_BACKGROUND },
+ { "-troughrelief",TK_OPTION_RELIEF,
+ Tk_Offset(TroughElement,reliefObj), "sunken" },
+ { "-groovewidth", TK_OPTION_PIXELS,
+ Tk_Offset(TroughElement,grooveWidthObj), "-1" },
+ { NULL, 0, 0, NULL }
+};
+
+static void TroughElementSize(
+ void *clientData, void *elementRecord, Tk_Window tkwin,
+ int *widthPtr, int *heightPtr, Ttk_Padding *paddingPtr)
+{
+ TroughElement *troughPtr = elementRecord;
+ int borderWidth = 2, grooveWidth = 0;
+
+ Tk_GetPixelsFromObj(NULL, tkwin, troughPtr->borderWidthObj, &borderWidth);
+ Tk_GetPixelsFromObj(NULL, tkwin, troughPtr->grooveWidthObj, &grooveWidth);
+
+ if (grooveWidth <= 0) {
+ *paddingPtr = Ttk_UniformPadding((short)borderWidth);
+ }
+}
+
+static void TroughElementDraw(
+ void *clientData, void *elementRecord, Tk_Window tkwin,
+ Drawable d, Ttk_Box b, unsigned int state)
+{
+ TroughElement *troughPtr = elementRecord;
+ Tk_3DBorder border = NULL;
+ int borderWidth = 2, relief = TK_RELIEF_SUNKEN, groove = -1, orient;
+
+ border = Tk_Get3DBorderFromObj(tkwin, troughPtr->colorObj);
+ Ttk_GetOrientFromObj(NULL, troughPtr->orientObj, &orient);
+ Tk_GetReliefFromObj(NULL, troughPtr->reliefObj, &relief);
+ Tk_GetPixelsFromObj(NULL, tkwin, troughPtr->borderWidthObj, &borderWidth);
+ Tk_GetPixelsFromObj(NULL, tkwin, troughPtr->grooveWidthObj, &groove);
+
+ if (groove != -1 && groove < b.height && groove < b.width) {
+ if (orient == TTK_ORIENT_HORIZONTAL) {
+ b.y = b.y + b.height/2 - groove/2;
+ b.height = groove;
+ } else {
+ b.x = b.x + b.width/2 - groove/2;
+ b.width = groove;
+ }
+ }
+
+ Tk_Fill3DRectangle(tkwin, d, border, b.x, b.y, b.width, b.height,
+ borderWidth, relief);
+}
+
+static Ttk_ElementSpec TroughElementSpec = {
+ TK_STYLE_VERSION_2,
+ sizeof(TroughElement),
+ TroughElementOptions,
+ TroughElementSize,
+ TroughElementDraw
+};
+
+/*
+ *----------------------------------------------------------------------
+ * +++ Thumb element.
+ */
+
+typedef struct {
+ Tcl_Obj *sizeObj;
+ Tcl_Obj *firstObj;
+ Tcl_Obj *lastObj;
+ Tcl_Obj *borderObj;
+ Tcl_Obj *borderColorObj;
+ Tcl_Obj *reliefObj;
+ Tcl_Obj *orientObj;
+} ThumbElement;
+
+static Ttk_ElementOptionSpec ThumbElementOptions[] = {
+ { "-width", TK_OPTION_PIXELS, Tk_Offset(ThumbElement,sizeObj),
+ STRINGIFY(SCROLLBAR_WIDTH) },
+ { "-background", TK_OPTION_BORDER, Tk_Offset(ThumbElement,borderObj),
+ DEFAULT_BACKGROUND },
+ { "-bordercolor", TK_OPTION_COLOR, Tk_Offset(ThumbElement,borderColorObj),
+ "black" },
+ { "-relief", TK_OPTION_RELIEF,Tk_Offset(ThumbElement,reliefObj),"raised" },
+ { "-orient", TK_OPTION_ANY,Tk_Offset(ThumbElement,orientObj),"horizontal"},
+ { NULL, 0, 0, NULL }
+};
+
+static void ThumbElementSize(
+ void *clientData, void *elementRecord, Tk_Window tkwin,
+ int *widthPtr, int *heightPtr, Ttk_Padding *paddingPtr)
+{
+ ThumbElement *thumb = elementRecord;
+ int orient, size;
+ Tk_GetPixelsFromObj(NULL, tkwin, thumb->sizeObj, &size);
+ Ttk_GetOrientFromObj(NULL, thumb->orientObj, &orient);
+
+ if (orient == TTK_ORIENT_VERTICAL) {
+ *widthPtr = size;
+ *heightPtr = MIN_THUMB_SIZE;
+ } else {
+ *widthPtr = MIN_THUMB_SIZE;
+ *heightPtr = size;
+ }
+}
+
+static void ThumbElementDraw(
+ void *clientData, void *elementRecord, Tk_Window tkwin,
+ Drawable d, Ttk_Box b, unsigned int state)
+{
+ ThumbElement *thumb = elementRecord;
+ Tk_3DBorder border = Tk_Get3DBorderFromObj(tkwin, thumb->borderObj);
+ XColor *borderColor = Tk_GetColorFromObj(tkwin, thumb->borderColorObj);
+ int relief = TK_RELIEF_RAISED;
+ int borderWidth = 2;
+
+ /*
+ * Don't draw the thumb if we are disabled.
+ * This makes it behave like Windows ... if that's what we want.
+ if (state & TTK_STATE_DISABLED)
+ return;
+ */
+
+ Tk_GetReliefFromObj(NULL, thumb->reliefObj, &relief);
+
+ Tk_Fill3DRectangle(
+ tkwin, d, border, b.x,b.y,b.width,b.height, 0, TK_RELIEF_FLAT);
+ DrawBorder(tkwin, d, border, borderColor, b, borderWidth, relief);
+}
+
+static Ttk_ElementSpec ThumbElementSpec = {
+ TK_STYLE_VERSION_2,
+ sizeof(ThumbElement),
+ ThumbElementOptions,
+ ThumbElementSize,
+ ThumbElementDraw
+};
+
+/*
+ *----------------------------------------------------------------------
+ * +++ Slider element.
+ *
+ * This is the moving part of the scale widget.
+ *
+ * The slider element is the thumb in the scale widget. This is drawn
+ * as an arrow-type element that can point up, down, left or right.
+ *
+ */
+
+typedef struct {
+ Tcl_Obj *lengthObj; /* Long axis dimension */
+ Tcl_Obj *thicknessObj; /* Short axis dimension */
+ Tcl_Obj *reliefObj; /* Relief for this object */
+ Tcl_Obj *borderObj; /* Border / background color */
+ Tcl_Obj *borderColorObj; /* Additional border color */
+ Tcl_Obj *borderWidthObj;
+ Tcl_Obj *orientObj; /* Orientation of overall slider */
+} SliderElement;
+
+static Ttk_ElementOptionSpec SliderElementOptions[] = {
+ { "-sliderlength", TK_OPTION_PIXELS, Tk_Offset(SliderElement,lengthObj),
+ "15" },
+ { "-sliderthickness",TK_OPTION_PIXELS,Tk_Offset(SliderElement,thicknessObj),
+ "15" },
+ { "-sliderrelief", TK_OPTION_RELIEF, Tk_Offset(SliderElement,reliefObj),
+ "raised" },
+ { "-borderwidth", TK_OPTION_PIXELS, Tk_Offset(SliderElement,borderWidthObj),
+ STRINGIFY(BORDERWIDTH) },
+ { "-background", TK_OPTION_BORDER, Tk_Offset(SliderElement,borderObj),
+ DEFAULT_BACKGROUND },
+ { "-bordercolor", TK_OPTION_COLOR, Tk_Offset(ThumbElement,borderColorObj),
+ "black" },
+ { "-orient", TK_OPTION_ANY, Tk_Offset(SliderElement,orientObj),
+ "horizontal" },
+ { NULL, 0, 0, NULL }
+};
+
+static void SliderElementSize(
+ void *clientData, void *elementRecord, Tk_Window tkwin,
+ int *widthPtr, int *heightPtr, Ttk_Padding *paddingPtr)
+{
+ SliderElement *slider = elementRecord;
+ int orient, length, thickness, borderWidth;
+
+ Ttk_GetOrientFromObj(NULL, slider->orientObj, &orient);
+ Tk_GetPixelsFromObj(NULL, tkwin, slider->borderWidthObj, &borderWidth);
+ Tk_GetPixelsFromObj(NULL, tkwin, slider->lengthObj, &length);
+ Tk_GetPixelsFromObj(NULL, tkwin, slider->thicknessObj, &thickness);
+
+ switch (orient) {
+ case TTK_ORIENT_VERTICAL:
+ *widthPtr = thickness + (borderWidth *2);
+ *heightPtr = *widthPtr/2;
+ break;
+
+ case TTK_ORIENT_HORIZONTAL:
+ *heightPtr = thickness + (borderWidth *2);
+ *widthPtr = *heightPtr/2;
+ break;
+ }
+}
+
+static void SliderElementDraw(
+ void *clientData, void *elementRecord, Tk_Window tkwin,
+ Drawable d, Ttk_Box b, unsigned int state)
+{
+ SliderElement *slider = elementRecord;
+ Tk_3DBorder border = Tk_Get3DBorderFromObj(tkwin, slider->borderObj);
+ XColor *borderColor = Tk_GetColorFromObj(tkwin, slider->borderColorObj);
+ int relief = TK_RELIEF_RAISED, borderWidth = 2;
+
+ Tk_GetPixelsFromObj(NULL, tkwin, slider->borderWidthObj, &borderWidth);
+ Tk_GetReliefFromObj(NULL, slider->reliefObj, &relief);
+
+ Tk_Fill3DRectangle(tkwin, d, border,
+ b.x, b.y, b.width, b.height,
+ borderWidth, TK_RELIEF_FLAT);
+ DrawBorder(tkwin, d, border, borderColor, b, borderWidth, relief);
+}
+
+static Ttk_ElementSpec SliderElementSpec = {
+ TK_STYLE_VERSION_2,
+ sizeof(SliderElement),
+ SliderElementOptions,
+ SliderElementSize,
+ SliderElementDraw
+};
+
+/*------------------------------------------------------------------------
+ * +++ Tree indicator element.
+ */
+
+#define TTK_STATE_OPEN TTK_STATE_USER1 /* XREF: treeview.c */
+#define TTK_STATE_LEAF TTK_STATE_USER2
+
+typedef struct {
+ Tcl_Obj *colorObj;
+ Tcl_Obj *marginObj;
+ Tcl_Obj *diameterObj;
+} TreeitemIndicator;
+
+static Ttk_ElementOptionSpec TreeitemIndicatorOptions[] = {
+ { "-foreground", TK_OPTION_COLOR,
+ Tk_Offset(TreeitemIndicator,colorObj), DEFAULT_FOREGROUND },
+ { "-diameter", TK_OPTION_PIXELS,
+ Tk_Offset(TreeitemIndicator,diameterObj), "9" },
+ { "-indicatormargins", TK_OPTION_STRING,
+ Tk_Offset(TreeitemIndicator,marginObj), "2 2 4 2" },
+ { NULL, 0, 0, NULL }
+};
+
+static void TreeitemIndicatorSize(
+ void *clientData, void *elementRecord, Tk_Window tkwin,
+ int *widthPtr, int *heightPtr, Ttk_Padding *paddingPtr)
+{
+ TreeitemIndicator *indicator = elementRecord;
+ int diameter = 0;
+ Ttk_Padding margins;
+
+ Ttk_GetPaddingFromObj(NULL, tkwin, indicator->marginObj, &margins);
+ Tk_GetPixelsFromObj(NULL, tkwin, indicator->diameterObj, &diameter);
+ *widthPtr = diameter + Ttk_PaddingWidth(margins);
+ *heightPtr = diameter + Ttk_PaddingHeight(margins);
+}
+
+static void TreeitemIndicatorDraw(
+ void *clientData, void *elementRecord, Tk_Window tkwin,
+ Drawable d, Ttk_Box b, Ttk_State state)
+{
+ TreeitemIndicator *indicator = elementRecord;
+ XColor *color = Tk_GetColorFromObj(tkwin, indicator->colorObj);
+ GC gc = Tk_GCForColor(color, d);
+ Ttk_Padding padding = Ttk_UniformPadding(0);
+ int w = WIN32_XDRAWLINE_HACK;
+ int cx, cy;
+
+ if (state & TTK_STATE_LEAF) {
+ /* don't draw anything ... */
+ return;
+ }
+
+ Ttk_GetPaddingFromObj(NULL,tkwin,indicator->marginObj,&padding);
+ b = Ttk_PadBox(b, padding);
+
+ XDrawRectangle(Tk_Display(tkwin), d, gc,
+ b.x, b.y, b.width - 1, b.height - 1);
+
+ cx = b.x + (b.width - 1) / 2;
+ cy = b.y + (b.height - 1) / 2;
+ XDrawLine(Tk_Display(tkwin), d, gc, b.x+2, cy, b.x+b.width-3+w, cy);
+
+ if (!(state & TTK_STATE_OPEN)) {
+ /* turn '-' into a '+' */
+ XDrawLine(Tk_Display(tkwin), d, gc, cx, b.y+2, cx, b.y+b.height-3+w);
+ }
+}
+
+static Ttk_ElementSpec TreeitemIndicatorElementSpec = {
+ TK_STYLE_VERSION_2,
+ sizeof(TreeitemIndicator),
+ TreeitemIndicatorOptions,
+ TreeitemIndicatorSize,
+ TreeitemIndicatorDraw
+};
+
+/*------------------------------------------------------------------------
+ * TtkAltTheme_Init --
+ * Install alternate theme.
+ */
+MODULE_SCOPE int TtkAltTheme_Init(Tcl_Interp *interp)
+{
+ Ttk_Theme theme = Ttk_CreateTheme(interp, "alt", NULL);
+
+ if (!theme) {
+ return TCL_ERROR;
+ }
+
+ Ttk_RegisterElement(interp, theme, "border", &BorderElementSpec, NULL);
+
+ Ttk_RegisterElement(interp, theme, "Checkbutton.indicator",
+ &IndicatorElementSpec, &checkbutton_spec);
+ Ttk_RegisterElement(interp, theme, "Radiobutton.indicator",
+ &IndicatorElementSpec, &radiobutton_spec);
+ Ttk_RegisterElement(interp, theme, "Menubutton.indicator",
+ &MenubuttonArrowElementSpec, NULL);
+
+ Ttk_RegisterElement(interp, theme, "field", &FieldElementSpec, NULL);
+
+ Ttk_RegisterElement(interp, theme, "trough", &TroughElementSpec, NULL);
+ Ttk_RegisterElement(interp, theme, "thumb", &ThumbElementSpec, NULL);
+ Ttk_RegisterElement(interp, theme, "slider", &SliderElementSpec, NULL);
+
+ Ttk_RegisterElement(interp, theme, "uparrow",
+ &ArrowElementSpec, &ArrowElements[0]);
+ Ttk_RegisterElement(interp, theme, "downarrow",
+ &ArrowElementSpec, &ArrowElements[1]);
+ Ttk_RegisterElement(interp, theme, "leftarrow",
+ &ArrowElementSpec, &ArrowElements[2]);
+ Ttk_RegisterElement(interp, theme, "rightarrow",
+ &ArrowElementSpec, &ArrowElements[3]);
+ Ttk_RegisterElement(interp, theme, "arrow",
+ &ArrowElementSpec, &ArrowElements[0]);
+
+ Ttk_RegisterElement(interp, theme, "arrow",
+ &ArrowElementSpec, &ArrowElements[0]);
+
+ Ttk_RegisterElement(interp, theme, "Treeitem.indicator",
+ &TreeitemIndicatorElementSpec, 0);
+
+ Tcl_PkgProvide(interp, "ttk::theme::alt", TTK_VERSION);
+
+ return TCL_OK;
+}
+
+/*EOF*/
diff --git a/tk8.6/generic/ttk/ttkElements.c b/tk8.6/generic/ttk/ttkElements.c
new file mode 100644
index 0000000..5c95dba
--- /dev/null
+++ b/tk8.6/generic/ttk/ttkElements.c
@@ -0,0 +1,1281 @@
+/*
+ * Copyright (c) 2003, Joe English
+ *
+ * Default implementation for themed elements.
+ *
+ */
+
+#include <tcl.h>
+#include <tk.h>
+#include <string.h>
+#include "ttkTheme.h"
+#include "ttkWidget.h"
+
+#define DEFAULT_BORDERWIDTH "2"
+#define DEFAULT_ARROW_SIZE "15"
+#define MIN_THUMB_SIZE 10
+
+/*----------------------------------------------------------------------
+ * +++ Null element. Does nothing; used as a stub.
+ * Null element methods, option table and element spec are public,
+ * and may be used in other engines.
+ */
+
+/* public */ Ttk_ElementOptionSpec TtkNullElementOptions[] = { { NULL, 0, 0, NULL } };
+
+/* public */ void
+TtkNullElementSize(
+ void *clientData, void *elementRecord, Tk_Window tkwin,
+ int *widthPtr, int *heightPtr, Ttk_Padding *paddingPtr)
+{
+}
+
+/* public */ void
+TtkNullElementDraw(
+ void *clientData, void *elementRecord, Tk_Window tkwin,
+ Drawable d, Ttk_Box b, unsigned int state)
+{
+}
+
+/* public */ Ttk_ElementSpec ttkNullElementSpec = {
+ TK_STYLE_VERSION_2,
+ sizeof(NullElement),
+ TtkNullElementOptions,
+ TtkNullElementSize,
+ TtkNullElementDraw
+};
+
+/*----------------------------------------------------------------------
+ * +++ Background and fill elements.
+ *
+ * The fill element fills its parcel with the background color.
+ * The background element ignores the parcel, and fills the entire window.
+ *
+ * Ttk_GetLayout() automatically includes a background element.
+ */
+
+typedef struct {
+ Tcl_Obj *backgroundObj;
+} BackgroundElement;
+
+static Ttk_ElementOptionSpec BackgroundElementOptions[] = {
+ { "-background", TK_OPTION_BORDER,
+ Tk_Offset(BackgroundElement,backgroundObj), DEFAULT_BACKGROUND },
+ { NULL, 0, 0, NULL }
+};
+
+static void FillElementDraw(
+ void *clientData, void *elementRecord, Tk_Window tkwin,
+ Drawable d, Ttk_Box b, unsigned int state)
+{
+ BackgroundElement *bg = elementRecord;
+ Tk_3DBorder backgroundPtr = Tk_Get3DBorderFromObj(tkwin,bg->backgroundObj);
+
+ XFillRectangle(Tk_Display(tkwin), d,
+ Tk_3DBorderGC(tkwin, backgroundPtr, TK_3D_FLAT_GC),
+ b.x, b.y, b.width, b.height);
+}
+
+static void BackgroundElementDraw(
+ void *clientData, void *elementRecord, Tk_Window tkwin,
+ Drawable d, Ttk_Box b, unsigned int state)
+{
+ FillElementDraw(
+ clientData, elementRecord, tkwin,
+ d, Ttk_WinBox(tkwin), state);
+}
+
+static Ttk_ElementSpec FillElementSpec = {
+ TK_STYLE_VERSION_2,
+ sizeof(BackgroundElement),
+ BackgroundElementOptions,
+ TtkNullElementSize,
+ FillElementDraw
+};
+
+static Ttk_ElementSpec BackgroundElementSpec = {
+ TK_STYLE_VERSION_2,
+ sizeof(BackgroundElement),
+ BackgroundElementOptions,
+ TtkNullElementSize,
+ BackgroundElementDraw
+};
+
+/*----------------------------------------------------------------------
+ * +++ Border element.
+ */
+
+typedef struct {
+ Tcl_Obj *borderObj;
+ Tcl_Obj *borderWidthObj;
+ Tcl_Obj *reliefObj;
+} BorderElement;
+
+static Ttk_ElementOptionSpec BorderElementOptions[] = {
+ { "-background", TK_OPTION_BORDER,
+ Tk_Offset(BorderElement,borderObj), DEFAULT_BACKGROUND },
+ { "-borderwidth", TK_OPTION_PIXELS,
+ Tk_Offset(BorderElement,borderWidthObj), DEFAULT_BORDERWIDTH },
+ { "-relief", TK_OPTION_RELIEF,
+ Tk_Offset(BorderElement,reliefObj), "flat" },
+ { NULL, 0, 0, NULL }
+};
+
+static void BorderElementSize(
+ void *clientData, void *elementRecord, Tk_Window tkwin,
+ int *widthPtr, int *heightPtr, Ttk_Padding *paddingPtr)
+{
+ BorderElement *bd = elementRecord;
+ int borderWidth = 0;
+ Tcl_GetIntFromObj(NULL, bd->borderWidthObj, &borderWidth);
+ *paddingPtr = Ttk_UniformPadding((short)borderWidth);
+}
+
+static void BorderElementDraw(
+ void *clientData, void *elementRecord, Tk_Window tkwin,
+ Drawable d, Ttk_Box b, unsigned int state)
+{
+ BorderElement *bd = elementRecord;
+ Tk_3DBorder border = NULL;
+ int borderWidth = 1, relief = TK_RELIEF_FLAT;
+
+ border = Tk_Get3DBorderFromObj(tkwin, bd->borderObj);
+ Tcl_GetIntFromObj(NULL, bd->borderWidthObj, &borderWidth);
+ Tk_GetReliefFromObj(NULL, bd->reliefObj, &relief);
+
+ if (border && borderWidth > 0 && relief != TK_RELIEF_FLAT) {
+ Tk_Draw3DRectangle(tkwin, d, border,
+ b.x, b.y, b.width, b.height, borderWidth,relief);
+ }
+}
+
+static Ttk_ElementSpec BorderElementSpec = {
+ TK_STYLE_VERSION_2,
+ sizeof(BorderElement),
+ BorderElementOptions,
+ BorderElementSize,
+ BorderElementDraw
+};
+
+/*----------------------------------------------------------------------
+ * +++ Field element.
+ * Used for editable fields.
+ */
+typedef struct {
+ Tcl_Obj *borderObj;
+ Tcl_Obj *borderWidthObj;
+} FieldElement;
+
+static Ttk_ElementOptionSpec FieldElementOptions[] = {
+ { "-fieldbackground", TK_OPTION_BORDER,
+ Tk_Offset(FieldElement,borderObj), "white" },
+ { "-borderwidth", TK_OPTION_PIXELS,
+ Tk_Offset(FieldElement,borderWidthObj), "2" },
+ { NULL, 0, 0, NULL }
+};
+
+static void FieldElementSize(
+ void *clientData, void *elementRecord, Tk_Window tkwin,
+ int *widthPtr, int *heightPtr, Ttk_Padding *paddingPtr)
+{
+ FieldElement *field = elementRecord;
+ int borderWidth = 2;
+ Tk_GetPixelsFromObj(NULL, tkwin, field->borderWidthObj, &borderWidth);
+ *paddingPtr = Ttk_UniformPadding((short)borderWidth);
+}
+
+static void FieldElementDraw(
+ void *clientData, void *elementRecord, Tk_Window tkwin,
+ Drawable d, Ttk_Box b, unsigned int state)
+{
+ FieldElement *field = elementRecord;
+ Tk_3DBorder border = Tk_Get3DBorderFromObj(tkwin, field->borderObj);
+ int borderWidth = 2;
+
+ Tk_GetPixelsFromObj(NULL, tkwin, field->borderWidthObj, &borderWidth);
+ Tk_Fill3DRectangle(tkwin, d, border,
+ b.x, b.y, b.width, b.height, borderWidth, TK_RELIEF_SUNKEN);
+}
+
+static Ttk_ElementSpec FieldElementSpec = {
+ TK_STYLE_VERSION_2,
+ sizeof(FieldElement),
+ FieldElementOptions,
+ FieldElementSize,
+ FieldElementDraw
+};
+
+/*
+ *----------------------------------------------------------------------
+ * +++ Padding element.
+ *
+ * This element has no visual representation, only geometry.
+ * It adds a (possibly non-uniform) internal border.
+ * In addition, if "-shiftrelief" is specified,
+ * adds additional pixels to shift child elements "in" or "out"
+ * depending on the -relief.
+ */
+
+typedef struct {
+ Tcl_Obj *paddingObj;
+ Tcl_Obj *reliefObj;
+ Tcl_Obj *shiftreliefObj;
+} PaddingElement;
+
+static Ttk_ElementOptionSpec PaddingElementOptions[] = {
+ { "-padding", TK_OPTION_STRING,
+ Tk_Offset(PaddingElement,paddingObj), "0" },
+ { "-relief", TK_OPTION_RELIEF,
+ Tk_Offset(PaddingElement,reliefObj), "flat" },
+ { "-shiftrelief", TK_OPTION_INT,
+ Tk_Offset(PaddingElement,shiftreliefObj), "0" },
+ { NULL, 0, 0, NULL }
+};
+
+static void PaddingElementSize(
+ void *clientData, void *elementRecord, Tk_Window tkwin,
+ int *widthPtr, int *heightPtr, Ttk_Padding *paddingPtr)
+{
+ PaddingElement *padding = elementRecord;
+ int shiftRelief = 0;
+ int relief = TK_RELIEF_FLAT;
+ Ttk_Padding pad;
+
+ Tk_GetReliefFromObj(NULL, padding->reliefObj, &relief);
+ Tcl_GetIntFromObj(NULL, padding->shiftreliefObj, &shiftRelief);
+ Ttk_GetPaddingFromObj(NULL,tkwin,padding->paddingObj,&pad);
+ *paddingPtr = Ttk_RelievePadding(pad, relief, shiftRelief);
+}
+
+static Ttk_ElementSpec PaddingElementSpec = {
+ TK_STYLE_VERSION_2,
+ sizeof(PaddingElement),
+ PaddingElementOptions,
+ PaddingElementSize,
+ TtkNullElementDraw
+};
+
+/*----------------------------------------------------------------------
+ * +++ Focus ring element.
+ * Draws a dashed focus ring, if the widget has keyboard focus.
+ */
+typedef struct {
+ Tcl_Obj *focusColorObj;
+ Tcl_Obj *focusThicknessObj;
+} FocusElement;
+
+/*
+ * DrawFocusRing --
+ * Draw a dotted rectangle to indicate focus.
+ */
+static void DrawFocusRing(
+ Tk_Window tkwin, Drawable d, Tcl_Obj *colorObj, Ttk_Box b)
+{
+ XColor *color = Tk_GetColorFromObj(tkwin, colorObj);
+ unsigned long mask = 0UL;
+ XGCValues gcvalues;
+ GC gc;
+
+ gcvalues.foreground = color->pixel;
+ gcvalues.line_style = LineOnOffDash;
+ gcvalues.line_width = 1;
+ gcvalues.dashes = 1;
+ gcvalues.dash_offset = 1;
+ mask = GCForeground | GCLineStyle | GCDashList | GCDashOffset | GCLineWidth;
+
+ gc = Tk_GetGC(tkwin, mask, &gcvalues);
+ XDrawRectangle(Tk_Display(tkwin), d, gc, b.x, b.y, b.width-1, b.height-1);
+ Tk_FreeGC(Tk_Display(tkwin), gc);
+}
+
+static Ttk_ElementOptionSpec FocusElementOptions[] = {
+ { "-focuscolor",TK_OPTION_COLOR,
+ Tk_Offset(FocusElement,focusColorObj), "black" },
+ { "-focusthickness",TK_OPTION_PIXELS,
+ Tk_Offset(FocusElement,focusThicknessObj), "1" },
+ { NULL, 0, 0, NULL }
+};
+
+static void FocusElementSize(
+ void *clientData, void *elementRecord, Tk_Window tkwin,
+ int *widthPtr, int *heightPtr, Ttk_Padding *paddingPtr)
+{
+ FocusElement *focus = elementRecord;
+ int focusThickness = 0;
+
+ Tcl_GetIntFromObj(NULL, focus->focusThicknessObj, &focusThickness);
+ *paddingPtr = Ttk_UniformPadding((short)focusThickness);
+}
+
+static void FocusElementDraw(
+ void *clientData, void *elementRecord, Tk_Window tkwin,
+ Drawable d, Ttk_Box b, unsigned int state)
+{
+ FocusElement *focus = elementRecord;
+ int focusThickness = 0;
+
+ if (state & TTK_STATE_FOCUS) {
+ Tcl_GetIntFromObj(NULL,focus->focusThicknessObj,&focusThickness);
+ DrawFocusRing(tkwin, d, focus->focusColorObj, b);
+ }
+}
+
+static Ttk_ElementSpec FocusElementSpec = {
+ TK_STYLE_VERSION_2,
+ sizeof(FocusElement),
+ FocusElementOptions,
+ FocusElementSize,
+ FocusElementDraw
+};
+
+/*----------------------------------------------------------------------
+ * +++ Separator element.
+ * Just draws a horizontal or vertical bar.
+ * Three elements are defined: horizontal, vertical, and general;
+ * the general separator checks the "-orient" option.
+ */
+
+typedef struct {
+ Tcl_Obj *orientObj;
+ Tcl_Obj *borderObj;
+} SeparatorElement;
+
+static Ttk_ElementOptionSpec SeparatorElementOptions[] = {
+ { "-orient", TK_OPTION_ANY,
+ Tk_Offset(SeparatorElement, orientObj), "horizontal" },
+ { "-background", TK_OPTION_BORDER,
+ Tk_Offset(SeparatorElement,borderObj), DEFAULT_BACKGROUND },
+ { NULL, 0, 0, NULL }
+};
+
+static void SeparatorElementSize(
+ void *clientData, void *elementRecord, Tk_Window tkwin,
+ int *widthPtr, int *heightPtr, Ttk_Padding *paddingPtr)
+{
+ *widthPtr = *heightPtr = 2;
+}
+
+static void HorizontalSeparatorElementDraw(
+ void *clientData, void *elementRecord, Tk_Window tkwin,
+ Drawable d, Ttk_Box b, unsigned int state)
+{
+ SeparatorElement *separator = elementRecord;
+ Tk_3DBorder border = Tk_Get3DBorderFromObj(tkwin, separator->borderObj);
+ GC lightGC = Tk_3DBorderGC(tkwin, border, TK_3D_LIGHT_GC);
+ GC darkGC = Tk_3DBorderGC(tkwin, border, TK_3D_DARK_GC);
+
+ XDrawLine(Tk_Display(tkwin), d, darkGC, b.x, b.y, b.x + b.width, b.y);
+ XDrawLine(Tk_Display(tkwin), d, lightGC, b.x, b.y+1, b.x + b.width, b.y+1);
+}
+
+static void VerticalSeparatorElementDraw(
+ void *clientData, void *elementRecord, Tk_Window tkwin,
+ Drawable d, Ttk_Box b, unsigned int state)
+{
+ SeparatorElement *separator = elementRecord;
+ Tk_3DBorder border = Tk_Get3DBorderFromObj(tkwin, separator->borderObj);
+ GC lightGC = Tk_3DBorderGC(tkwin, border, TK_3D_LIGHT_GC);
+ GC darkGC = Tk_3DBorderGC(tkwin, border, TK_3D_DARK_GC);
+
+ XDrawLine(Tk_Display(tkwin), d, darkGC, b.x, b.y, b.x, b.y + b.height);
+ XDrawLine(Tk_Display(tkwin), d, lightGC, b.x+1, b.y, b.x+1, b.y+b.height);
+}
+
+static void GeneralSeparatorElementDraw(
+ void *clientData, void *elementRecord, Tk_Window tkwin,
+ Drawable d, Ttk_Box b, unsigned int state)
+{
+ SeparatorElement *separator = elementRecord;
+ int orient;
+ Ttk_GetOrientFromObj(NULL, separator->orientObj, &orient);
+ switch (orient) {
+ case TTK_ORIENT_HORIZONTAL:
+ HorizontalSeparatorElementDraw(
+ clientData, elementRecord, tkwin, d, b, state);
+ break;
+ case TTK_ORIENT_VERTICAL:
+ VerticalSeparatorElementDraw(
+ clientData, elementRecord, tkwin, d, b, state);
+ break;
+ }
+}
+
+static Ttk_ElementSpec HorizontalSeparatorElementSpec = {
+ TK_STYLE_VERSION_2,
+ sizeof(SeparatorElement),
+ SeparatorElementOptions,
+ SeparatorElementSize,
+ HorizontalSeparatorElementDraw
+};
+
+static Ttk_ElementSpec VerticalSeparatorElementSpec = {
+ TK_STYLE_VERSION_2,
+ sizeof(SeparatorElement),
+ SeparatorElementOptions,
+ SeparatorElementSize,
+ HorizontalSeparatorElementDraw
+};
+
+static Ttk_ElementSpec SeparatorElementSpec = {
+ TK_STYLE_VERSION_2,
+ sizeof(SeparatorElement),
+ SeparatorElementOptions,
+ SeparatorElementSize,
+ GeneralSeparatorElementDraw
+};
+
+/*----------------------------------------------------------------------
+ * +++ Sizegrip: lower-right corner grip handle for resizing window.
+ */
+
+typedef struct {
+ Tcl_Obj *backgroundObj;
+} SizegripElement;
+
+static Ttk_ElementOptionSpec SizegripOptions[] = {
+ { "-background", TK_OPTION_BORDER,
+ Tk_Offset(SizegripElement,backgroundObj), DEFAULT_BACKGROUND },
+ {0,0,0,0}
+};
+
+static void SizegripSize(
+ void *clientData, void *elementRecord, Tk_Window tkwin,
+ int *widthPtr, int *heightPtr, Ttk_Padding *paddingPtr)
+{
+ int gripCount = 3, gripSpace = 2, gripThickness = 3;
+ *widthPtr = *heightPtr = gripCount * (gripSpace + gripThickness);
+}
+
+static void SizegripDraw(
+ void *clientData, void *elementRecord, Tk_Window tkwin,
+ Drawable d, Ttk_Box b, Ttk_State state)
+{
+ SizegripElement *grip = elementRecord;
+ int gripCount = 3, gripSpace = 2;
+ Tk_3DBorder border = Tk_Get3DBorderFromObj(tkwin, grip->backgroundObj);
+ GC lightGC = Tk_3DBorderGC(tkwin, border, TK_3D_LIGHT_GC);
+ GC darkGC = Tk_3DBorderGC(tkwin, border, TK_3D_DARK_GC);
+ int x1 = b.x + b.width-1, y1 = b.y + b.height-1, x2 = x1, y2 = y1;
+
+ while (gripCount--) {
+ x1 -= gripSpace; y2 -= gripSpace;
+ XDrawLine(Tk_Display(tkwin), d, darkGC, x1,y1, x2,y2); --x1; --y2;
+ XDrawLine(Tk_Display(tkwin), d, darkGC, x1,y1, x2,y2); --x1; --y2;
+ XDrawLine(Tk_Display(tkwin), d, lightGC, x1,y1, x2,y2); --x1; --y2;
+ }
+}
+
+static Ttk_ElementSpec SizegripElementSpec = {
+ TK_STYLE_VERSION_2,
+ sizeof(SizegripElement),
+ SizegripOptions,
+ SizegripSize,
+ SizegripDraw
+};
+
+/*----------------------------------------------------------------------
+ * +++ Indicator element.
+ *
+ * Draws the on/off indicator for checkbuttons and radiobuttons.
+ *
+ * Draws a 3-D square (or diamond), raised if off, sunken if on.
+ *
+ * This is actually a regression from Tk 8.5 back to the ugly old Motif
+ * style; use "altTheme" for the newer, nicer version.
+ */
+
+typedef struct {
+ Tcl_Obj *backgroundObj;
+ Tcl_Obj *reliefObj;
+ Tcl_Obj *colorObj;
+ Tcl_Obj *diameterObj;
+ Tcl_Obj *marginObj;
+ Tcl_Obj *borderWidthObj;
+} IndicatorElement;
+
+static Ttk_ElementOptionSpec IndicatorElementOptions[] = {
+ { "-background", TK_OPTION_BORDER,
+ Tk_Offset(IndicatorElement,backgroundObj), DEFAULT_BACKGROUND },
+ { "-indicatorcolor", TK_OPTION_BORDER,
+ Tk_Offset(IndicatorElement,colorObj), DEFAULT_BACKGROUND },
+ { "-indicatorrelief", TK_OPTION_RELIEF,
+ Tk_Offset(IndicatorElement,reliefObj), "raised" },
+ { "-indicatordiameter", TK_OPTION_PIXELS,
+ Tk_Offset(IndicatorElement,diameterObj), "12" },
+ { "-indicatormargin", TK_OPTION_STRING,
+ Tk_Offset(IndicatorElement,marginObj), "0 2 4 2" },
+ { "-borderwidth", TK_OPTION_PIXELS,
+ Tk_Offset(IndicatorElement,borderWidthObj), DEFAULT_BORDERWIDTH },
+ { NULL, 0, 0, NULL }
+};
+
+/*
+ * Checkbutton indicators (default): 3-D square.
+ */
+static void SquareIndicatorElementSize(
+ void *clientData, void *elementRecord, Tk_Window tkwin,
+ int *widthPtr, int *heightPtr, Ttk_Padding *paddingPtr)
+{
+ IndicatorElement *indicator = elementRecord;
+ Ttk_Padding margins;
+ int diameter = 0;
+ Ttk_GetPaddingFromObj(NULL, tkwin, indicator->marginObj, &margins);
+ Tk_GetPixelsFromObj(NULL, tkwin, indicator->diameterObj, &diameter);
+ *widthPtr = diameter + Ttk_PaddingWidth(margins);
+ *heightPtr = diameter + Ttk_PaddingHeight(margins);
+}
+
+static void SquareIndicatorElementDraw(
+ void *clientData, void *elementRecord, Tk_Window tkwin,
+ Drawable d, Ttk_Box b, unsigned int state)
+{
+ IndicatorElement *indicator = elementRecord;
+ Tk_3DBorder border = 0, interior = 0;
+ int relief = TK_RELIEF_RAISED;
+ Ttk_Padding padding;
+ int borderWidth = 2;
+ int diameter;
+
+ interior = Tk_Get3DBorderFromObj(tkwin, indicator->colorObj);
+ border = Tk_Get3DBorderFromObj(tkwin, indicator->backgroundObj);
+ Tcl_GetIntFromObj(NULL,indicator->borderWidthObj,&borderWidth);
+ Tk_GetReliefFromObj(NULL,indicator->reliefObj,&relief);
+ Ttk_GetPaddingFromObj(NULL,tkwin,indicator->marginObj,&padding);
+
+ b = Ttk_PadBox(b, padding);
+
+ diameter = b.width < b.height ? b.width : b.height;
+ Tk_Fill3DRectangle(tkwin, d, interior, b.x, b.y,
+ diameter, diameter,borderWidth, TK_RELIEF_FLAT);
+ Tk_Draw3DRectangle(tkwin, d, border, b.x, b.y,
+ diameter, diameter, borderWidth, relief);
+}
+
+/*
+ * Radiobutton indicators: 3-D diamond.
+ */
+static void DiamondIndicatorElementSize(
+ void *clientData, void *elementRecord, Tk_Window tkwin,
+ int *widthPtr, int *heightPtr, Ttk_Padding *paddingPtr)
+{
+ IndicatorElement *indicator = elementRecord;
+ Ttk_Padding margins;
+ int diameter = 0;
+ Ttk_GetPaddingFromObj(NULL, tkwin, indicator->marginObj, &margins);
+ Tk_GetPixelsFromObj(NULL, tkwin, indicator->diameterObj, &diameter);
+ *widthPtr = diameter + 3 + Ttk_PaddingWidth(margins);
+ *heightPtr = diameter + 3 + Ttk_PaddingHeight(margins);
+}
+
+static void DiamondIndicatorElementDraw(
+ void *clientData, void *elementRecord, Tk_Window tkwin,
+ Drawable d, Ttk_Box b, unsigned int state)
+{
+ IndicatorElement *indicator = elementRecord;
+ Tk_3DBorder border = 0, interior = 0;
+ int borderWidth = 2;
+ int relief = TK_RELIEF_RAISED;
+ int diameter, radius;
+ XPoint points[4];
+ Ttk_Padding padding;
+
+ interior = Tk_Get3DBorderFromObj(tkwin, indicator->colorObj);
+ border = Tk_Get3DBorderFromObj(tkwin, indicator->backgroundObj);
+ Tcl_GetIntFromObj(NULL,indicator->borderWidthObj,&borderWidth);
+ Tk_GetReliefFromObj(NULL,indicator->reliefObj,&relief);
+ Ttk_GetPaddingFromObj(NULL,tkwin,indicator->marginObj,&padding);
+
+ b = Ttk_PadBox(b, padding);
+
+ diameter = b.width < b.height ? b.width : b.height;
+ radius = diameter / 2;
+
+ points[0].x = b.x;
+ points[0].y = b.y + radius;
+ points[1].x = b.x + radius;
+ points[1].y = b.y + 2*radius;
+ points[2].x = b.x + 2*radius;
+ points[2].y = b.y + radius;
+ points[3].x = b.x + radius;
+ points[3].y = b.y;
+
+ Tk_Fill3DPolygon(tkwin,d,interior,points,4,borderWidth,TK_RELIEF_FLAT);
+ Tk_Draw3DPolygon(tkwin,d,border,points,4,borderWidth,relief);
+}
+
+static Ttk_ElementSpec CheckbuttonIndicatorElementSpec = {
+ TK_STYLE_VERSION_2,
+ sizeof(IndicatorElement),
+ IndicatorElementOptions,
+ SquareIndicatorElementSize,
+ SquareIndicatorElementDraw
+};
+
+static Ttk_ElementSpec RadiobuttonIndicatorElementSpec = {
+ TK_STYLE_VERSION_2,
+ sizeof(IndicatorElement),
+ IndicatorElementOptions,
+ DiamondIndicatorElementSize,
+ DiamondIndicatorElementDraw
+};
+
+/*
+ *----------------------------------------------------------------------
+ * +++ Menubutton indicators.
+ *
+ * These aren't functional like radio/check indicators,
+ * they're just affordability indicators.
+ *
+ * Standard Tk sets the indicator size to 4.0 mm by 1.7 mm.
+ * I have no idea where these numbers came from.
+ */
+
+typedef struct {
+ Tcl_Obj *backgroundObj;
+ Tcl_Obj *widthObj;
+ Tcl_Obj *heightObj;
+ Tcl_Obj *borderWidthObj;
+ Tcl_Obj *reliefObj;
+ Tcl_Obj *marginObj;
+} MenuIndicatorElement;
+
+static Ttk_ElementOptionSpec MenuIndicatorElementOptions[] = {
+ { "-background", TK_OPTION_BORDER,
+ Tk_Offset(MenuIndicatorElement,backgroundObj), DEFAULT_BACKGROUND },
+ { "-indicatorwidth", TK_OPTION_PIXELS,
+ Tk_Offset(MenuIndicatorElement,widthObj), "4.0m" },
+ { "-indicatorheight", TK_OPTION_PIXELS,
+ Tk_Offset(MenuIndicatorElement,heightObj), "1.7m" },
+ { "-borderwidth", TK_OPTION_PIXELS,
+ Tk_Offset(MenuIndicatorElement,borderWidthObj), DEFAULT_BORDERWIDTH },
+ { "-indicatorrelief", TK_OPTION_RELIEF,
+ Tk_Offset(MenuIndicatorElement,reliefObj),"raised" },
+ { "-indicatormargin", TK_OPTION_STRING,
+ Tk_Offset(MenuIndicatorElement,marginObj), "5 0" },
+ { NULL, 0, 0, NULL }
+};
+
+static void MenuIndicatorElementSize(
+ void *clientData, void *elementRecord, Tk_Window tkwin,
+ int *widthPtr, int *heightPtr, Ttk_Padding *paddingPtr)
+{
+ MenuIndicatorElement *mi = elementRecord;
+ Ttk_Padding margins;
+ Tk_GetPixelsFromObj(NULL, tkwin, mi->widthObj, widthPtr);
+ Tk_GetPixelsFromObj(NULL, tkwin, mi->heightObj, heightPtr);
+ Ttk_GetPaddingFromObj(NULL,tkwin,mi->marginObj, &margins);
+ *widthPtr += Ttk_PaddingWidth(margins);
+ *heightPtr += Ttk_PaddingHeight(margins);
+}
+
+static void MenuIndicatorElementDraw(
+ void *clientData, void *elementRecord, Tk_Window tkwin,
+ Drawable d, Ttk_Box b, unsigned int state)
+{
+ MenuIndicatorElement *mi = elementRecord;
+ Tk_3DBorder border = Tk_Get3DBorderFromObj(tkwin, mi->backgroundObj);
+ Ttk_Padding margins;
+ int borderWidth = 2;
+
+ Ttk_GetPaddingFromObj(NULL,tkwin,mi->marginObj,&margins);
+ b = Ttk_PadBox(b, margins);
+ Tk_GetPixelsFromObj(NULL, tkwin, mi->borderWidthObj, &borderWidth);
+ Tk_Fill3DRectangle(tkwin, d, border, b.x, b.y, b.width, b.height,
+ borderWidth, TK_RELIEF_RAISED);
+}
+
+static Ttk_ElementSpec MenuIndicatorElementSpec = {
+ TK_STYLE_VERSION_2,
+ sizeof(MenuIndicatorElement),
+ MenuIndicatorElementOptions,
+ MenuIndicatorElementSize,
+ MenuIndicatorElementDraw
+};
+
+/*----------------------------------------------------------------------
+ * +++ Arrow elements.
+ *
+ * Draws a solid triangle inside a box.
+ * clientData is an enum ArrowDirection pointer.
+ */
+
+static int ArrowElements[] = { ARROW_UP, ARROW_DOWN, ARROW_LEFT, ARROW_RIGHT };
+typedef struct {
+ Tcl_Obj *borderObj;
+ Tcl_Obj *borderWidthObj;
+ Tcl_Obj *reliefObj;
+ Tcl_Obj *sizeObj;
+ Tcl_Obj *colorObj;
+} ArrowElement;
+
+static Ttk_ElementOptionSpec ArrowElementOptions[] = {
+ { "-background", TK_OPTION_BORDER,
+ Tk_Offset(ArrowElement,borderObj), DEFAULT_BACKGROUND },
+ { "-relief",TK_OPTION_RELIEF,
+ Tk_Offset(ArrowElement,reliefObj),"raised"},
+ { "-borderwidth", TK_OPTION_PIXELS,
+ Tk_Offset(ArrowElement,borderWidthObj), "1" },
+ { "-arrowcolor",TK_OPTION_COLOR,
+ Tk_Offset(ArrowElement,colorObj),"black"},
+ { "-arrowsize", TK_OPTION_PIXELS,
+ Tk_Offset(ArrowElement,sizeObj), "14" },
+ { NULL, 0, 0, NULL }
+};
+
+static Ttk_Padding ArrowMargins = { 3,3,3,3 };
+
+static void ArrowElementSize(
+ void *clientData, void *elementRecord, Tk_Window tkwin,
+ int *widthPtr, int *heightPtr, Ttk_Padding *paddingPtr)
+{
+ ArrowElement *arrow = elementRecord;
+ int direction = *(int *)clientData;
+ int width = 14;
+
+ Tk_GetPixelsFromObj(NULL, tkwin, arrow->sizeObj, &width);
+ width -= Ttk_PaddingWidth(ArrowMargins);
+ TtkArrowSize(width/2, direction, widthPtr, heightPtr);
+ *widthPtr += Ttk_PaddingWidth(ArrowMargins);
+ *heightPtr += Ttk_PaddingWidth(ArrowMargins);
+}
+
+static void ArrowElementDraw(
+ void *clientData, void *elementRecord, Tk_Window tkwin,
+ Drawable d, Ttk_Box b, unsigned int state)
+{
+ int direction = *(int *)clientData;
+ ArrowElement *arrow = elementRecord;
+ Tk_3DBorder border = Tk_Get3DBorderFromObj(tkwin, arrow->borderObj);
+ XColor *arrowColor = Tk_GetColorFromObj(tkwin, arrow->colorObj);
+ int relief = TK_RELIEF_RAISED;
+ int borderWidth = 1;
+
+ Tk_GetReliefFromObj(NULL, arrow->reliefObj, &relief);
+
+ Tk_Fill3DRectangle(
+ tkwin, d, border, b.x, b.y, b.width, b.height, borderWidth, relief);
+
+ TtkFillArrow(Tk_Display(tkwin), d, Tk_GCForColor(arrowColor, d),
+ Ttk_PadBox(b, ArrowMargins), direction);
+}
+
+static Ttk_ElementSpec ArrowElementSpec = {
+ TK_STYLE_VERSION_2,
+ sizeof(ArrowElement),
+ ArrowElementOptions,
+ ArrowElementSize,
+ ArrowElementDraw
+};
+
+/*----------------------------------------------------------------------
+ * +++ Trough element.
+ *
+ * Used in scrollbars and scales in place of "border".
+ */
+
+typedef struct {
+ Tcl_Obj *colorObj;
+ Tcl_Obj *borderWidthObj;
+ Tcl_Obj *reliefObj;
+} TroughElement;
+
+static Ttk_ElementOptionSpec TroughElementOptions[] = {
+ { "-borderwidth", TK_OPTION_PIXELS,
+ Tk_Offset(TroughElement,borderWidthObj), DEFAULT_BORDERWIDTH },
+ { "-troughcolor", TK_OPTION_BORDER,
+ Tk_Offset(TroughElement,colorObj), DEFAULT_BACKGROUND },
+ { "-troughrelief",TK_OPTION_RELIEF,
+ Tk_Offset(TroughElement,reliefObj), "sunken" },
+ { NULL, 0, 0, NULL }
+};
+
+static void TroughElementSize(
+ void *clientData, void *elementRecord, Tk_Window tkwin,
+ int *widthPtr, int *heightPtr, Ttk_Padding *paddingPtr)
+{
+ TroughElement *troughPtr = elementRecord;
+ int borderWidth = 2;
+
+ Tk_GetPixelsFromObj(NULL, tkwin, troughPtr->borderWidthObj, &borderWidth);
+ *paddingPtr = Ttk_UniformPadding((short)borderWidth);
+}
+
+static void TroughElementDraw(
+ void *clientData, void *elementRecord, Tk_Window tkwin,
+ Drawable d, Ttk_Box b, unsigned int state)
+{
+ TroughElement *troughPtr = elementRecord;
+ Tk_3DBorder border = NULL;
+ int borderWidth = 2, relief = TK_RELIEF_SUNKEN;
+
+ border = Tk_Get3DBorderFromObj(tkwin, troughPtr->colorObj);
+ Tk_GetReliefFromObj(NULL, troughPtr->reliefObj, &relief);
+ Tk_GetPixelsFromObj(NULL, tkwin, troughPtr->borderWidthObj, &borderWidth);
+
+ Tk_Fill3DRectangle(tkwin, d, border, b.x, b.y, b.width, b.height,
+ borderWidth, relief);
+}
+
+static Ttk_ElementSpec TroughElementSpec = {
+ TK_STYLE_VERSION_2,
+ sizeof(TroughElement),
+ TroughElementOptions,
+ TroughElementSize,
+ TroughElementDraw
+};
+
+/*
+ *----------------------------------------------------------------------
+ * +++ Thumb element.
+ *
+ * Used in scrollbars.
+ */
+
+typedef struct {
+ Tcl_Obj *orientObj;
+ Tcl_Obj *thicknessObj;
+ Tcl_Obj *reliefObj;
+ Tcl_Obj *borderObj;
+ Tcl_Obj *borderWidthObj;
+} ThumbElement;
+
+static Ttk_ElementOptionSpec ThumbElementOptions[] = {
+ { "-orient", TK_OPTION_ANY,
+ Tk_Offset(ThumbElement, orientObj), "horizontal" },
+ { "-width", TK_OPTION_PIXELS,
+ Tk_Offset(ThumbElement,thicknessObj), DEFAULT_ARROW_SIZE },
+ { "-relief", TK_OPTION_RELIEF,
+ Tk_Offset(ThumbElement,reliefObj), "raised" },
+ { "-background", TK_OPTION_BORDER,
+ Tk_Offset(ThumbElement,borderObj), DEFAULT_BACKGROUND },
+ { "-borderwidth", TK_OPTION_PIXELS,
+ Tk_Offset(ThumbElement,borderWidthObj), DEFAULT_BORDERWIDTH },
+ { NULL, 0, 0, NULL }
+};
+
+static void ThumbElementSize(
+ void *clientData, void *elementRecord, Tk_Window tkwin,
+ int *widthPtr, int *heightPtr, Ttk_Padding *paddingPtr)
+{
+ ThumbElement *thumb = elementRecord;
+ int orient, thickness;
+
+ Tk_GetPixelsFromObj(NULL, tkwin, thumb->thicknessObj, &thickness);
+ Ttk_GetOrientFromObj(NULL, thumb->orientObj, &orient);
+
+ if (orient == TTK_ORIENT_VERTICAL) {
+ *widthPtr = thickness;
+ *heightPtr = MIN_THUMB_SIZE;
+ } else {
+ *widthPtr = MIN_THUMB_SIZE;
+ *heightPtr = thickness;
+ }
+}
+
+static void ThumbElementDraw(
+ void *clientData, void *elementRecord, Tk_Window tkwin,
+ Drawable d, Ttk_Box b, unsigned int state)
+{
+ ThumbElement *thumb = elementRecord;
+ Tk_3DBorder border = Tk_Get3DBorderFromObj(tkwin, thumb->borderObj);
+ int borderWidth = 2, relief = TK_RELIEF_RAISED;
+
+ Tk_GetPixelsFromObj(NULL, tkwin, thumb->borderWidthObj, &borderWidth);
+ Tk_GetReliefFromObj(NULL, thumb->reliefObj, &relief);
+ Tk_Fill3DRectangle(tkwin, d, border, b.x, b.y, b.width, b.height,
+ borderWidth, relief);
+}
+
+static Ttk_ElementSpec ThumbElementSpec = {
+ TK_STYLE_VERSION_2,
+ sizeof(ThumbElement),
+ ThumbElementOptions,
+ ThumbElementSize,
+ ThumbElementDraw
+};
+
+/*
+ *----------------------------------------------------------------------
+ * +++ Slider element.
+ *
+ * This is the moving part of the scale widget. Drawn as a raised box.
+ */
+
+typedef struct {
+ Tcl_Obj *orientObj; /* orientation of overall slider */
+ Tcl_Obj *lengthObj; /* slider length */
+ Tcl_Obj *thicknessObj; /* slider thickness */
+ Tcl_Obj *reliefObj; /* the relief for this object */
+ Tcl_Obj *borderObj; /* the background color */
+ Tcl_Obj *borderWidthObj; /* the size of the border */
+} SliderElement;
+
+static Ttk_ElementOptionSpec SliderElementOptions[] = {
+ { "-sliderlength", TK_OPTION_PIXELS, Tk_Offset(SliderElement,lengthObj),
+ "30" },
+ { "-sliderthickness",TK_OPTION_PIXELS,Tk_Offset(SliderElement,thicknessObj),
+ "15" },
+ { "-sliderrelief", TK_OPTION_RELIEF, Tk_Offset(SliderElement,reliefObj),
+ "raised" },
+ { "-borderwidth", TK_OPTION_PIXELS, Tk_Offset(SliderElement,borderWidthObj),
+ DEFAULT_BORDERWIDTH },
+ { "-background", TK_OPTION_BORDER, Tk_Offset(SliderElement,borderObj),
+ DEFAULT_BACKGROUND },
+ { "-orient", TK_OPTION_ANY, Tk_Offset(SliderElement,orientObj),
+ "horizontal" },
+ { NULL, 0, 0, NULL }
+};
+
+static void SliderElementSize(
+ void *clientData, void *elementRecord, Tk_Window tkwin,
+ int *widthPtr, int *heightPtr, Ttk_Padding *paddingPtr)
+{
+ SliderElement *slider = elementRecord;
+ int orient, length, thickness;
+
+ Ttk_GetOrientFromObj(NULL, slider->orientObj, &orient);
+ Tk_GetPixelsFromObj(NULL, tkwin, slider->lengthObj, &length);
+ Tk_GetPixelsFromObj(NULL, tkwin, slider->thicknessObj, &thickness);
+
+ switch (orient) {
+ case TTK_ORIENT_VERTICAL:
+ *widthPtr = thickness;
+ *heightPtr = length;
+ break;
+
+ case TTK_ORIENT_HORIZONTAL:
+ *widthPtr = length;
+ *heightPtr = thickness;
+ break;
+ }
+}
+
+static void SliderElementDraw(
+ void *clientData, void *elementRecord, Tk_Window tkwin,
+ Drawable d, Ttk_Box b, unsigned int state)
+{
+ SliderElement *slider = elementRecord;
+ Tk_3DBorder border = NULL;
+ int relief = TK_RELIEF_RAISED, borderWidth = 2, orient;
+
+ border = Tk_Get3DBorderFromObj(tkwin, slider->borderObj);
+ Ttk_GetOrientFromObj(NULL, slider->orientObj, &orient);
+ Tk_GetPixelsFromObj(NULL, tkwin, slider->borderWidthObj, &borderWidth);
+ Tk_GetReliefFromObj(NULL, slider->reliefObj, &relief);
+
+ Tk_Fill3DRectangle(tkwin, d, border,
+ b.x, b.y, b.width, b.height,
+ borderWidth, relief);
+
+ if (relief != TK_RELIEF_FLAT) {
+ if (orient == TTK_ORIENT_HORIZONTAL) {
+ if (b.width > 4) {
+ b.x += b.width/2;
+ XDrawLine(Tk_Display(tkwin), d,
+ Tk_3DBorderGC(tkwin, border, TK_3D_DARK_GC),
+ b.x-1, b.y+borderWidth, b.x-1, b.y+b.height-borderWidth);
+ XDrawLine(Tk_Display(tkwin), d,
+ Tk_3DBorderGC(tkwin, border, TK_3D_LIGHT_GC),
+ b.x, b.y+borderWidth, b.x, b.y+b.height-borderWidth);
+ }
+ } else {
+ if (b.height > 4) {
+ b.y += b.height/2;
+ XDrawLine(Tk_Display(tkwin), d,
+ Tk_3DBorderGC(tkwin, border, TK_3D_DARK_GC),
+ b.x+borderWidth, b.y-1, b.x+b.width-borderWidth, b.y-1);
+ XDrawLine(Tk_Display(tkwin), d,
+ Tk_3DBorderGC(tkwin, border, TK_3D_LIGHT_GC),
+ b.x+borderWidth, b.y, b.x+b.width-borderWidth, b.y);
+ }
+ }
+ }
+}
+
+static Ttk_ElementSpec SliderElementSpec = {
+ TK_STYLE_VERSION_2,
+ sizeof(SliderElement),
+ SliderElementOptions,
+ SliderElementSize,
+ SliderElementDraw
+};
+
+/*------------------------------------------------------------------------
+ * +++ Progress bar element:
+ * Draws the moving part of the progress bar.
+ *
+ * -thickness specifies the size along the short axis of the bar.
+ * -length specifies the default size along the long axis;
+ * the bar will be this long in indeterminate mode.
+ */
+
+#define DEFAULT_PBAR_THICKNESS "15"
+#define DEFAULT_PBAR_LENGTH "30"
+
+typedef struct {
+ Tcl_Obj *orientObj; /* widget orientation */
+ Tcl_Obj *thicknessObj; /* the height/width of the bar */
+ Tcl_Obj *lengthObj; /* default width/height of the bar */
+ Tcl_Obj *reliefObj; /* border relief for this object */
+ Tcl_Obj *borderObj; /* background color */
+ Tcl_Obj *borderWidthObj; /* thickness of the border */
+} PbarElement;
+
+static Ttk_ElementOptionSpec PbarElementOptions[] = {
+ { "-orient", TK_OPTION_ANY, Tk_Offset(PbarElement,orientObj),
+ "horizontal" },
+ { "-thickness", TK_OPTION_PIXELS, Tk_Offset(PbarElement,thicknessObj),
+ DEFAULT_PBAR_THICKNESS },
+ { "-barsize", TK_OPTION_PIXELS, Tk_Offset(PbarElement,lengthObj),
+ DEFAULT_PBAR_LENGTH },
+ { "-pbarrelief", TK_OPTION_RELIEF, Tk_Offset(PbarElement,reliefObj),
+ "raised" },
+ { "-borderwidth", TK_OPTION_PIXELS, Tk_Offset(PbarElement,borderWidthObj),
+ DEFAULT_BORDERWIDTH },
+ { "-background", TK_OPTION_BORDER, Tk_Offset(PbarElement,borderObj),
+ DEFAULT_BACKGROUND },
+ { NULL, 0, 0, NULL }
+};
+
+static void PbarElementSize(
+ void *clientData, void *elementRecord, Tk_Window tkwin,
+ int *widthPtr, int *heightPtr, Ttk_Padding *paddingPtr)
+{
+ PbarElement *pbar = elementRecord;
+ int orient, thickness = 15, length = 30, borderWidth = 2;
+
+ Ttk_GetOrientFromObj(NULL, pbar->orientObj, &orient);
+ Tk_GetPixelsFromObj(NULL, tkwin, pbar->thicknessObj, &thickness);
+ Tk_GetPixelsFromObj(NULL, tkwin, pbar->lengthObj, &length);
+ Tk_GetPixelsFromObj(NULL, tkwin, pbar->borderWidthObj, &borderWidth);
+
+ switch (orient) {
+ case TTK_ORIENT_HORIZONTAL:
+ *widthPtr = length + 2 * borderWidth;
+ *heightPtr = thickness + 2 * borderWidth;
+ break;
+ case TTK_ORIENT_VERTICAL:
+ *widthPtr = thickness + 2 * borderWidth;
+ *heightPtr = length + 2 * borderWidth;
+ break;
+ }
+}
+
+static void PbarElementDraw(
+ void *clientData, void *elementRecord, Tk_Window tkwin,
+ Drawable d, Ttk_Box b, Ttk_State state)
+{
+ PbarElement *pbar = elementRecord;
+ Tk_3DBorder border = Tk_Get3DBorderFromObj(tkwin, pbar->borderObj);
+ int relief = TK_RELIEF_RAISED, borderWidth = 2;
+
+ Tk_GetPixelsFromObj(NULL, tkwin, pbar->borderWidthObj, &borderWidth);
+ Tk_GetReliefFromObj(NULL, pbar->reliefObj, &relief);
+
+ Tk_Fill3DRectangle(tkwin, d, border,
+ b.x, b.y, b.width, b.height,
+ borderWidth, relief);
+}
+
+static Ttk_ElementSpec PbarElementSpec = {
+ TK_STYLE_VERSION_2,
+ sizeof(PbarElement),
+ PbarElementOptions,
+ PbarElementSize,
+ PbarElementDraw
+};
+
+/*------------------------------------------------------------------------
+ * +++ Notebook tabs and client area.
+ */
+
+typedef struct {
+ Tcl_Obj *borderWidthObj;
+ Tcl_Obj *backgroundObj;
+} TabElement;
+
+static Ttk_ElementOptionSpec TabElementOptions[] = {
+ { "-borderwidth", TK_OPTION_PIXELS,
+ Tk_Offset(TabElement,borderWidthObj),"1" },
+ { "-background", TK_OPTION_BORDER,
+ Tk_Offset(TabElement,backgroundObj), DEFAULT_BACKGROUND },
+ {0,0,0,0}
+};
+
+static void TabElementSize(
+ void *clientData, void *elementRecord, Tk_Window tkwin,
+ int *widthPtr, int *heightPtr, Ttk_Padding *paddingPtr)
+{
+ TabElement *tab = elementRecord;
+ int borderWidth = 1;
+ Tk_GetPixelsFromObj(0, tkwin, tab->borderWidthObj, &borderWidth);
+ paddingPtr->top = paddingPtr->left = paddingPtr->right = borderWidth;
+ paddingPtr->bottom = 0;
+}
+
+static void TabElementDraw(
+ void *clientData, void *elementRecord, Tk_Window tkwin,
+ Drawable d, Ttk_Box b, unsigned int state)
+{
+ TabElement *tab = elementRecord;
+ Tk_3DBorder border = Tk_Get3DBorderFromObj(tkwin, tab->backgroundObj);
+ int borderWidth = 1;
+ int cut = 2;
+ XPoint pts[6];
+ int n = 0;
+
+ Tcl_GetIntFromObj(NULL, tab->borderWidthObj, &borderWidth);
+
+ if (state & TTK_STATE_SELECTED) {
+ /*
+ * Draw slightly outside of the allocated parcel,
+ * to overwrite the client area border.
+ */
+ b.height += borderWidth;
+ }
+
+ pts[n].x = b.x; pts[n].y = b.y + b.height - 1; ++n;
+ pts[n].x = b.x; pts[n].y = b.y + cut; ++n;
+ pts[n].x = b.x + cut; pts[n].y = b.y; ++n;
+ pts[n].x = b.x + b.width-1-cut; pts[n].y = b.y; ++n;
+ pts[n].x = b.x + b.width-1; pts[n].y = b.y + cut; ++n;
+ pts[n].x = b.x + b.width-1; pts[n].y = b.y + b.height; ++n;
+
+ XFillPolygon(Tk_Display(tkwin), d,
+ Tk_3DBorderGC(tkwin, border, TK_3D_FLAT_GC),
+ pts, 6, Convex, CoordModeOrigin);
+
+#ifndef _WIN32
+ /*
+ * Account for whether XDrawLines draws endpoints by platform
+ */
+ --pts[5].y;
+#endif
+
+ while (borderWidth--) {
+ XDrawLines(Tk_Display(tkwin), d,
+ Tk_3DBorderGC(tkwin, border, TK_3D_LIGHT_GC),
+ pts, 4, CoordModeOrigin);
+ XDrawLines(Tk_Display(tkwin), d,
+ Tk_3DBorderGC(tkwin, border, TK_3D_DARK_GC),
+ pts+3, 3, CoordModeOrigin);
+ ++pts[0].x; ++pts[1].x; ++pts[2].x; --pts[4].x; --pts[5].x;
+ ++pts[2].y; ++pts[3].y;
+ }
+
+}
+
+static Ttk_ElementSpec TabElementSpec = {
+ TK_STYLE_VERSION_2,
+ sizeof(TabElement),
+ TabElementOptions,
+ TabElementSize,
+ TabElementDraw
+};
+
+/*
+ * Client area element:
+ * Uses same resources as tab element.
+ */
+typedef TabElement ClientElement;
+#define ClientElementOptions TabElementOptions
+
+static void ClientElementDraw(
+ void *clientData, void *elementRecord, Tk_Window tkwin,
+ Drawable d, Ttk_Box b, unsigned int state)
+{
+ ClientElement *ce = elementRecord;
+ Tk_3DBorder border = Tk_Get3DBorderFromObj(tkwin, ce->backgroundObj);
+ int borderWidth = 1;
+
+ Tcl_GetIntFromObj(NULL, ce->borderWidthObj, &borderWidth);
+
+ Tk_Fill3DRectangle(tkwin, d, border,
+ b.x, b.y, b.width, b.height, borderWidth,TK_RELIEF_RAISED);
+}
+
+static void ClientElementSize(
+ void *clientData, void *elementRecord, Tk_Window tkwin,
+ int *widthPtr, int *heightPtr, Ttk_Padding *paddingPtr)
+{
+ ClientElement *ce = elementRecord;
+ int borderWidth = 1;
+ Tk_GetPixelsFromObj(0, tkwin, ce->borderWidthObj, &borderWidth);
+ *paddingPtr = Ttk_UniformPadding((short)borderWidth);
+}
+
+static Ttk_ElementSpec ClientElementSpec = {
+ TK_STYLE_VERSION_2,
+ sizeof(ClientElement),
+ ClientElementOptions,
+ ClientElementSize,
+ ClientElementDraw
+};
+
+/*----------------------------------------------------------------------
+ * TtkElements_Init --
+ * Register default element implementations.
+ */
+
+MODULE_SCOPE
+void TtkElements_Init(Tcl_Interp *interp)
+{
+ Ttk_Theme theme = Ttk_GetDefaultTheme(interp);
+
+ /*
+ * Elements:
+ */
+ Ttk_RegisterElement(interp, theme, "background",
+ &BackgroundElementSpec,NULL);
+
+ Ttk_RegisterElement(interp, theme, "fill", &FillElementSpec, NULL);
+ Ttk_RegisterElement(interp, theme, "border", &BorderElementSpec, NULL);
+ Ttk_RegisterElement(interp, theme, "field", &FieldElementSpec, NULL);
+ Ttk_RegisterElement(interp, theme, "focus", &FocusElementSpec, NULL);
+
+ Ttk_RegisterElement(interp, theme, "padding", &PaddingElementSpec, NULL);
+
+ Ttk_RegisterElement(interp, theme, "Checkbutton.indicator",
+ &CheckbuttonIndicatorElementSpec, NULL);
+ Ttk_RegisterElement(interp, theme, "Radiobutton.indicator",
+ &RadiobuttonIndicatorElementSpec, NULL);
+ Ttk_RegisterElement(interp, theme, "Menubutton.indicator",
+ &MenuIndicatorElementSpec, NULL);
+
+ Ttk_RegisterElement(interp, theme, "indicator", &ttkNullElementSpec,NULL);
+
+ Ttk_RegisterElement(interp, theme, "uparrow",
+ &ArrowElementSpec, &ArrowElements[0]);
+ Ttk_RegisterElement(interp, theme, "downarrow",
+ &ArrowElementSpec, &ArrowElements[1]);
+ Ttk_RegisterElement(interp, theme, "leftarrow",
+ &ArrowElementSpec, &ArrowElements[2]);
+ Ttk_RegisterElement(interp, theme, "rightarrow",
+ &ArrowElementSpec, &ArrowElements[3]);
+ Ttk_RegisterElement(interp, theme, "arrow",
+ &ArrowElementSpec, &ArrowElements[0]);
+
+ Ttk_RegisterElement(interp, theme, "trough", &TroughElementSpec, NULL);
+ Ttk_RegisterElement(interp, theme, "thumb", &ThumbElementSpec, NULL);
+ Ttk_RegisterElement(interp, theme, "slider", &SliderElementSpec, NULL);
+ Ttk_RegisterElement(interp, theme, "pbar", &PbarElementSpec, NULL);
+
+ Ttk_RegisterElement(interp, theme, "separator",
+ &SeparatorElementSpec, NULL);
+ Ttk_RegisterElement(interp, theme, "hseparator",
+ &HorizontalSeparatorElementSpec, NULL);
+ Ttk_RegisterElement(interp, theme, "vseparator",
+ &VerticalSeparatorElementSpec, NULL);
+
+ Ttk_RegisterElement(interp, theme, "sizegrip", &SizegripElementSpec, NULL);
+
+ Ttk_RegisterElement(interp, theme, "tab", &TabElementSpec, NULL);
+ Ttk_RegisterElement(interp, theme, "client", &ClientElementSpec, NULL);
+
+ /*
+ * Register "default" as a user-loadable theme (for now):
+ */
+ Tcl_PkgProvideEx(interp, "ttk::theme::default", TTK_VERSION, NULL);
+}
+
+/*EOF*/
diff --git a/tk8.6/generic/ttk/ttkEntry.c b/tk8.6/generic/ttk/ttkEntry.c
new file mode 100644
index 0000000..f395649
--- /dev/null
+++ b/tk8.6/generic/ttk/ttkEntry.c
@@ -0,0 +1,2058 @@
+/*
+ * DERIVED FROM: tk/generic/tkEntry.c r1.35.
+ *
+ * Copyright (c) 1990-1994 The Regents of the University of California.
+ * Copyright (c) 1994-1997 Sun Microsystems, Inc.
+ * Copyright (c) 2000 Ajuba Solutions.
+ * Copyright (c) 2002 ActiveState Corporation.
+ * Copyright (c) 2004 Joe English
+ */
+
+#include <string.h>
+#include <stdio.h>
+#include <tkInt.h>
+#include <X11/Xatom.h>
+
+#include "ttkTheme.h"
+#include "ttkWidget.h"
+
+/*
+ * Extra bits for core.flags:
+ */
+#define GOT_SELECTION (WIDGET_USER_FLAG<<1)
+#define SYNCING_VARIABLE (WIDGET_USER_FLAG<<2)
+#define VALIDATING (WIDGET_USER_FLAG<<3)
+#define VALIDATION_SET_VALUE (WIDGET_USER_FLAG<<4)
+
+/*
+ * Definitions for -validate option values:
+ */
+typedef enum validateMode {
+ VMODE_ALL, VMODE_KEY, VMODE_FOCUS, VMODE_FOCUSIN, VMODE_FOCUSOUT, VMODE_NONE
+} VMODE;
+
+static const char *const validateStrings[] = {
+ "all", "key", "focus", "focusin", "focusout", "none", NULL
+};
+
+/*
+ * Validation reasons:
+ */
+typedef enum validateReason {
+ VALIDATE_INSERT, VALIDATE_DELETE,
+ VALIDATE_FOCUSIN, VALIDATE_FOCUSOUT,
+ VALIDATE_FORCED
+} VREASON;
+
+static const char *const validateReasonStrings[] = {
+ "key", "key", "focusin", "focusout", "forced", NULL
+};
+
+/*------------------------------------------------------------------------
+ * +++ Entry widget record.
+ *
+ * Dependencies:
+ *
+ * textVariableTrace : textVariableObj
+ *
+ * numBytes,numChars : string
+ * displayString : numChars, showChar
+ * layoutHeight,
+ * layoutWidth,
+ * textLayout : fontObj, displayString
+ * layoutX, layoutY : textLayout, justify, xscroll.first
+ *
+ * Invariants:
+ *
+ * 0 <= insertPos <= numChars
+ * 0 <= selectFirst < selectLast <= numChars || selectFirst == selectLast == -1
+ * displayString points to string if showChar == NULL,
+ * or to malloc'ed storage if showChar != NULL.
+ */
+
+/* Style parameters:
+ */
+typedef struct {
+ Tcl_Obj *foregroundObj; /* Foreground color for normal text */
+ Tcl_Obj *backgroundObj; /* Entry widget background color */
+ Tcl_Obj *selBorderObj; /* Border and background for selection */
+ Tcl_Obj *selBorderWidthObj; /* Width of selection border */
+ Tcl_Obj *selForegroundObj; /* Foreground color for selected text */
+ Tcl_Obj *insertColorObj; /* Color of insertion cursor */
+ Tcl_Obj *insertWidthObj; /* Insert cursor width */
+} EntryStyleData;
+
+typedef struct {
+ /*
+ * Internal state:
+ */
+ char *string; /* Storage for string (malloced) */
+ int numBytes; /* Length of string in bytes. */
+ int numChars; /* Length of string in characters. */
+
+ int insertPos; /* Insert index */
+ int selectFirst; /* Index of start of selection, or -1 */
+ int selectLast; /* Index of end of selection, or -1 */
+
+ Scrollable xscroll; /* Current scroll position */
+ ScrollHandle xscrollHandle;
+
+ /*
+ * Options managed by Tk_SetOptions:
+ */
+ Tcl_Obj *textVariableObj; /* Name of linked variable */
+ int exportSelection; /* Tie internal selection to X selection? */
+
+ VMODE validate; /* Validation mode */
+ char *validateCmd; /* Validation script template */
+ char *invalidCmd; /* Invalid callback script template */
+
+ char *showChar; /* Used to derive displayString */
+
+ Tcl_Obj *fontObj; /* Text font to use */
+ Tcl_Obj *widthObj; /* Desired width of window (in avgchars) */
+ Tk_Justify justify; /* Text justification */
+
+ EntryStyleData styleData; /* Display style data (widget options) */
+ EntryStyleData styleDefaults;/* Style defaults (fallback values) */
+
+ Tcl_Obj *stateObj; /* Compatibility option -- see CheckStateObj */
+
+ /*
+ * Derived resources:
+ */
+ Ttk_TraceHandle *textVariableTrace;
+
+ char *displayString; /* String to use when displaying */
+ Tk_TextLayout textLayout; /* Cached text layout information. */
+ int layoutWidth; /* textLayout width */
+ int layoutHeight; /* textLayout height */
+
+ int layoutX, layoutY; /* Origin for text layout. */
+
+} EntryPart;
+
+typedef struct {
+ WidgetCore core;
+ EntryPart entry;
+} Entry;
+
+/*
+ * Extra mask bits for Tk_SetOptions()
+ */
+#define STATE_CHANGED (0x100) /* -state option changed */
+#define TEXTVAR_CHANGED (0x200) /* -textvariable option changed */
+#define SCROLLCMD_CHANGED (0x400) /* -xscrollcommand option changed */
+
+/*
+ * Default option values:
+ */
+#define DEF_SELECT_BG "#000000"
+#define DEF_SELECT_FG "#ffffff"
+#define DEF_INSERT_BG "black"
+#define DEF_ENTRY_WIDTH "20"
+#define DEF_ENTRY_FONT "TkTextFont"
+#define DEF_LIST_HEIGHT "10"
+
+static Tk_OptionSpec EntryOptionSpecs[] = {
+ {TK_OPTION_BOOLEAN, "-exportselection", "exportSelection",
+ "ExportSelection", "1", -1, Tk_Offset(Entry, entry.exportSelection),
+ 0,0,0 },
+ {TK_OPTION_FONT, "-font", "font", "Font",
+ DEF_ENTRY_FONT, Tk_Offset(Entry, entry.fontObj),-1,
+ 0,0,GEOMETRY_CHANGED},
+ {TK_OPTION_STRING, "-invalidcommand", "invalidCommand", "InvalidCommand",
+ NULL, -1, Tk_Offset(Entry, entry.invalidCmd),
+ TK_OPTION_NULL_OK, 0, 0},
+ {TK_OPTION_JUSTIFY, "-justify", "justify", "Justify",
+ "left", -1, Tk_Offset(Entry, entry.justify),
+ 0, 0, GEOMETRY_CHANGED},
+ {TK_OPTION_STRING, "-show", "show", "Show",
+ NULL, -1, Tk_Offset(Entry, entry.showChar),
+ TK_OPTION_NULL_OK, 0, 0},
+ {TK_OPTION_STRING, "-state", "state", "State",
+ "normal", Tk_Offset(Entry, entry.stateObj), -1,
+ 0,0,STATE_CHANGED},
+ {TK_OPTION_STRING, "-textvariable", "textVariable", "Variable",
+ NULL, Tk_Offset(Entry, entry.textVariableObj), -1,
+ TK_OPTION_NULL_OK,0,TEXTVAR_CHANGED},
+ {TK_OPTION_STRING_TABLE, "-validate", "validate", "Validate",
+ "none", -1, Tk_Offset(Entry, entry.validate),
+ 0, (ClientData) validateStrings, 0},
+ {TK_OPTION_STRING, "-validatecommand", "validateCommand", "ValidateCommand",
+ NULL, -1, Tk_Offset(Entry, entry.validateCmd),
+ TK_OPTION_NULL_OK, 0, 0},
+ {TK_OPTION_INT, "-width", "width", "Width",
+ DEF_ENTRY_WIDTH, Tk_Offset(Entry, entry.widthObj), -1,
+ 0,0,GEOMETRY_CHANGED},
+ {TK_OPTION_STRING, "-xscrollcommand", "xScrollCommand", "ScrollCommand",
+ NULL, -1, Tk_Offset(Entry, entry.xscroll.scrollCmd),
+ TK_OPTION_NULL_OK, 0, SCROLLCMD_CHANGED},
+
+ /* EntryStyleData options:
+ */
+ {TK_OPTION_COLOR, "-foreground", "textColor", "TextColor",
+ NULL, Tk_Offset(Entry, entry.styleData.foregroundObj), -1,
+ TK_OPTION_NULL_OK,0,0},
+ {TK_OPTION_COLOR, "-background", "windowColor", "WindowColor",
+ NULL, Tk_Offset(Entry, entry.styleData.backgroundObj), -1,
+ TK_OPTION_NULL_OK,0,0},
+
+ WIDGET_TAKEFOCUS_TRUE,
+ WIDGET_INHERIT_OPTIONS(ttkCoreOptionSpecs)
+};
+
+/*------------------------------------------------------------------------
+ * +++ EntryStyleData management.
+ * This is still more awkward than it should be;
+ * it should be able to use the Element API instead.
+ */
+
+/* EntryInitStyleDefaults --
+ * Initialize EntryStyleData record to fallback values.
+ */
+static void EntryInitStyleDefaults(EntryStyleData *es)
+{
+#define INIT(member, value) \
+ es->member = Tcl_NewStringObj(value, -1); \
+ Tcl_IncrRefCount(es->member);
+ INIT(foregroundObj, DEFAULT_FOREGROUND)
+ INIT(selBorderObj, DEF_SELECT_BG)
+ INIT(selForegroundObj, DEF_SELECT_FG)
+ INIT(insertColorObj, DEFAULT_FOREGROUND)
+ INIT(selBorderWidthObj, "0")
+ INIT(insertWidthObj, "1")
+#undef INIT
+}
+
+static void EntryFreeStyleDefaults(EntryStyleData *es)
+{
+ Tcl_DecrRefCount(es->foregroundObj);
+ Tcl_DecrRefCount(es->selBorderObj);
+ Tcl_DecrRefCount(es->selForegroundObj);
+ Tcl_DecrRefCount(es->insertColorObj);
+ Tcl_DecrRefCount(es->selBorderWidthObj);
+ Tcl_DecrRefCount(es->insertWidthObj);
+}
+
+/*
+ * EntryInitStyleData --
+ * Look up style-specific data for an entry widget.
+ */
+static void EntryInitStyleData(Entry *entryPtr, EntryStyleData *es)
+{
+ Ttk_State state = entryPtr->core.state;
+ Ttk_ResourceCache cache = Ttk_GetResourceCache(entryPtr->core.interp);
+ Tk_Window tkwin = entryPtr->core.tkwin;
+ Tcl_Obj *tmp;
+
+ /* Initialize to fallback values:
+ */
+ *es = entryPtr->entry.styleDefaults;
+
+# define INIT(member, name) \
+ if ((tmp=Ttk_QueryOption(entryPtr->core.layout,name,state))) \
+ es->member=tmp;
+ INIT(foregroundObj, "-foreground");
+ INIT(selBorderObj, "-selectbackground")
+ INIT(selBorderWidthObj, "-selectborderwidth")
+ INIT(selForegroundObj, "-selectforeground")
+ INIT(insertColorObj, "-insertcolor")
+ INIT(insertWidthObj, "-insertwidth")
+#undef INIT
+
+ /* Reacquire color & border resources from resource cache.
+ */
+ es->foregroundObj = Ttk_UseColor(cache, tkwin, es->foregroundObj);
+ es->selForegroundObj = Ttk_UseColor(cache, tkwin, es->selForegroundObj);
+ es->insertColorObj = Ttk_UseColor(cache, tkwin, es->insertColorObj);
+ es->selBorderObj = Ttk_UseBorder(cache, tkwin, es->selBorderObj);
+}
+
+/*------------------------------------------------------------------------
+ * +++ Resource management.
+ */
+
+/* EntryDisplayString --
+ * Return a malloc'ed string consisting of 'numChars' copies
+ * of (the first character in the string) 'showChar'.
+ * Used to compute the displayString if -show is non-NULL.
+ */
+static char *EntryDisplayString(const char *showChar, int numChars)
+{
+ char *displayString, *p;
+ int size;
+ Tcl_UniChar ch;
+ char buf[TCL_UTF_MAX];
+
+ Tcl_UtfToUniChar(showChar, &ch);
+ size = Tcl_UniCharToUtf(ch, buf);
+ p = displayString = ckalloc(numChars * size + 1);
+
+ while (numChars--) {
+ p += Tcl_UniCharToUtf(ch, p);
+ }
+ *p = '\0';
+
+ return displayString;
+}
+
+/* EntryUpdateTextLayout --
+ * Recompute textLayout, layoutWidth, and layoutHeight
+ * from displayString and fontObj.
+ */
+static void EntryUpdateTextLayout(Entry *entryPtr)
+{
+ Tk_FreeTextLayout(entryPtr->entry.textLayout);
+ entryPtr->entry.textLayout = Tk_ComputeTextLayout(
+ Tk_GetFontFromObj(entryPtr->core.tkwin, entryPtr->entry.fontObj),
+ entryPtr->entry.displayString, entryPtr->entry.numChars,
+ 0/*wraplength*/, entryPtr->entry.justify, TK_IGNORE_NEWLINES,
+ &entryPtr->entry.layoutWidth, &entryPtr->entry.layoutHeight);
+}
+
+/* EntryEditable --
+ * Returns 1 if the entry widget accepts user changes, 0 otherwise
+ */
+static int
+EntryEditable(Entry *entryPtr)
+{
+ return !(entryPtr->core.state & (TTK_STATE_DISABLED|TTK_STATE_READONLY));
+}
+
+/*------------------------------------------------------------------------
+ * +++ Selection management.
+ */
+
+/* EntryFetchSelection --
+ * Selection handler for entry widgets.
+ */
+static int
+EntryFetchSelection(
+ ClientData clientData, int offset, char *buffer, int maxBytes)
+{
+ Entry *entryPtr = (Entry *) clientData;
+ size_t byteCount;
+ const char *string;
+ const char *selStart, *selEnd;
+
+ if (entryPtr->entry.selectFirst < 0 || !entryPtr->entry.exportSelection) {
+ return -1;
+ }
+ string = entryPtr->entry.displayString;
+
+ selStart = Tcl_UtfAtIndex(string, entryPtr->entry.selectFirst);
+ selEnd = Tcl_UtfAtIndex(selStart,
+ entryPtr->entry.selectLast - entryPtr->entry.selectFirst);
+ byteCount = selEnd - selStart - offset;
+ if (byteCount > (size_t)maxBytes) {
+ /* @@@POSSIBLE BUG: Can transfer partial UTF-8 sequences. Is this OK? */
+ byteCount = maxBytes;
+ }
+ if (byteCount <= 0) {
+ return 0;
+ }
+ memcpy(buffer, selStart + offset, byteCount);
+ buffer[byteCount] = '\0';
+ return byteCount;
+}
+
+/* EntryLostSelection --
+ * Tk_LostSelProc for Entry widgets; called when an entry
+ * loses ownership of the selection.
+ */
+static void EntryLostSelection(ClientData clientData)
+{
+ Entry *entryPtr = (Entry *) clientData;
+ entryPtr->core.flags &= ~GOT_SELECTION;
+ entryPtr->entry.selectFirst = entryPtr->entry.selectLast = -1;
+ TtkRedisplayWidget(&entryPtr->core);
+}
+
+/* EntryOwnSelection --
+ * Assert ownership of the PRIMARY selection,
+ * if -exportselection set and selection is present.
+ */
+static void EntryOwnSelection(Entry *entryPtr)
+{
+ if (entryPtr->entry.exportSelection
+ && !(entryPtr->core.flags & GOT_SELECTION)) {
+ Tk_OwnSelection(entryPtr->core.tkwin, XA_PRIMARY, EntryLostSelection,
+ (ClientData) entryPtr);
+ entryPtr->core.flags |= GOT_SELECTION;
+ }
+}
+
+/*------------------------------------------------------------------------
+ * +++ Validation.
+ */
+
+/* ExpandPercents --
+ * Expand an entry validation script template (-validatecommand
+ * or -invalidcommand).
+ */
+static void
+ExpandPercents(
+ Entry *entryPtr, /* Entry that needs validation. */
+ const char *template, /* Script template */
+ const char *new, /* Potential new value of entry string */
+ int index, /* index of insert/delete */
+ int count, /* #changed characters */
+ VREASON reason, /* Reason for change */
+ Tcl_DString *dsPtr) /* Result of %-substitutions */
+{
+ int spaceNeeded, cvtFlags;
+ int number, length;
+ const char *string;
+ int stringLength;
+ Tcl_UniChar ch;
+ char numStorage[2*TCL_INTEGER_SPACE];
+
+ while (*template) {
+ /* Find everything up to the next % character and append it
+ * to the result string.
+ */
+ string = Tcl_UtfFindFirst(template, '%');
+ if (string == NULL) {
+ /* No more %-sequences to expand.
+ * Copy the rest of the template.
+ */
+ Tcl_DStringAppend(dsPtr, template, -1);
+ return;
+ }
+ if (string != template) {
+ Tcl_DStringAppend(dsPtr, template, string - template);
+ template = string;
+ }
+
+ /* There's a percent sequence here. Process it.
+ */
+ ++template; /* skip over % */
+ if (*template != '\0') {
+ template += Tcl_UtfToUniChar(template, &ch);
+ } else {
+ ch = '%';
+ }
+
+ stringLength = -1;
+ switch (ch) {
+ case 'd': /* Type of call that caused validation */
+ if (reason == VALIDATE_INSERT) {
+ number = 1;
+ } else if (reason == VALIDATE_DELETE) {
+ number = 0;
+ } else {
+ number = -1;
+ }
+ 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 */
+ string = entryPtr->entry.string;
+ break;
+ case 'S': /* string to be inserted/deleted, if any */
+ if (reason == VALIDATE_INSERT) {
+ string = Tcl_UtfAtIndex(new, index);
+ stringLength = Tcl_UtfAtIndex(string, count) - string;
+ } else if (reason == VALIDATE_DELETE) {
+ string = Tcl_UtfAtIndex(entryPtr->entry.string, index);
+ stringLength = Tcl_UtfAtIndex(string, count) - string;
+ } else {
+ string = "";
+ stringLength = 0;
+ }
+ break;
+ case 'v': /* type of validation currently set */
+ string = validateStrings[entryPtr->entry.validate];
+ break;
+ case 'V': /* type of validation in effect */
+ string = validateReasonStrings[reason];
+ break;
+ case 'W': /* widget name */
+ string = Tk_PathName(entryPtr->core.tkwin);
+ break;
+ default:
+ length = Tcl_UniCharToUtf(ch, numStorage);
+ numStorage[length] = '\0';
+ string = numStorage;
+ break;
+ }
+
+ spaceNeeded = Tcl_ScanCountedElement(string, stringLength, &cvtFlags);
+ length = Tcl_DStringLength(dsPtr);
+ Tcl_DStringSetLength(dsPtr, length + spaceNeeded);
+ spaceNeeded = Tcl_ConvertCountedElement(string, stringLength,
+ Tcl_DStringValue(dsPtr) + length,
+ cvtFlags | TCL_DONT_USE_BRACES);
+ Tcl_DStringSetLength(dsPtr, length + spaceNeeded);
+ }
+}
+
+/* RunValidationScript --
+ * Build and evaluate an entry validation script.
+ * If the script raises an error, disable validation
+ * by setting '-validate none'
+ */
+static int RunValidationScript(
+ Tcl_Interp *interp, /* Interpreter to use */
+ Entry *entryPtr, /* Entry being validated */
+ const char *template, /* Script template */
+ const char *optionName, /* "-validatecommand", "-invalidcommand" */
+ const char *new, /* Potential new value of entry string */
+ int index, /* index of insert/delete */
+ int count, /* #changed characters */
+ VREASON reason) /* Reason for change */
+{
+ Tcl_DString script;
+ int code;
+
+ Tcl_DStringInit(&script);
+ ExpandPercents(entryPtr, template, new, index, count, reason, &script);
+ code = Tcl_EvalEx(interp,
+ Tcl_DStringValue(&script), Tcl_DStringLength(&script),
+ TCL_EVAL_GLOBAL);
+ Tcl_DStringFree(&script);
+ if (WidgetDestroyed(&entryPtr->core))
+ return TCL_ERROR;
+
+ if (code != TCL_OK && code != TCL_RETURN) {
+ Tcl_AddErrorInfo(interp, "\n\t(in ");
+ Tcl_AddErrorInfo(interp, optionName);
+ Tcl_AddErrorInfo(interp, " validation command executed by ");
+ Tcl_AddErrorInfo(interp, Tk_PathName(entryPtr->core.tkwin));
+ Tcl_AddErrorInfo(interp, ")");
+ entryPtr->entry.validate = VMODE_NONE;
+ return TCL_ERROR;
+ }
+ return TCL_OK;
+}
+
+/* EntryNeedsValidation --
+ * Determine whether the specified VREASON should trigger validation
+ * in the current VMODE.
+ */
+static int EntryNeedsValidation(VMODE vmode, VREASON reason)
+{
+ return (reason == VALIDATE_FORCED)
+ || (vmode == VMODE_ALL)
+ || (reason == VALIDATE_FOCUSIN
+ && (vmode == VMODE_FOCUSIN || vmode == VMODE_FOCUS))
+ || (reason == VALIDATE_FOCUSOUT
+ && (vmode == VMODE_FOCUSOUT || vmode == VMODE_FOCUS))
+ || (reason == VALIDATE_INSERT && vmode == VMODE_KEY)
+ || (reason == VALIDATE_DELETE && vmode == VMODE_KEY)
+ ;
+}
+
+/* EntryValidateChange --
+ * Validate a proposed change to the entry widget's value if required.
+ * Call the -invalidcommand if validation fails.
+ *
+ * Returns:
+ * TCL_OK if the change is accepted
+ * TCL_BREAK if the change is rejected
+ * TCL_ERROR if any errors occured
+ *
+ * The change will be rejected if -validatecommand returns 0,
+ * or if -validatecommand or -invalidcommand modifies the value.
+ */
+static int
+EntryValidateChange(
+ Entry *entryPtr, /* Entry that needs validation. */
+ const char *newValue, /* Potential new value of entry string */
+ int index, /* index of insert/delete, -1 otherwise */
+ int count, /* #changed characters */
+ VREASON reason) /* Reason for change */
+{
+ Tcl_Interp *interp = entryPtr->core.interp;
+ VMODE vmode = entryPtr->entry.validate;
+ int code, change_ok;
+
+ if ( (entryPtr->entry.validateCmd == NULL)
+ || (entryPtr->core.flags & VALIDATING)
+ || !EntryNeedsValidation(vmode, reason) )
+ {
+ return TCL_OK;
+ }
+
+ entryPtr->core.flags |= VALIDATING;
+
+ /* Run -validatecommand and check return value:
+ */
+ code = RunValidationScript(interp, entryPtr,
+ entryPtr->entry.validateCmd, "-validatecommand",
+ newValue, index, count, reason);
+ if (code != TCL_OK) {
+ goto done;
+ }
+
+ code = Tcl_GetBooleanFromObj(interp,Tcl_GetObjResult(interp), &change_ok);
+ if (code != TCL_OK) {
+ entryPtr->entry.validate = VMODE_NONE; /* Disable validation */
+ Tcl_AddErrorInfo(interp,
+ "\n(validation command did not return valid boolean)");
+ goto done;
+ }
+
+ /* Run the -invalidcommand if validation failed:
+ */
+ if (!change_ok && entryPtr->entry.invalidCmd != NULL) {
+ code = RunValidationScript(interp, entryPtr,
+ entryPtr->entry.invalidCmd, "-invalidcommand",
+ newValue, index, count, reason);
+ if (code != TCL_OK) {
+ goto done;
+ }
+ }
+
+ /* Reject the pending change if validation failed
+ * or if a validation script changed the value.
+ */
+ if (!change_ok || (entryPtr->core.flags & VALIDATION_SET_VALUE)) {
+ code = TCL_BREAK;
+ }
+
+done:
+ entryPtr->core.flags &= ~(VALIDATING|VALIDATION_SET_VALUE);
+ return code;
+}
+
+/* EntryRevalidate --
+ * Revalidate the current value of an entry widget,
+ * update the TTK_STATE_INVALID bit.
+ *
+ * Returns:
+ * TCL_OK if valid, TCL_BREAK if invalid, TCL_ERROR on error.
+ */
+static int EntryRevalidate(Tcl_Interp *interp, Entry *entryPtr, VREASON reason)
+{
+ int code = EntryValidateChange(
+ entryPtr, entryPtr->entry.string, -1,0, reason);
+
+ if (code == TCL_BREAK) {
+ TtkWidgetChangeState(&entryPtr->core, TTK_STATE_INVALID, 0);
+ } else if (code == TCL_OK) {
+ TtkWidgetChangeState(&entryPtr->core, 0, TTK_STATE_INVALID);
+ }
+
+ return code;
+}
+
+/* EntryRevalidateBG --
+ * Revalidate in the background (called from event handler).
+ */
+static void EntryRevalidateBG(Entry *entryPtr, VREASON reason)
+{
+ Tcl_Interp *interp = entryPtr->core.interp;
+ if (EntryRevalidate(interp, entryPtr, reason) == TCL_ERROR) {
+ Tcl_BackgroundException(interp, TCL_ERROR);
+ }
+}
+
+/*------------------------------------------------------------------------
+ * +++ Entry widget modification.
+ */
+
+/* AdjustIndex --
+ * Adjust index to account for insertion (nChars > 0)
+ * or deletion (nChars < 0) at specified index.
+ */
+static int AdjustIndex(int i0, int index, int nChars)
+{
+ if (i0 >= index) {
+ i0 += nChars;
+ if (i0 < index) { /* index was inside deleted range */
+ i0 = index;
+ }
+ }
+ return i0;
+}
+
+/* AdjustIndices --
+ * Adjust all internal entry indexes to account for change.
+ * Note that insertPos, and selectFirst have "right gravity",
+ * while leftIndex (=xscroll.first) and selectLast have "left gravity".
+ */
+static void AdjustIndices(Entry *entryPtr, int index, int nChars)
+{
+ EntryPart *e = &entryPtr->entry;
+ int g = nChars > 0; /* left gravity adjustment */
+
+ e->insertPos = AdjustIndex(e->insertPos, index, nChars);
+ e->selectFirst = AdjustIndex(e->selectFirst, index, nChars);
+ e->selectLast = AdjustIndex(e->selectLast, index+g, nChars);
+ e->xscroll.first= AdjustIndex(e->xscroll.first, index+g, nChars);
+
+ if (e->selectLast <= e->selectFirst)
+ e->selectFirst = e->selectLast = -1;
+}
+
+/* EntryStoreValue --
+ * Replace the contents of a text entry with a given value,
+ * recompute dependent resources, and schedule a redisplay.
+ *
+ * See also: EntrySetValue().
+ */
+static void
+EntryStoreValue(Entry *entryPtr, const char *value)
+{
+ size_t numBytes = strlen(value);
+ int numChars = Tcl_NumUtfChars(value, numBytes);
+
+ if (entryPtr->core.flags & VALIDATING)
+ entryPtr->core.flags |= VALIDATION_SET_VALUE;
+
+ /* Make sure all indices remain in bounds:
+ */
+ if (numChars < entryPtr->entry.numChars)
+ AdjustIndices(entryPtr, numChars, numChars - entryPtr->entry.numChars);
+
+ /* Free old value:
+ */
+ if (entryPtr->entry.displayString != entryPtr->entry.string)
+ ckfree(entryPtr->entry.displayString);
+ ckfree(entryPtr->entry.string);
+
+ /* Store new value:
+ */
+ entryPtr->entry.string = ckalloc(numBytes + 1);
+ strcpy(entryPtr->entry.string, value);
+ entryPtr->entry.numBytes = numBytes;
+ entryPtr->entry.numChars = numChars;
+
+ entryPtr->entry.displayString
+ = entryPtr->entry.showChar
+ ? EntryDisplayString(entryPtr->entry.showChar, numChars)
+ : entryPtr->entry.string
+ ;
+
+ /* Update layout, schedule redisplay:
+ */
+ EntryUpdateTextLayout(entryPtr);
+ TtkRedisplayWidget(&entryPtr->core);
+}
+
+/* EntrySetValue --
+ * Stores a new value in the entry widget and updates the
+ * linked -textvariable, if any. The write trace on the
+ * text variable is temporarily disabled; however, other
+ * write traces may change the value of the variable.
+ * If so, the widget is updated again with the new value.
+ *
+ * Returns:
+ * TCL_OK if successful, TCL_ERROR otherwise.
+ */
+static int EntrySetValue(Entry *entryPtr, const char *value)
+{
+ EntryStoreValue(entryPtr, value);
+
+ if (entryPtr->entry.textVariableObj) {
+ const char *textVarName =
+ Tcl_GetString(entryPtr->entry.textVariableObj);
+ if (textVarName && *textVarName) {
+ entryPtr->core.flags |= SYNCING_VARIABLE;
+ value = Tcl_SetVar2(entryPtr->core.interp, textVarName,
+ NULL, value, TCL_GLOBAL_ONLY|TCL_LEAVE_ERR_MSG);
+ entryPtr->core.flags &= ~SYNCING_VARIABLE;
+ if (!value || WidgetDestroyed(&entryPtr->core)) {
+ return TCL_ERROR;
+ } else if (strcmp(value, entryPtr->entry.string) != 0) {
+ /* Some write trace has changed the variable value.
+ */
+ EntryStoreValue(entryPtr, value);
+ }
+ }
+ }
+
+ return TCL_OK;
+}
+
+/* EntryTextVariableTrace --
+ * Variable trace procedure for entry -textvariable
+ */
+static void EntryTextVariableTrace(void *recordPtr, const char *value)
+{
+ Entry *entryPtr = recordPtr;
+
+ if (WidgetDestroyed(&entryPtr->core)) {
+ return;
+ }
+
+ if (entryPtr->core.flags & SYNCING_VARIABLE) {
+ /* Trace was fired due to Tcl_SetVar2 call in EntrySetValue.
+ * Don't do anything.
+ */
+ return;
+ }
+
+ EntryStoreValue(entryPtr, value ? value : "");
+}
+
+/*------------------------------------------------------------------------
+ * +++ Insertion and deletion.
+ */
+
+/* InsertChars --
+ * Add new characters to an entry widget.
+ */
+static int
+InsertChars(
+ Entry *entryPtr, /* Entry that is to get the new elements. */
+ int index, /* Insert before this index */
+ const char *value) /* New characters to add */
+{
+ char *string = entryPtr->entry.string;
+ size_t byteIndex = Tcl_UtfAtIndex(string, index) - string;
+ size_t byteCount = strlen(value);
+ int charsAdded = Tcl_NumUtfChars(value, byteCount);
+ size_t newByteCount = entryPtr->entry.numBytes + byteCount + 1;
+ char *new;
+ int code;
+
+ if (byteCount == 0) {
+ return TCL_OK;
+ }
+
+ new = ckalloc(newByteCount);
+ memcpy(new, string, byteIndex);
+ strcpy(new + byteIndex, value);
+ strcpy(new + byteIndex + byteCount, string + byteIndex);
+
+ code = EntryValidateChange(
+ entryPtr, new, index, charsAdded, VALIDATE_INSERT);
+
+ if (code == TCL_OK) {
+ AdjustIndices(entryPtr, index, charsAdded);
+ code = EntrySetValue(entryPtr, new);
+ } else if (code == TCL_BREAK) {
+ code = TCL_OK;
+ }
+
+ ckfree(new);
+ return code;
+}
+
+/* DeleteChars --
+ * Remove one or more characters from an entry widget.
+ */
+static int
+DeleteChars(
+ Entry *entryPtr, /* Entry widget to modify. */
+ int index, /* Index of first character to delete. */
+ int count) /* How many characters to delete. */
+{
+ char *string = entryPtr->entry.string;
+ size_t byteIndex, byteCount, newByteCount;
+ char *new;
+ int code;
+
+ if (index < 0) {
+ index = 0;
+ }
+ if (count > entryPtr->entry.numChars - index) {
+ count = entryPtr->entry.numChars - index;
+ }
+ if (count <= 0) {
+ return TCL_OK;
+ }
+
+ byteIndex = Tcl_UtfAtIndex(string, index) - string;
+ byteCount = Tcl_UtfAtIndex(string+byteIndex, count) - (string+byteIndex);
+
+ newByteCount = entryPtr->entry.numBytes + 1 - byteCount;
+ new = ckalloc(newByteCount);
+ memcpy(new, string, byteIndex);
+ strcpy(new + byteIndex, string + byteIndex + byteCount);
+
+ code = EntryValidateChange(
+ entryPtr, new, index, count, VALIDATE_DELETE);
+
+ if (code == TCL_OK) {
+ AdjustIndices(entryPtr, index, -count);
+ code = EntrySetValue(entryPtr, new);
+ } else if (code == TCL_BREAK) {
+ code = TCL_OK;
+ }
+ ckfree(new);
+
+ return code;
+}
+
+/*------------------------------------------------------------------------
+ * +++ Event handler.
+ */
+
+/* EntryEventProc --
+ * Extra event handling for entry widgets:
+ * Triggers validation on FocusIn and FocusOut events.
+ */
+#define EntryEventMask (FocusChangeMask)
+static void
+EntryEventProc(ClientData clientData, XEvent *eventPtr)
+{
+ Entry *entryPtr = (Entry *) clientData;
+
+ Tcl_Preserve(clientData);
+ switch (eventPtr->type) {
+ case DestroyNotify:
+ Tk_DeleteEventHandler(entryPtr->core.tkwin,
+ EntryEventMask, EntryEventProc, clientData);
+ break;
+ case FocusIn:
+ EntryRevalidateBG(entryPtr, VALIDATE_FOCUSIN);
+ break;
+ case FocusOut:
+ EntryRevalidateBG(entryPtr, VALIDATE_FOCUSOUT);
+ break;
+ }
+ Tcl_Release(clientData);
+}
+
+/*------------------------------------------------------------------------
+ * +++ Initialization and cleanup.
+ */
+
+static void
+EntryInitialize(Tcl_Interp *interp, void *recordPtr)
+{
+ Entry *entryPtr = recordPtr;
+
+ Tk_CreateEventHandler(
+ entryPtr->core.tkwin, EntryEventMask, EntryEventProc, entryPtr);
+ Tk_CreateSelHandler(entryPtr->core.tkwin, XA_PRIMARY, XA_STRING,
+ EntryFetchSelection, (ClientData) entryPtr, XA_STRING);
+ TtkBlinkCursor(&entryPtr->core);
+
+ entryPtr->entry.string = ckalloc(1);
+ *entryPtr->entry.string = '\0';
+ entryPtr->entry.displayString = entryPtr->entry.string;
+ entryPtr->entry.textVariableTrace = 0;
+ entryPtr->entry.numBytes = entryPtr->entry.numChars = 0;
+
+ EntryInitStyleDefaults(&entryPtr->entry.styleDefaults);
+
+ entryPtr->entry.xscrollHandle =
+ TtkCreateScrollHandle(&entryPtr->core, &entryPtr->entry.xscroll);
+
+ entryPtr->entry.insertPos = 0;
+ entryPtr->entry.selectFirst = -1;
+ entryPtr->entry.selectLast = -1;
+}
+
+static void
+EntryCleanup(void *recordPtr)
+{
+ Entry *entryPtr = recordPtr;
+
+ if (entryPtr->entry.textVariableTrace)
+ Ttk_UntraceVariable(entryPtr->entry.textVariableTrace);
+
+ TtkFreeScrollHandle(entryPtr->entry.xscrollHandle);
+
+ EntryFreeStyleDefaults(&entryPtr->entry.styleDefaults);
+
+ Tk_DeleteSelHandler(entryPtr->core.tkwin, XA_PRIMARY, XA_STRING);
+
+ Tk_FreeTextLayout(entryPtr->entry.textLayout);
+ if (entryPtr->entry.displayString != entryPtr->entry.string)
+ ckfree(entryPtr->entry.displayString);
+ ckfree(entryPtr->entry.string);
+}
+
+/* EntryConfigure --
+ * Configure hook for Entry widgets.
+ */
+static int EntryConfigure(Tcl_Interp *interp, void *recordPtr, int mask)
+{
+ Entry *entryPtr = recordPtr;
+ Tcl_Obj *textVarName = entryPtr->entry.textVariableObj;
+ Ttk_TraceHandle *vt = 0;
+
+ if (mask & TEXTVAR_CHANGED) {
+ if (textVarName && *Tcl_GetString(textVarName)) {
+ vt = Ttk_TraceVariable(interp,
+ textVarName,EntryTextVariableTrace,entryPtr);
+ if (!vt) return TCL_ERROR;
+ }
+ }
+
+ if (TtkCoreConfigure(interp, recordPtr, mask) != TCL_OK) {
+ if (vt) Ttk_UntraceVariable(vt);
+ return TCL_ERROR;
+ }
+
+ /* Update derived resources:
+ */
+ if (mask & TEXTVAR_CHANGED) {
+ if (entryPtr->entry.textVariableTrace)
+ Ttk_UntraceVariable(entryPtr->entry.textVariableTrace);
+ entryPtr->entry.textVariableTrace = vt;
+ }
+
+ /* Claim the selection, in case we've suddenly started exporting it.
+ */
+ if (entryPtr->entry.exportSelection && entryPtr->entry.selectFirst != -1) {
+ EntryOwnSelection(entryPtr);
+ }
+
+ /* Handle -state compatibility option:
+ */
+ if (mask & STATE_CHANGED) {
+ TtkCheckStateOption(&entryPtr->core, entryPtr->entry.stateObj);
+ }
+
+ /* Force scrollbar update if needed:
+ */
+ if (mask & SCROLLCMD_CHANGED) {
+ TtkScrollbarUpdateRequired(entryPtr->entry.xscrollHandle);
+ }
+
+ /* Recompute the displayString, in case showChar changed:
+ */
+ if (entryPtr->entry.displayString != entryPtr->entry.string)
+ ckfree(entryPtr->entry.displayString);
+
+ entryPtr->entry.displayString
+ = entryPtr->entry.showChar
+ ? EntryDisplayString(entryPtr->entry.showChar, entryPtr->entry.numChars)
+ : entryPtr->entry.string
+ ;
+
+ /* Update textLayout:
+ */
+ EntryUpdateTextLayout(entryPtr);
+ return TCL_OK;
+}
+
+/* EntryPostConfigure --
+ * Post-configuration hook for entry widgets.
+ */
+static int EntryPostConfigure(Tcl_Interp *interp, void *recordPtr, int mask)
+{
+ Entry *entryPtr = recordPtr;
+ int status = TCL_OK;
+
+ if ((mask & TEXTVAR_CHANGED) && entryPtr->entry.textVariableTrace != NULL) {
+ status = Ttk_FireTrace(entryPtr->entry.textVariableTrace);
+ }
+
+ return status;
+}
+
+/*------------------------------------------------------------------------
+ * +++ Layout and display.
+ */
+
+/* EntryCharPosition --
+ * Return the X coordinate of the specified character index.
+ * Precondition: textLayout and layoutX up-to-date.
+ */
+static int
+EntryCharPosition(Entry *entryPtr, int index)
+{
+ int xPos;
+ Tk_CharBbox(entryPtr->entry.textLayout, index, &xPos, NULL, NULL, NULL);
+ return xPos + entryPtr->entry.layoutX;
+}
+
+/* EntryDoLayout --
+ * Layout hook for entry widgets.
+ *
+ * Determine position of textLayout based on xscroll.first, justify,
+ * and display area.
+ *
+ * Recalculates layoutX, layoutY, and rightIndex,
+ * and updates xscroll accordingly.
+ * May adjust xscroll.first to ensure the maximum #characters are onscreen.
+ */
+static void
+EntryDoLayout(void *recordPtr)
+{
+ Entry *entryPtr = recordPtr;
+ WidgetCore *corePtr = &entryPtr->core;
+ Tk_TextLayout textLayout = entryPtr->entry.textLayout;
+ int leftIndex = entryPtr->entry.xscroll.first;
+ int rightIndex;
+ Ttk_Box textarea;
+
+ Ttk_PlaceLayout(corePtr->layout,corePtr->state,Ttk_WinBox(corePtr->tkwin));
+ textarea = Ttk_ClientRegion(corePtr->layout, "textarea");
+
+ /* Center the text vertically within the available parcel:
+ */
+ entryPtr->entry.layoutY = textarea.y +
+ (textarea.height - entryPtr->entry.layoutHeight)/2;
+
+ /* Recompute where the leftmost character on the display will
+ * be drawn (layoutX) and adjust leftIndex if necessary.
+ */
+ if (entryPtr->entry.layoutWidth <= textarea.width) {
+ /* Everything fits. Set leftIndex to zero (no need to scroll),
+ * and compute layoutX based on -justify.
+ */
+ int extraSpace = textarea.width - entryPtr->entry.layoutWidth;
+ leftIndex = 0;
+ rightIndex = entryPtr->entry.numChars;
+ entryPtr->entry.layoutX = textarea.x;
+ if (entryPtr->entry.justify == TK_JUSTIFY_RIGHT) {
+ entryPtr->entry.layoutX += extraSpace;
+ } else if (entryPtr->entry.justify == TK_JUSTIFY_CENTER) {
+ entryPtr->entry.layoutX += extraSpace / 2;
+ }
+ } else {
+ /* The whole string doesn't fit in the window.
+ * Limit leftIndex to leave at most one character's worth
+ * of empty space on the right.
+ */
+ int overflow = entryPtr->entry.layoutWidth - textarea.width;
+ int maxLeftIndex = 1 + Tk_PointToChar(textLayout, overflow, 0);
+ int leftX;
+
+ if (leftIndex > maxLeftIndex) {
+ leftIndex = maxLeftIndex;
+ }
+
+ /* Compute layoutX and rightIndex.
+ * rightIndex is set to one past the last fully-visible character.
+ */
+ Tk_CharBbox(textLayout, leftIndex, &leftX, NULL, NULL, NULL);
+ rightIndex = Tk_PointToChar(textLayout, leftX + textarea.width, 0);
+ entryPtr->entry.layoutX = textarea.x - leftX;
+ }
+
+ TtkScrolled(entryPtr->entry.xscrollHandle,
+ leftIndex, rightIndex, entryPtr->entry.numChars);
+}
+
+/* EntryGetGC -- Helper routine.
+ * Get a GC using the specified foreground color and the entry's font.
+ * Result must be freed with Tk_FreeGC().
+ */
+static GC EntryGetGC(Entry *entryPtr, Tcl_Obj *colorObj, TkRegion clip)
+{
+ Tk_Window tkwin = entryPtr->core.tkwin;
+ Tk_Font font = Tk_GetFontFromObj(tkwin, entryPtr->entry.fontObj);
+ XColor *colorPtr;
+ unsigned long mask = 0ul;
+ XGCValues gcValues;
+ GC gc;
+
+ gcValues.line_width = 1; mask |= GCLineWidth;
+ gcValues.font = Tk_FontId(font); mask |= GCFont;
+ if (colorObj != 0 && (colorPtr=Tk_GetColorFromObj(tkwin,colorObj)) != 0) {
+ gcValues.foreground = colorPtr->pixel;
+ mask |= GCForeground;
+ }
+ gc = Tk_GetGC(entryPtr->core.tkwin, mask, &gcValues);
+ if (clip != None) {
+ TkSetRegion(Tk_Display(entryPtr->core.tkwin), gc, clip);
+ }
+ return gc;
+}
+
+/* EntryDisplay --
+ * Redraws the contents of an entry window.
+ */
+static void EntryDisplay(void *clientData, Drawable d)
+{
+ Entry *entryPtr = clientData;
+ Tk_Window tkwin = entryPtr->core.tkwin;
+ int leftIndex = entryPtr->entry.xscroll.first,
+ rightIndex = entryPtr->entry.xscroll.last + 1,
+ selFirst = entryPtr->entry.selectFirst,
+ selLast = entryPtr->entry.selectLast;
+ EntryStyleData es;
+ GC gc;
+ int showSelection, showCursor;
+ Ttk_Box textarea;
+ TkRegion clipRegion;
+ XRectangle rect;
+
+ EntryInitStyleData(entryPtr, &es);
+
+ textarea = Ttk_ClientRegion(entryPtr->core.layout, "textarea");
+ showCursor =
+ (entryPtr->core.flags & CURSOR_ON)
+ && EntryEditable(entryPtr)
+ && entryPtr->entry.insertPos >= leftIndex
+ && entryPtr->entry.insertPos <= rightIndex
+ ;
+ showSelection =
+ !(entryPtr->core.state & TTK_STATE_DISABLED)
+ && selFirst > -1
+ && selLast > leftIndex
+ && selFirst <= rightIndex
+ ;
+
+ /* Adjust selection range to keep in display bounds.
+ */
+ if (showSelection) {
+ if (selFirst < leftIndex)
+ selFirst = leftIndex;
+ if (selLast > rightIndex)
+ selLast = rightIndex;
+ }
+
+ /* Draw widget background & border
+ */
+ Ttk_DrawLayout(entryPtr->core.layout, entryPtr->core.state, d);
+
+ /* Draw selection background
+ */
+ if (showSelection && es.selBorderObj) {
+ Tk_3DBorder selBorder = Tk_Get3DBorderFromObj(tkwin, es.selBorderObj);
+ int selStartX = EntryCharPosition(entryPtr, selFirst);
+ int selEndX = EntryCharPosition(entryPtr, selLast);
+ int borderWidth = 1;
+
+ Tcl_GetIntFromObj(NULL, es.selBorderWidthObj, &borderWidth);
+
+ if (selBorder) {
+ Tk_Fill3DRectangle(tkwin, d, selBorder,
+ selStartX - borderWidth, entryPtr->entry.layoutY - borderWidth,
+ selEndX - selStartX + 2*borderWidth,
+ entryPtr->entry.layoutHeight + 2*borderWidth,
+ borderWidth, TK_RELIEF_RAISED);
+ }
+ }
+
+ /* Initialize the clip region. Note that Xft does _not_ derive its
+ * clipping area from the GC, so we have to supply that by other means.
+ */
+
+ rect.x = textarea.x;
+ rect.y = textarea.y;
+ rect.width = textarea.width;
+ rect.height = textarea.height;
+ clipRegion = TkCreateRegion();
+ TkUnionRectWithRegion(&rect, clipRegion, clipRegion);
+#ifdef HAVE_XFT
+ TkUnixSetXftClipRegion(clipRegion);
+#endif
+
+ /* Draw cursor:
+ */
+ if (showCursor) {
+ int cursorX = EntryCharPosition(entryPtr, entryPtr->entry.insertPos),
+ cursorY = entryPtr->entry.layoutY,
+ cursorHeight = entryPtr->entry.layoutHeight,
+ cursorWidth = 1;
+
+ Tcl_GetIntFromObj(NULL,es.insertWidthObj,&cursorWidth);
+ if (cursorWidth <= 0) {
+ cursorWidth = 1;
+ }
+
+ /* @@@ should: maybe: SetCaretPos even when blinked off */
+ Tk_SetCaretPos(tkwin, cursorX, cursorY, cursorHeight);
+
+ gc = EntryGetGC(entryPtr, es.insertColorObj, clipRegion);
+ XFillRectangle(Tk_Display(tkwin), d, gc,
+ cursorX-cursorWidth/2, cursorY, cursorWidth, cursorHeight);
+ XSetClipMask(Tk_Display(tkwin), gc, None);
+ Tk_FreeGC(Tk_Display(tkwin), gc);
+ }
+
+ /* Draw the text:
+ */
+ gc = EntryGetGC(entryPtr, es.foregroundObj, clipRegion);
+ Tk_DrawTextLayout(
+ Tk_Display(tkwin), d, gc, entryPtr->entry.textLayout,
+ entryPtr->entry.layoutX, entryPtr->entry.layoutY,
+ leftIndex, rightIndex);
+ XSetClipMask(Tk_Display(tkwin), gc, None);
+ Tk_FreeGC(Tk_Display(tkwin), gc);
+
+ /* Overwrite the selected portion (if any) in the -selectforeground color:
+ */
+ if (showSelection) {
+ gc = EntryGetGC(entryPtr, es.selForegroundObj, clipRegion);
+ Tk_DrawTextLayout(
+ Tk_Display(tkwin), d, gc, entryPtr->entry.textLayout,
+ entryPtr->entry.layoutX, entryPtr->entry.layoutY,
+ selFirst, selLast);
+ XSetClipMask(Tk_Display(tkwin), gc, None);
+ Tk_FreeGC(Tk_Display(tkwin), gc);
+ }
+
+ /* Drop the region. Note that we have to manually remove the reference to
+ * it from the Xft guts (if they're being used).
+ */
+#ifdef HAVE_XFT
+ TkUnixSetXftClipRegion(None);
+#endif
+ TkDestroyRegion(clipRegion);
+}
+
+/*------------------------------------------------------------------------
+ * +++ Widget commands.
+ */
+
+/* EntryIndex --
+ * Parse an index into an entry and return either its value
+ * or an error.
+ *
+ * Results:
+ * A standard Tcl result. If all went well, then *indexPtr is
+ * filled in with the character index (into entryPtr) corresponding to
+ * string. The index value is guaranteed to lie between 0 and
+ * the number of characters in the string, inclusive. If an
+ * error occurs then an error message is left in the interp's result.
+ */
+static int
+EntryIndex(
+ Tcl_Interp *interp, /* For error messages. */
+ Entry *entryPtr, /* Entry widget to query */
+ Tcl_Obj *indexObj, /* Symbolic index name */
+ int *indexPtr) /* Return value */
+{
+# define EntryWidth(e) (Tk_Width(entryPtr->core.tkwin)) /* Not Right */
+ const char *string = Tcl_GetString(indexObj);
+ size_t length = indexObj->length;
+
+ if (strncmp(string, "end", length) == 0) {
+ *indexPtr = entryPtr->entry.numChars;
+ } else if (strncmp(string, "insert", length) == 0) {
+ *indexPtr = entryPtr->entry.insertPos;
+ } else if (strncmp(string, "left", length) == 0) { /* for debugging */
+ *indexPtr = entryPtr->entry.xscroll.first;
+ } else if (strncmp(string, "right", length) == 0) { /* for debugging */
+ *indexPtr = entryPtr->entry.xscroll.last;
+ } else if (strncmp(string, "sel.", 4) == 0) {
+ if (entryPtr->entry.selectFirst < 0) {
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "selection isn't in widget %s",
+ Tk_PathName(entryPtr->core.tkwin)));
+ Tcl_SetErrorCode(interp, "TTK", "ENTRY", "NO_SELECTION", NULL);
+ return TCL_ERROR;
+ }
+ if (strncmp(string, "sel.first", length) == 0) {
+ *indexPtr = entryPtr->entry.selectFirst;
+ } else if (strncmp(string, "sel.last", length) == 0) {
+ *indexPtr = entryPtr->entry.selectLast;
+ } else {
+ goto badIndex;
+ }
+ } else if (string[0] == '@') {
+ int roundUp = 0;
+ int maxWidth = EntryWidth(entryPtr);
+ int x;
+
+ if (Tcl_GetInt(interp, string + 1, &x) != TCL_OK) {
+ goto badIndex;
+ }
+ if (x > maxWidth) {
+ x = maxWidth;
+ roundUp = 1;
+ }
+ *indexPtr = Tk_PointToChar(entryPtr->entry.textLayout,
+ x - entryPtr->entry.layoutX, 0);
+
+ if (*indexPtr < entryPtr->entry.xscroll.first) {
+ *indexPtr = entryPtr->entry.xscroll.first;
+ }
+
+ /*
+ * Special trick: if the x-position was off-screen to the right,
+ * round the index up to refer to the character just after the
+ * last visible one on the screen. This is needed to enable the
+ * last character to be selected, for example.
+ */
+
+ if (roundUp && (*indexPtr < entryPtr->entry.numChars)) {
+ *indexPtr += 1;
+ }
+ } else {
+ if (Tcl_GetInt(interp, string, indexPtr) != TCL_OK) {
+ goto badIndex;
+ }
+ if (*indexPtr < 0) {
+ *indexPtr = 0;
+ } else if (*indexPtr > entryPtr->entry.numChars) {
+ *indexPtr = entryPtr->entry.numChars;
+ }
+ }
+ return TCL_OK;
+
+badIndex:
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "bad entry index \"%s\"", string));
+ Tcl_SetErrorCode(interp, "TTK", "ENTRY", "INDEX", NULL);
+ return TCL_ERROR;
+}
+
+/* $entry bbox $index --
+ * Return the bounding box of the character at the specified index.
+ */
+static int
+EntryBBoxCommand(
+ void *recordPtr, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[])
+{
+ Entry *entryPtr = recordPtr;
+ Ttk_Box b;
+ int index;
+
+ if (objc != 3) {
+ Tcl_WrongNumArgs(interp, 2, objv, "index");
+ return TCL_ERROR;
+ }
+ if (EntryIndex(interp, entryPtr, objv[2], &index) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if ((index == entryPtr->entry.numChars) && (index > 0)) {
+ index--;
+ }
+ Tk_CharBbox(entryPtr->entry.textLayout, index,
+ &b.x, &b.y, &b.width, &b.height);
+ b.x += entryPtr->entry.layoutX;
+ b.y += entryPtr->entry.layoutY;
+ Tcl_SetObjResult(interp, Ttk_NewBoxObj(b));
+ return TCL_OK;
+}
+
+/* $entry delete $from ?$to? --
+ * Delete the characters in the range [$from,$to).
+ * $to defaults to $from+1 if not specified.
+ */
+static int
+EntryDeleteCommand(
+ void *recordPtr, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[])
+{
+ Entry *entryPtr = recordPtr;
+ int first, last;
+
+ if ((objc < 3) || (objc > 4)) {
+ Tcl_WrongNumArgs(interp, 2, objv, "firstIndex ?lastIndex?");
+ return TCL_ERROR;
+ }
+ if (EntryIndex(interp, entryPtr, objv[2], &first) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (objc == 3) {
+ last = first + 1;
+ } else if (EntryIndex(interp, entryPtr, objv[3], &last) != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ if (last >= first && EntryEditable(entryPtr)) {
+ return DeleteChars(entryPtr, first, last - first);
+ }
+ return TCL_OK;
+}
+
+/* $entry get --
+ * Return the current value of the entry widget.
+ */
+static int
+EntryGetCommand(
+ void *recordPtr, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[])
+{
+ Entry *entryPtr = recordPtr;
+ if (objc != 2) {
+ Tcl_WrongNumArgs(interp, 2, objv, NULL);
+ return TCL_ERROR;
+ }
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(entryPtr->entry.string, -1));
+ return TCL_OK;
+}
+
+/* $entry icursor $index --
+ * Set the insert cursor position.
+ */
+static int
+EntryICursorCommand(
+ void *recordPtr, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[])
+{
+ Entry *entryPtr = recordPtr;
+ if (objc != 3) {
+ Tcl_WrongNumArgs(interp, 2, objv, "pos");
+ return TCL_ERROR;
+ }
+ if (EntryIndex(interp, entryPtr, objv[2],
+ &entryPtr->entry.insertPos) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ TtkRedisplayWidget(&entryPtr->core);
+ return TCL_OK;
+}
+
+/* $entry index $index --
+ * Return numeric value (0..numChars) of the specified index.
+ */
+static int
+EntryIndexCommand(
+ void *recordPtr, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[])
+{
+ Entry *entryPtr = recordPtr;
+ int index;
+
+ if (objc != 3) {
+ Tcl_WrongNumArgs(interp, 2, objv, "string");
+ return TCL_ERROR;
+ }
+ if (EntryIndex(interp, entryPtr, objv[2], &index) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ Tcl_SetObjResult(interp, Tcl_NewIntObj(index));
+ return TCL_OK;
+}
+
+/* $entry insert $index $text --
+ * Insert $text after position $index.
+ * Silent no-op if the entry is disabled or read-only.
+ */
+static int
+EntryInsertCommand(
+ void *recordPtr, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[])
+{
+ Entry *entryPtr = recordPtr;
+ int index;
+
+ if (objc != 4) {
+ Tcl_WrongNumArgs(interp, 2, objv, "index text");
+ return TCL_ERROR;
+ }
+ if (EntryIndex(interp, entryPtr, objv[2], &index) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (EntryEditable(entryPtr)) {
+ return InsertChars(entryPtr, index, Tcl_GetString(objv[3]));
+ }
+ return TCL_OK;
+}
+
+/* $entry selection clear --
+ * Clear selection.
+ */
+static int EntrySelectionClearCommand(
+ void *recordPtr, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[])
+{
+ Entry *entryPtr = recordPtr;
+
+ if (objc != 3) {
+ Tcl_WrongNumArgs(interp, 3, objv, NULL);
+ return TCL_ERROR;
+ }
+ entryPtr->entry.selectFirst = entryPtr->entry.selectLast = -1;
+ TtkRedisplayWidget(&entryPtr->core);
+ return TCL_OK;
+}
+
+/* $entry selection present --
+ * Returns 1 if any characters are selected, 0 otherwise.
+ */
+static int EntrySelectionPresentCommand(
+ void *recordPtr, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[])
+{
+ Entry *entryPtr = recordPtr;
+ if (objc != 3) {
+ Tcl_WrongNumArgs(interp, 3, objv, NULL);
+ return TCL_ERROR;
+ }
+ Tcl_SetObjResult(interp,
+ Tcl_NewBooleanObj(entryPtr->entry.selectFirst >= 0));
+ return TCL_OK;
+}
+
+/* $entry selection range $start $end --
+ * Explicitly set the selection range.
+ */
+static int EntrySelectionRangeCommand(
+ void *recordPtr, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[])
+{
+ Entry *entryPtr = recordPtr;
+ int start, end;
+ if (objc != 5) {
+ Tcl_WrongNumArgs(interp, 3, objv, "start end");
+ return TCL_ERROR;
+ }
+ if ( EntryIndex(interp, entryPtr, objv[3], &start) != TCL_OK
+ || EntryIndex(interp, entryPtr, objv[4], &end) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (entryPtr->core.state & TTK_STATE_DISABLED) {
+ return TCL_OK;
+ }
+
+ if (start >= end) {
+ entryPtr->entry.selectFirst = entryPtr->entry.selectLast = -1;
+ } else {
+ entryPtr->entry.selectFirst = start;
+ entryPtr->entry.selectLast = end;
+ EntryOwnSelection(entryPtr);
+ }
+ TtkRedisplayWidget(&entryPtr->core);
+ return TCL_OK;
+}
+
+static const Ttk_Ensemble EntrySelectionCommands[] = {
+ { "clear", EntrySelectionClearCommand,0 },
+ { "present", EntrySelectionPresentCommand,0 },
+ { "range", EntrySelectionRangeCommand,0 },
+ { 0,0,0 }
+};
+
+/* $entry set $value
+ * Sets the value of an entry widget.
+ */
+static int EntrySetCommand(
+ void *recordPtr, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[])
+{
+ Entry *entryPtr = recordPtr;
+ if (objc != 3) {
+ Tcl_WrongNumArgs(interp, 2, objv, "value");
+ return TCL_ERROR;
+ }
+ EntrySetValue(entryPtr, Tcl_GetString(objv[2]));
+ return TCL_OK;
+}
+
+/* $entry validate --
+ * Trigger forced validation. Returns 1/0 if validation succeeds/fails
+ * or error status from -validatecommand / -invalidcommand.
+ */
+static int EntryValidateCommand(
+ void *recordPtr, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[])
+{
+ Entry *entryPtr = recordPtr;
+ int code;
+
+ if (objc != 2) {
+ Tcl_WrongNumArgs(interp, 2, objv, NULL);
+ return TCL_ERROR;
+ }
+
+ code = EntryRevalidate(interp, entryPtr, VALIDATE_FORCED);
+
+ if (code == TCL_ERROR)
+ return code;
+
+ Tcl_SetObjResult(interp, Tcl_NewBooleanObj(code == TCL_OK));
+ return TCL_OK;
+}
+
+/* $entry xview -- horizontal scrolling interface
+ */
+static int EntryXViewCommand(
+ void *recordPtr, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[])
+{
+ Entry *entryPtr = recordPtr;
+ if (objc == 3) {
+ int newFirst;
+ if (EntryIndex(interp, entryPtr, objv[2], &newFirst) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ TtkScrollTo(entryPtr->entry.xscrollHandle, newFirst);
+ return TCL_OK;
+ }
+ return TtkScrollviewCommand(interp, objc, objv, entryPtr->entry.xscrollHandle);
+}
+
+static const Ttk_Ensemble EntryCommands[] = {
+ { "bbox", EntryBBoxCommand,0 },
+ { "cget", TtkWidgetCgetCommand,0 },
+ { "configure", TtkWidgetConfigureCommand,0 },
+ { "delete", EntryDeleteCommand,0 },
+ { "get", EntryGetCommand,0 },
+ { "icursor", EntryICursorCommand,0 },
+ { "identify", TtkWidgetIdentifyCommand,0 },
+ { "index", EntryIndexCommand,0 },
+ { "insert", EntryInsertCommand,0 },
+ { "instate", TtkWidgetInstateCommand,0 },
+ { "selection", 0,EntrySelectionCommands },
+ { "state", TtkWidgetStateCommand,0 },
+ { "validate", EntryValidateCommand,0 },
+ { "xview", EntryXViewCommand,0 },
+ { 0,0,0 }
+};
+
+/*------------------------------------------------------------------------
+ * +++ Entry widget definition.
+ */
+
+static WidgetSpec EntryWidgetSpec = {
+ "TEntry", /* className */
+ sizeof(Entry), /* recordSize */
+ EntryOptionSpecs, /* optionSpecs */
+ EntryCommands, /* subcommands */
+ EntryInitialize, /* initializeProc */
+ EntryCleanup, /* cleanupProc */
+ EntryConfigure, /* configureProc */
+ EntryPostConfigure, /* postConfigureProc */
+ TtkWidgetGetLayout, /* getLayoutProc */
+ TtkWidgetSize, /* sizeProc */
+ EntryDoLayout, /* layoutProc */
+ EntryDisplay /* displayProc */
+};
+
+/*------------------------------------------------------------------------
+ * +++ Combobox widget record.
+ */
+
+typedef struct {
+ Tcl_Obj *postCommandObj;
+ Tcl_Obj *valuesObj;
+ Tcl_Obj *heightObj;
+ int currentIndex;
+} ComboboxPart;
+
+typedef struct {
+ WidgetCore core;
+ EntryPart entry;
+ ComboboxPart combobox;
+} Combobox;
+
+static Tk_OptionSpec ComboboxOptionSpecs[] = {
+ {TK_OPTION_STRING, "-height", "height", "Height",
+ DEF_LIST_HEIGHT, Tk_Offset(Combobox, combobox.heightObj), -1,
+ 0,0,0 },
+ {TK_OPTION_STRING, "-postcommand", "postCommand", "PostCommand",
+ "", Tk_Offset(Combobox, combobox.postCommandObj), -1,
+ 0,0,0 },
+ {TK_OPTION_STRING, "-values", "values", "Values",
+ "", Tk_Offset(Combobox, combobox.valuesObj), -1,
+ 0,0,0 },
+ WIDGET_INHERIT_OPTIONS(EntryOptionSpecs)
+};
+
+/* ComboboxInitialize --
+ * Initialization hook for combobox widgets.
+ */
+static void
+ComboboxInitialize(Tcl_Interp *interp, void *recordPtr)
+{
+ Combobox *cb = recordPtr;
+
+ cb->combobox.currentIndex = -1;
+ TtkTrackElementState(&cb->core);
+ EntryInitialize(interp, recordPtr);
+}
+
+/* ComboboxConfigure --
+ * Configuration hook for combobox widgets.
+ */
+static int
+ComboboxConfigure(Tcl_Interp *interp, void *recordPtr, int mask)
+{
+ Combobox *cbPtr = recordPtr;
+ int unused;
+
+ /* Make sure -values is a valid list:
+ */
+ if (Tcl_ListObjLength(interp,cbPtr->combobox.valuesObj,&unused) != TCL_OK)
+ return TCL_ERROR;
+
+ return EntryConfigure(interp, recordPtr, mask);
+}
+
+/* $cb current ?newIndex? -- get or set current index.
+ * Setting the current index updates the combobox value,
+ * but the value and -values may be changed independently
+ * of the index. Instead of trying to keep currentIndex
+ * in sync at all times, [$cb current] double-checks
+ */
+static int ComboboxCurrentCommand(
+ void *recordPtr, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[])
+{
+ Combobox *cbPtr = recordPtr;
+ int currentIndex = cbPtr->combobox.currentIndex;
+ const char *currentValue = cbPtr->entry.string;
+ int nValues;
+ Tcl_Obj **values;
+
+ Tcl_ListObjGetElements(interp,cbPtr->combobox.valuesObj,&nValues,&values);
+
+ if (objc == 2) {
+ /* Check if currentIndex still valid:
+ */
+ if ( currentIndex < 0
+ || currentIndex >= nValues
+ || strcmp(currentValue,Tcl_GetString(values[currentIndex]))
+ )
+ {
+ /* Not valid. Check current value against each element in -values:
+ */
+ for (currentIndex = 0; currentIndex < nValues; ++currentIndex) {
+ if (!strcmp(currentValue,Tcl_GetString(values[currentIndex]))) {
+ break;
+ }
+ }
+ if (currentIndex >= nValues) {
+ /* Not found */
+ currentIndex = -1;
+ }
+ }
+ cbPtr->combobox.currentIndex = currentIndex;
+ Tcl_SetObjResult(interp, Tcl_NewIntObj(currentIndex));
+ return TCL_OK;
+ } else if (objc == 3) {
+ if (Tcl_GetIntFromObj(interp, objv[2], &currentIndex) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (currentIndex < 0 || currentIndex >= nValues) {
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "Index %s out of range", Tcl_GetString(objv[2])));
+ Tcl_SetErrorCode(interp, "TTK", "COMBOBOX", "IDX_RANGE", NULL);
+ return TCL_ERROR;
+ }
+
+ cbPtr->combobox.currentIndex = currentIndex;
+
+ return EntrySetValue(recordPtr, Tcl_GetString(values[currentIndex]));
+ } else {
+ Tcl_WrongNumArgs(interp, 2, objv, "?newIndex?");
+ return TCL_ERROR;
+ }
+ return TCL_OK;
+}
+
+/*------------------------------------------------------------------------
+ * +++ Combobox widget definition.
+ */
+static const Ttk_Ensemble ComboboxCommands[] = {
+ { "bbox", EntryBBoxCommand,0 },
+ { "cget", TtkWidgetCgetCommand,0 },
+ { "configure", TtkWidgetConfigureCommand,0 },
+ { "current", ComboboxCurrentCommand,0 },
+ { "delete", EntryDeleteCommand,0 },
+ { "get", EntryGetCommand,0 },
+ { "icursor", EntryICursorCommand,0 },
+ { "identify", TtkWidgetIdentifyCommand,0 },
+ { "index", EntryIndexCommand,0 },
+ { "insert", EntryInsertCommand,0 },
+ { "instate", TtkWidgetInstateCommand,0 },
+ { "selection", 0,EntrySelectionCommands },
+ { "state", TtkWidgetStateCommand,0 },
+ { "set", EntrySetCommand,0 },
+ { "validate", EntryValidateCommand,0 },
+ { "xview", EntryXViewCommand,0 },
+ { 0,0,0 }
+};
+
+static WidgetSpec ComboboxWidgetSpec = {
+ "TCombobox", /* className */
+ sizeof(Combobox), /* recordSize */
+ ComboboxOptionSpecs, /* optionSpecs */
+ ComboboxCommands, /* subcommands */
+ ComboboxInitialize, /* initializeProc */
+ EntryCleanup, /* cleanupProc */
+ ComboboxConfigure, /* configureProc */
+ EntryPostConfigure, /* postConfigureProc */
+ TtkWidgetGetLayout, /* getLayoutProc */
+ TtkWidgetSize, /* sizeProc */
+ EntryDoLayout, /* layoutProc */
+ EntryDisplay /* displayProc */
+};
+
+/*------------------------------------------------------------------------
+ * +++ Spinbox widget.
+ */
+
+typedef struct {
+ Tcl_Obj *valuesObj;
+
+ Tcl_Obj *fromObj;
+ Tcl_Obj *toObj;
+ Tcl_Obj *incrementObj;
+ Tcl_Obj *formatObj;
+
+ Tcl_Obj *wrapObj;
+ Tcl_Obj *commandObj;
+} SpinboxPart;
+
+typedef struct {
+ WidgetCore core;
+ EntryPart entry;
+ SpinboxPart spinbox;
+} Spinbox;
+
+static Tk_OptionSpec SpinboxOptionSpecs[] = {
+ {TK_OPTION_STRING, "-values", "values", "Values",
+ "", Tk_Offset(Spinbox, spinbox.valuesObj), -1,
+ 0,0,0 },
+
+ {TK_OPTION_DOUBLE, "-from", "from", "From",
+ "0", Tk_Offset(Spinbox,spinbox.fromObj), -1,
+ 0,0,0 },
+ {TK_OPTION_DOUBLE, "-to", "to", "To",
+ "0", Tk_Offset(Spinbox,spinbox.toObj), -1,
+ 0,0,0 },
+ {TK_OPTION_DOUBLE, "-increment", "increment", "Increment",
+ "1", Tk_Offset(Spinbox,spinbox.incrementObj), -1,
+ 0,0,0 },
+ {TK_OPTION_STRING, "-format", "format", "Format",
+ "", Tk_Offset(Spinbox, spinbox.formatObj), -1,
+ 0,0,0 },
+
+ {TK_OPTION_STRING, "-command", "command", "Command",
+ "", Tk_Offset(Spinbox, spinbox.commandObj), -1,
+ 0,0,0 },
+ {TK_OPTION_BOOLEAN, "-wrap", "wrap", "Wrap",
+ "0", Tk_Offset(Spinbox,spinbox.wrapObj), -1,
+ 0,0,0 },
+
+ WIDGET_INHERIT_OPTIONS(EntryOptionSpecs)
+};
+
+/* SpinboxInitialize --
+ * Initialization hook for spinbox widgets.
+ */
+static void
+SpinboxInitialize(Tcl_Interp *interp, void *recordPtr)
+{
+ Spinbox *sb = recordPtr;
+ TtkTrackElementState(&sb->core);
+ EntryInitialize(interp, recordPtr);
+}
+
+/* SpinboxConfigure --
+ * Configuration hook for spinbox widgets.
+ */
+static int
+SpinboxConfigure(Tcl_Interp *interp, void *recordPtr, int mask)
+{
+ Spinbox *sb = recordPtr;
+ int unused;
+
+ /* Make sure -values is a valid list:
+ */
+ if (Tcl_ListObjLength(interp,sb->spinbox.valuesObj,&unused) != TCL_OK)
+ return TCL_ERROR;
+
+ return EntryConfigure(interp, recordPtr, mask);
+}
+
+static const Ttk_Ensemble SpinboxCommands[] = {
+ { "bbox", EntryBBoxCommand,0 },
+ { "cget", TtkWidgetCgetCommand,0 },
+ { "configure", TtkWidgetConfigureCommand,0 },
+ { "delete", EntryDeleteCommand,0 },
+ { "get", EntryGetCommand,0 },
+ { "icursor", EntryICursorCommand,0 },
+ { "identify", TtkWidgetIdentifyCommand,0 },
+ { "index", EntryIndexCommand,0 },
+ { "insert", EntryInsertCommand,0 },
+ { "instate", TtkWidgetInstateCommand,0 },
+ { "selection", 0,EntrySelectionCommands },
+ { "state", TtkWidgetStateCommand,0 },
+ { "set", EntrySetCommand,0 },
+ { "validate", EntryValidateCommand,0 },
+ { "xview", EntryXViewCommand,0 },
+ { 0,0,0 }
+};
+
+static WidgetSpec SpinboxWidgetSpec = {
+ "TSpinbox", /* className */
+ sizeof(Spinbox), /* recordSize */
+ SpinboxOptionSpecs, /* optionSpecs */
+ SpinboxCommands, /* subcommands */
+ SpinboxInitialize, /* initializeProc */
+ EntryCleanup, /* cleanupProc */
+ SpinboxConfigure, /* configureProc */
+ EntryPostConfigure, /* postConfigureProc */
+ TtkWidgetGetLayout, /* getLayoutProc */
+ TtkWidgetSize, /* sizeProc */
+ EntryDoLayout, /* layoutProc */
+ EntryDisplay /* displayProc */
+};
+
+/*------------------------------------------------------------------------
+ * +++ Textarea element.
+ *
+ * Text display area for Entry widgets.
+ * Just computes requested size; display is handled by the widget itself.
+ */
+
+typedef struct {
+ Tcl_Obj *fontObj;
+ Tcl_Obj *widthObj;
+} TextareaElement;
+
+static Ttk_ElementOptionSpec TextareaElementOptions[] = {
+ { "-font", TK_OPTION_FONT,
+ Tk_Offset(TextareaElement,fontObj), DEF_ENTRY_FONT },
+ { "-width", TK_OPTION_INT,
+ Tk_Offset(TextareaElement,widthObj), "20" },
+ { NULL, 0, 0, NULL }
+};
+
+static void TextareaElementSize(
+ void *clientData, void *elementRecord, Tk_Window tkwin,
+ int *widthPtr, int *heightPtr, Ttk_Padding *paddingPtr)
+{
+ TextareaElement *textarea = elementRecord;
+ Tk_Font font = Tk_GetFontFromObj(tkwin, textarea->fontObj);
+ int avgWidth = Tk_TextWidth(font, "0", 1);
+ Tk_FontMetrics fm;
+ int prefWidth = 1;
+
+ Tk_GetFontMetrics(font, &fm);
+ Tcl_GetIntFromObj(NULL, textarea->widthObj, &prefWidth);
+ if (prefWidth <= 0)
+ prefWidth = 1;
+
+ *heightPtr = fm.linespace;
+ *widthPtr = prefWidth * avgWidth;
+}
+
+static Ttk_ElementSpec TextareaElementSpec = {
+ TK_STYLE_VERSION_2,
+ sizeof(TextareaElement),
+ TextareaElementOptions,
+ TextareaElementSize,
+ TtkNullElementDraw
+};
+
+/*------------------------------------------------------------------------
+ * +++ Widget layouts.
+ */
+
+TTK_BEGIN_LAYOUT(EntryLayout)
+ TTK_GROUP("Entry.field", TTK_FILL_BOTH|TTK_BORDER,
+ TTK_GROUP("Entry.padding", TTK_FILL_BOTH,
+ TTK_NODE("Entry.textarea", TTK_FILL_BOTH)))
+TTK_END_LAYOUT
+
+TTK_BEGIN_LAYOUT(ComboboxLayout)
+ TTK_GROUP("Combobox.field", TTK_FILL_BOTH,
+ TTK_NODE("Combobox.downarrow", TTK_PACK_RIGHT|TTK_FILL_Y)
+ TTK_GROUP("Combobox.padding", TTK_FILL_BOTH|TTK_PACK_LEFT|TTK_EXPAND,
+ TTK_NODE("Combobox.textarea", TTK_FILL_BOTH)))
+TTK_END_LAYOUT
+
+TTK_BEGIN_LAYOUT(SpinboxLayout)
+ TTK_GROUP("Spinbox.field", TTK_PACK_TOP|TTK_FILL_X,
+ TTK_GROUP("null", TTK_PACK_RIGHT,
+ TTK_NODE("Spinbox.uparrow", TTK_PACK_TOP|TTK_STICK_E)
+ TTK_NODE("Spinbox.downarrow", TTK_PACK_BOTTOM|TTK_STICK_E))
+ TTK_GROUP("Spinbox.padding", TTK_FILL_BOTH,
+ TTK_NODE("Spinbox.textarea", TTK_FILL_BOTH)))
+TTK_END_LAYOUT
+
+/*------------------------------------------------------------------------
+ * +++ Initialization.
+ */
+MODULE_SCOPE
+void TtkEntry_Init(Tcl_Interp *interp)
+{
+ Ttk_Theme themePtr = Ttk_GetDefaultTheme(interp);
+
+ Ttk_RegisterElement(interp, themePtr, "textarea", &TextareaElementSpec, 0);
+
+ Ttk_RegisterLayout(themePtr, "TEntry", EntryLayout);
+ Ttk_RegisterLayout(themePtr, "TCombobox", ComboboxLayout);
+ Ttk_RegisterLayout(themePtr, "TSpinbox", SpinboxLayout);
+
+ RegisterWidget(interp, "ttk::entry", &EntryWidgetSpec);
+ RegisterWidget(interp, "ttk::combobox", &ComboboxWidgetSpec);
+ RegisterWidget(interp, "ttk::spinbox", &SpinboxWidgetSpec);
+}
+
+/*EOF*/
diff --git a/tk8.6/generic/ttk/ttkFrame.c b/tk8.6/generic/ttk/ttkFrame.c
new file mode 100644
index 0000000..3e50a7f
--- /dev/null
+++ b/tk8.6/generic/ttk/ttkFrame.c
@@ -0,0 +1,653 @@
+/*
+ * Copyright (c) 2004, Joe English
+ *
+ * ttk::frame and ttk::labelframe widgets.
+ */
+
+#include <tk.h>
+
+#include "ttkTheme.h"
+#include "ttkWidget.h"
+#include "ttkManager.h"
+
+/* ======================================================================
+ * +++ Frame widget:
+ */
+
+typedef struct {
+ Tcl_Obj *borderWidthObj;
+ Tcl_Obj *paddingObj;
+ Tcl_Obj *reliefObj;
+ Tcl_Obj *widthObj;
+ Tcl_Obj *heightObj;
+} FramePart;
+
+typedef struct {
+ WidgetCore core;
+ FramePart frame;
+} Frame;
+
+static Tk_OptionSpec FrameOptionSpecs[] = {
+ {TK_OPTION_PIXELS, "-borderwidth", "borderWidth", "BorderWidth", NULL,
+ Tk_Offset(Frame,frame.borderWidthObj), -1,
+ TK_OPTION_NULL_OK,0,GEOMETRY_CHANGED },
+ {TK_OPTION_STRING, "-padding", "padding", "Pad", NULL,
+ Tk_Offset(Frame,frame.paddingObj), -1,
+ TK_OPTION_NULL_OK,0,GEOMETRY_CHANGED },
+ {TK_OPTION_RELIEF, "-relief", "relief", "Relief", NULL,
+ Tk_Offset(Frame,frame.reliefObj), -1,
+ TK_OPTION_NULL_OK,0,0 },
+ {TK_OPTION_PIXELS, "-width", "width", "Width", "0",
+ Tk_Offset(Frame,frame.widthObj), -1,
+ 0,0,GEOMETRY_CHANGED },
+ {TK_OPTION_PIXELS, "-height", "height", "Height", "0",
+ Tk_Offset(Frame,frame.heightObj), -1,
+ 0,0,GEOMETRY_CHANGED },
+
+ WIDGET_TAKEFOCUS_FALSE,
+ WIDGET_INHERIT_OPTIONS(ttkCoreOptionSpecs)
+};
+
+static const Ttk_Ensemble FrameCommands[] = {
+ { "configure", TtkWidgetConfigureCommand,0 },
+ { "cget", TtkWidgetCgetCommand,0 },
+ { "instate", TtkWidgetInstateCommand,0 },
+ { "state", TtkWidgetStateCommand,0 },
+ { "identify", TtkWidgetIdentifyCommand,0 },
+ { 0,0,0 }
+};
+
+/*
+ * FrameMargins --
+ * Compute internal margins for a frame widget.
+ * This includes the -borderWidth, plus any additional -padding.
+ */
+static Ttk_Padding FrameMargins(Frame *framePtr)
+{
+ Ttk_Padding margins = Ttk_UniformPadding(0);
+
+ /* Check -padding:
+ */
+ if (framePtr->frame.paddingObj) {
+ Ttk_GetPaddingFromObj(NULL,
+ framePtr->core.tkwin, framePtr->frame.paddingObj, &margins);
+ }
+
+ /* Add padding for border:
+ */
+ if (framePtr->frame.borderWidthObj) {
+ int border = 0;
+ Tk_GetPixelsFromObj(NULL,
+ framePtr->core.tkwin, framePtr->frame.borderWidthObj, &border);
+ margins = Ttk_AddPadding(margins, Ttk_UniformPadding((short)border));
+ }
+
+ return margins;
+}
+
+/* FrameSize procedure --
+ * The frame doesn't request a size of its own by default,
+ * but it does have an internal border. See also <<NOTE-SIZE>>
+ */
+static int FrameSize(void *recordPtr, int *widthPtr, int *heightPtr)
+{
+ Frame *framePtr = recordPtr;
+ Ttk_SetMargins(framePtr->core.tkwin, FrameMargins(framePtr));
+ return 0;
+}
+
+/*
+ * FrameConfigure -- configure hook.
+ * <<NOTE-SIZE>> Usually the size of a frame is controlled by
+ * a geometry manager (pack, grid); the -width and -height
+ * options are only effective if geometry propagation is turned
+ * off or if the [place] GM is used for child widgets.
+ *
+ * To avoid geometry blinking, we issue a geometry request
+ * in the Configure hook instead of the Size hook, and only
+ * if -width and/or -height is nonzero and one of them
+ * or the other size-related options (-borderwidth, -padding)
+ * has been changed.
+ */
+
+static int FrameConfigure(Tcl_Interp *interp, void *recordPtr, int mask)
+{
+ Frame *framePtr = recordPtr;
+ int width, height;
+
+ /*
+ * Make sure -padding resource, if present, is correct:
+ */
+ if (framePtr->frame.paddingObj) {
+ Ttk_Padding unused;
+ if (Ttk_GetPaddingFromObj(interp,
+ framePtr->core.tkwin,
+ framePtr->frame.paddingObj,
+ &unused) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ }
+
+ /* See <<NOTE-SIZE>>
+ */
+ if ( TCL_OK != Tk_GetPixelsFromObj(
+ interp,framePtr->core.tkwin,framePtr->frame.widthObj,&width)
+ || TCL_OK != Tk_GetPixelsFromObj(
+ interp,framePtr->core.tkwin,framePtr->frame.heightObj,&height)
+ )
+ {
+ return TCL_ERROR;
+ }
+
+ if ((width > 0 || height > 0) && (mask & GEOMETRY_CHANGED)) {
+ Tk_GeometryRequest(framePtr->core.tkwin, width, height);
+ }
+
+ return TtkCoreConfigure(interp, recordPtr, mask);
+}
+
+static WidgetSpec FrameWidgetSpec = {
+ "TFrame", /* className */
+ sizeof(Frame), /* recordSize */
+ FrameOptionSpecs, /* optionSpecs */
+ FrameCommands, /* subcommands */
+ TtkNullInitialize, /* initializeProc */
+ TtkNullCleanup, /* cleanupProc */
+ FrameConfigure, /* configureProc */
+ TtkNullPostConfigure, /* postConfigureProc */
+ TtkWidgetGetLayout, /* getLayoutProc */
+ FrameSize, /* sizeProc */
+ TtkWidgetDoLayout, /* layoutProc */
+ TtkWidgetDisplay /* displayProc */
+};
+
+TTK_BEGIN_LAYOUT(FrameLayout)
+ TTK_NODE("Frame.border", TTK_FILL_BOTH)
+TTK_END_LAYOUT
+
+/* ======================================================================
+ * +++ Labelframe widget:
+ */
+
+#define DEFAULT_LABELINSET 8
+#define DEFAULT_BORDERWIDTH 2
+
+int TtkGetLabelAnchorFromObj(
+ Tcl_Interp *interp, Tcl_Obj *objPtr, Ttk_PositionSpec *anchorPtr)
+{
+ const char *string = Tcl_GetString(objPtr);
+ char c = *string++;
+ Ttk_PositionSpec flags = 0;
+
+ /* First character determines side:
+ */
+ switch (c) {
+ case 'w' : flags = TTK_PACK_LEFT; break;
+ case 'e' : flags = TTK_PACK_RIGHT; break;
+ case 'n' : flags = TTK_PACK_TOP; break;
+ case 's' : flags = TTK_PACK_BOTTOM; break;
+ default : goto error;
+ }
+
+ /* Remaining characters are as per -sticky:
+ */
+ while ((c = *string++) != '\0') {
+ switch (c) {
+ case 'w' : flags |= TTK_STICK_W; break;
+ case 'e' : flags |= TTK_STICK_E; break;
+ case 'n' : flags |= TTK_STICK_N; break;
+ case 's' : flags |= TTK_STICK_S; break;
+ default : goto error;
+ }
+ }
+
+ *anchorPtr = flags;
+ return TCL_OK;
+
+error:
+ if (interp) {
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "Bad label anchor specification %s", Tcl_GetString(objPtr)));
+ Tcl_SetErrorCode(interp, "TTK", "LABEL", "ANCHOR", NULL);
+ }
+ return TCL_ERROR;
+}
+
+/* LabelAnchorSide --
+ * Returns the side corresponding to a LabelAnchor value.
+ */
+static Ttk_Side LabelAnchorSide(Ttk_PositionSpec flags)
+{
+ if (flags & TTK_PACK_LEFT) return TTK_SIDE_LEFT;
+ else if (flags & TTK_PACK_RIGHT) return TTK_SIDE_RIGHT;
+ else if (flags & TTK_PACK_TOP) return TTK_SIDE_TOP;
+ else if (flags & TTK_PACK_BOTTOM) return TTK_SIDE_BOTTOM;
+ /*NOTREACHED*/
+ return TTK_SIDE_TOP;
+}
+
+/*
+ * Labelframe widget record:
+ */
+typedef struct {
+ Tcl_Obj *labelAnchorObj;
+ Tcl_Obj *textObj;
+ Tcl_Obj *underlineObj;
+ Tk_Window labelWidget;
+
+ Ttk_Manager *mgr;
+ Ttk_Layout labelLayout; /* Sublayout for label */
+ Ttk_Box labelParcel; /* Set in layoutProc */
+} LabelframePart;
+
+typedef struct {
+ WidgetCore core;
+ FramePart frame;
+ LabelframePart label;
+} Labelframe;
+
+#define LABELWIDGET_CHANGED 0x100
+
+static Tk_OptionSpec LabelframeOptionSpecs[] = {
+ {TK_OPTION_STRING, "-labelanchor", "labelAnchor", "LabelAnchor",
+ "nw", Tk_Offset(Labelframe, label.labelAnchorObj),-1,
+ 0,0,GEOMETRY_CHANGED},
+ {TK_OPTION_STRING, "-text", "text", "Text", "",
+ Tk_Offset(Labelframe,label.textObj), -1,
+ 0,0,GEOMETRY_CHANGED },
+ {TK_OPTION_INT, "-underline", "underline", "Underline",
+ "-1", Tk_Offset(Labelframe,label.underlineObj), -1,
+ 0,0,0 },
+ {TK_OPTION_WINDOW, "-labelwidget", "labelWidget", "LabelWidget", NULL,
+ -1, Tk_Offset(Labelframe,label.labelWidget),
+ TK_OPTION_NULL_OK,0,LABELWIDGET_CHANGED|GEOMETRY_CHANGED },
+
+ WIDGET_INHERIT_OPTIONS(FrameOptionSpecs)
+};
+
+/*
+ * Labelframe style parameters:
+ */
+typedef struct {
+ int borderWidth; /* border width */
+ Ttk_Padding padding; /* internal padding */
+ Ttk_PositionSpec labelAnchor; /* corner/side to place label */
+ Ttk_Padding labelMargins; /* extra space around label */
+ int labelOutside; /* true=>place label outside border */
+} LabelframeStyle;
+
+static void LabelframeStyleOptions(Labelframe *lf, LabelframeStyle *style)
+{
+ Ttk_Layout layout = lf->core.layout;
+ Tcl_Obj *objPtr;
+
+ style->borderWidth = DEFAULT_BORDERWIDTH;
+ style->padding = Ttk_UniformPadding(0);
+ style->labelAnchor = TTK_PACK_TOP | TTK_STICK_W;
+ style->labelOutside = 0;
+
+ if ((objPtr = Ttk_QueryOption(layout, "-borderwidth", 0)) != NULL) {
+ Tk_GetPixelsFromObj(NULL, lf->core.tkwin, objPtr, &style->borderWidth);
+ }
+ if ((objPtr = Ttk_QueryOption(layout, "-padding", 0)) != NULL) {
+ Ttk_GetPaddingFromObj(NULL, lf->core.tkwin, objPtr, &style->padding);
+ }
+ if ((objPtr = Ttk_QueryOption(layout,"-labelanchor", 0)) != NULL) {
+ TtkGetLabelAnchorFromObj(NULL, objPtr, &style->labelAnchor);
+ }
+ if ((objPtr = Ttk_QueryOption(layout,"-labelmargins", 0)) != NULL) {
+ Ttk_GetBorderFromObj(NULL, objPtr, &style->labelMargins);
+ } else {
+ if (style->labelAnchor & (TTK_PACK_TOP|TTK_PACK_BOTTOM)) {
+ style->labelMargins =
+ Ttk_MakePadding(DEFAULT_LABELINSET,0,DEFAULT_LABELINSET,0);
+ } else {
+ style->labelMargins =
+ Ttk_MakePadding(0,DEFAULT_LABELINSET,0,DEFAULT_LABELINSET);
+ }
+ }
+ if ((objPtr = Ttk_QueryOption(layout,"-labeloutside", 0)) != NULL) {
+ Tcl_GetBooleanFromObj(NULL, objPtr, &style->labelOutside);
+ }
+
+ return;
+}
+
+/* LabelframeLabelSize --
+ * Extract the requested width and height of the labelframe's label:
+ * taken from the label widget if specified, otherwise the text label.
+ */
+static void
+LabelframeLabelSize(Labelframe *lframePtr, int *widthPtr, int *heightPtr)
+{
+ Tk_Window labelWidget = lframePtr->label.labelWidget;
+ Ttk_Layout labelLayout = lframePtr->label.labelLayout;
+
+ if (labelWidget) {
+ *widthPtr = Tk_ReqWidth(labelWidget);
+ *heightPtr = Tk_ReqHeight(labelWidget);
+ } else if (labelLayout) {
+ Ttk_LayoutSize(labelLayout, 0, widthPtr, heightPtr);
+ } else {
+ *widthPtr = *heightPtr = 0;
+ }
+}
+
+/*
+ * LabelframeSize --
+ * Like the frame, this doesn't request a size of its own
+ * but it does have internal padding and a minimum size.
+ */
+static int LabelframeSize(void *recordPtr, int *widthPtr, int *heightPtr)
+{
+ Labelframe *lframePtr = recordPtr;
+ WidgetCore *corePtr = &lframePtr->core;
+ Ttk_Padding margins;
+ LabelframeStyle style;
+ int labelWidth, labelHeight;
+
+ LabelframeStyleOptions(lframePtr, &style);
+
+ /* Compute base margins (See also: FrameMargins)
+ */
+ margins = Ttk_AddPadding(
+ style.padding, Ttk_UniformPadding((short)style.borderWidth));
+
+ /* Adjust margins based on label size and position:
+ */
+ LabelframeLabelSize(lframePtr, &labelWidth, &labelHeight);
+ labelWidth += Ttk_PaddingWidth(style.labelMargins);
+ labelHeight += Ttk_PaddingHeight(style.labelMargins);
+
+ switch (LabelAnchorSide(style.labelAnchor)) {
+ case TTK_SIDE_LEFT: margins.left += labelWidth; break;
+ case TTK_SIDE_RIGHT: margins.right += labelWidth; break;
+ case TTK_SIDE_TOP: margins.top += labelHeight; break;
+ case TTK_SIDE_BOTTOM: margins.bottom += labelHeight; break;
+ }
+
+ Ttk_SetMargins(corePtr->tkwin,margins);
+
+ /* Request minimum size based on border width and label size:
+ */
+ Tk_SetMinimumRequestSize(corePtr->tkwin,
+ labelWidth + 2*style.borderWidth,
+ labelHeight + 2*style.borderWidth);
+
+ return 0;
+}
+
+/*
+ * LabelframeGetLayout --
+ * Getlayout widget hook.
+ */
+
+static Ttk_Layout LabelframeGetLayout(
+ Tcl_Interp *interp, Ttk_Theme theme, void *recordPtr)
+{
+ Labelframe *lf = recordPtr;
+ Ttk_Layout frameLayout = TtkWidgetGetLayout(interp, theme, recordPtr);
+ Ttk_Layout labelLayout;
+
+ if (!frameLayout) {
+ return NULL;
+ }
+
+ labelLayout = Ttk_CreateSublayout(
+ interp, theme, frameLayout, ".Label", lf->core.optionTable);
+
+ if (labelLayout) {
+ if (lf->label.labelLayout) {
+ Ttk_FreeLayout(lf->label.labelLayout);
+ }
+ Ttk_RebindSublayout(labelLayout, recordPtr);
+ lf->label.labelLayout = labelLayout;
+ }
+
+ return frameLayout;
+}
+
+/*
+ * LabelframeDoLayout --
+ * Labelframe layout hook.
+ *
+ * Side effects: Computes labelParcel.
+ */
+
+static void LabelframeDoLayout(void *recordPtr)
+{
+ Labelframe *lframePtr = recordPtr;
+ WidgetCore *corePtr = &lframePtr->core;
+ int lw, lh; /* Label width and height */
+ LabelframeStyle style;
+ Ttk_Box borderParcel = Ttk_WinBox(lframePtr->core.tkwin);
+ Ttk_Box labelParcel;
+
+ /*
+ * Compute label parcel:
+ */
+ LabelframeStyleOptions(lframePtr, &style);
+ LabelframeLabelSize(lframePtr, &lw, &lh);
+ lw += Ttk_PaddingWidth(style.labelMargins);
+ lh += Ttk_PaddingHeight(style.labelMargins);
+
+ labelParcel = Ttk_PadBox(
+ Ttk_PositionBox(&borderParcel, lw, lh, style.labelAnchor),
+ style.labelMargins);
+
+ if (!style.labelOutside) {
+ /* Move border edge so it's over label:
+ */
+ switch (LabelAnchorSide(style.labelAnchor)) {
+ case TTK_SIDE_LEFT: borderParcel.x -= lw / 2;
+ case TTK_SIDE_RIGHT: borderParcel.width += lw/2; break;
+ case TTK_SIDE_TOP: borderParcel.y -= lh / 2;
+ case TTK_SIDE_BOTTOM: borderParcel.height += lh / 2; break;
+ }
+ }
+
+ /*
+ * Place border and label:
+ */
+ Ttk_PlaceLayout(corePtr->layout, corePtr->state, borderParcel);
+ if (lframePtr->label.labelLayout) {
+ Ttk_PlaceLayout(
+ lframePtr->label.labelLayout, corePtr->state, labelParcel);
+ }
+ /* labelWidget placed in LabelframePlaceSlaves GM hook */
+ lframePtr->label.labelParcel = labelParcel;
+}
+
+static void LabelframeDisplay(void *recordPtr, Drawable d)
+{
+ Labelframe *lframePtr = recordPtr;
+ Ttk_DrawLayout(lframePtr->core.layout, lframePtr->core.state, d);
+ if (lframePtr->label.labelLayout) {
+ Ttk_DrawLayout(lframePtr->label.labelLayout, lframePtr->core.state, d);
+ }
+}
+
+/* +++ Labelframe geometry manager hooks.
+ */
+
+/* LabelframePlaceSlaves --
+ * Sets the position and size of the labelwidget.
+ */
+static void LabelframePlaceSlaves(void *recordPtr)
+{
+ Labelframe *lframe = recordPtr;
+
+ if (Ttk_NumberSlaves(lframe->label.mgr) == 1) {
+ Ttk_Box b;
+ LabelframeDoLayout(recordPtr);
+ b = lframe->label.labelParcel;
+ /* ASSERT: slave #0 is lframe->label.labelWidget */
+ Ttk_PlaceSlave(lframe->label.mgr, 0, b.x,b.y,b.width,b.height);
+ }
+}
+
+static int LabelRequest(void *managerData, int index, int width, int height)
+{
+ return 1;
+}
+
+/* LabelRemoved --
+ * Unset the -labelwidget option.
+ *
+ * <<NOTE-LABELREMOVED>>:
+ * This routine is also called when the widget voluntarily forgets
+ * the slave in LabelframeConfigure.
+ */
+static void LabelRemoved(void *managerData, int slaveIndex)
+{
+ Labelframe *lframe = managerData;
+ lframe->label.labelWidget = 0;
+}
+
+static Ttk_ManagerSpec LabelframeManagerSpec = {
+ { "labelframe", Ttk_GeometryRequestProc, Ttk_LostSlaveProc },
+ LabelframeSize,
+ LabelframePlaceSlaves,
+ LabelRequest,
+ LabelRemoved
+};
+
+/* LabelframeInitialize --
+ * Initialization hook.
+ */
+static void LabelframeInitialize(Tcl_Interp *interp, void *recordPtr)
+{
+ Labelframe *lframe = recordPtr;
+
+ lframe->label.mgr = Ttk_CreateManager(
+ &LabelframeManagerSpec, lframe, lframe->core.tkwin);
+ lframe->label.labelWidget = 0;
+ lframe->label.labelLayout = 0;
+ lframe->label.labelParcel = Ttk_MakeBox(-1,-1,-1,-1);
+}
+
+/* LabelframeCleanup --
+ * Cleanup hook.
+ */
+static void LabelframeCleanup(void *recordPtr)
+{
+ Labelframe *lframe = recordPtr;
+ Ttk_DeleteManager(lframe->label.mgr);
+ if (lframe->label.labelLayout) {
+ Ttk_FreeLayout(lframe->label.labelLayout);
+ }
+}
+
+/* RaiseLabelWidget --
+ * Raise the -labelwidget to ensure that the labelframe doesn't
+ * obscure it (if it's not a direct child), or bring it to
+ * the top of the stacking order (if it is).
+ */
+static void RaiseLabelWidget(Labelframe *lframe)
+{
+ Tk_Window parent = Tk_Parent(lframe->label.labelWidget);
+ Tk_Window sibling = NULL;
+ Tk_Window w = lframe->core.tkwin;
+
+ while (w && w != parent) {
+ sibling = w;
+ w = Tk_Parent(w);
+ }
+
+ Tk_RestackWindow(lframe->label.labelWidget, Above, sibling);
+}
+
+/* LabelframeConfigure --
+ * Configuration hook.
+ */
+static int LabelframeConfigure(Tcl_Interp *interp,void *recordPtr,int mask)
+{
+ Labelframe *lframePtr = recordPtr;
+ Tk_Window labelWidget = lframePtr->label.labelWidget;
+ Ttk_PositionSpec unused;
+
+ /* Validate options:
+ */
+ if (mask & LABELWIDGET_CHANGED && labelWidget != NULL) {
+ if (!Ttk_Maintainable(interp, labelWidget, lframePtr->core.tkwin)) {
+ return TCL_ERROR;
+ }
+ }
+
+ if (TtkGetLabelAnchorFromObj(
+ interp, lframePtr->label.labelAnchorObj, &unused) != TCL_OK)
+ {
+ return TCL_ERROR;
+ }
+
+ /* Base class configuration:
+ */
+ if (FrameConfigure(interp, recordPtr, mask) != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ /* Update -labelwidget changes, if any:
+ */
+ if (mask & LABELWIDGET_CHANGED) {
+ if (Ttk_NumberSlaves(lframePtr->label.mgr) == 1) {
+ Ttk_ForgetSlave(lframePtr->label.mgr, 0);
+ /* Restore labelWidget field (see <<NOTE-LABELREMOVED>>)
+ */
+ lframePtr->label.labelWidget = labelWidget;
+ }
+
+ if (labelWidget) {
+ Ttk_InsertSlave(lframePtr->label.mgr, 0, labelWidget, NULL);
+ RaiseLabelWidget(lframePtr);
+ }
+ }
+
+ if (mask & GEOMETRY_CHANGED) {
+ Ttk_ManagerSizeChanged(lframePtr->label.mgr);
+ Ttk_ManagerLayoutChanged(lframePtr->label.mgr);
+ }
+
+ return TCL_OK;
+}
+
+static WidgetSpec LabelframeWidgetSpec = {
+ "TLabelframe", /* className */
+ sizeof(Labelframe), /* recordSize */
+ LabelframeOptionSpecs, /* optionSpecs */
+ FrameCommands, /* subcommands */
+ LabelframeInitialize, /* initializeProc */
+ LabelframeCleanup, /* cleanupProc */
+ LabelframeConfigure, /* configureProc */
+ TtkNullPostConfigure, /* postConfigureProc */
+ LabelframeGetLayout, /* getLayoutProc */
+ LabelframeSize, /* sizeProc */
+ LabelframeDoLayout, /* layoutProc */
+ LabelframeDisplay /* displayProc */
+};
+
+TTK_BEGIN_LAYOUT(LabelframeLayout)
+ TTK_NODE("Labelframe.border", TTK_FILL_BOTH)
+TTK_END_LAYOUT
+
+TTK_BEGIN_LAYOUT(LabelSublayout)
+ TTK_GROUP("Label.fill", TTK_FILL_BOTH,
+ TTK_NODE("Label.text", TTK_FILL_BOTH))
+TTK_END_LAYOUT
+
+/* ======================================================================
+ * +++ Initialization.
+ */
+
+MODULE_SCOPE
+void TtkFrame_Init(Tcl_Interp *interp)
+{
+ Ttk_Theme theme = Ttk_GetDefaultTheme(interp);
+
+ Ttk_RegisterLayout(theme, "TFrame", FrameLayout);
+ Ttk_RegisterLayout(theme, "TLabelframe", LabelframeLayout);
+ Ttk_RegisterLayout(theme, "Label", LabelSublayout);
+
+ RegisterWidget(interp, "ttk::frame", &FrameWidgetSpec);
+ RegisterWidget(interp, "ttk::labelframe", &LabelframeWidgetSpec);
+}
+
diff --git a/tk8.6/generic/ttk/ttkGenStubs.tcl b/tk8.6/generic/ttk/ttkGenStubs.tcl
new file mode 100644
index 0000000..8047e3f
--- /dev/null
+++ b/tk8.6/generic/ttk/ttkGenStubs.tcl
@@ -0,0 +1,963 @@
+# ttkGenStubs.tcl --
+#
+# This script generates a set of stub files for a given
+# interface.
+#
+#
+# Copyright (c) 1998-1999 by Scriptics Corporation.
+# Copyright (c) 2007 Daniel A. Steffen <das@users.sourceforge.net>
+#
+# See the file "license.terms" for information on usage and redistribution
+# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+#
+# SOURCE: tcl/tools/genStubs.tcl, revision 1.44
+#
+# CHANGES:
+# + Second argument to "declare" is used as a status guard
+# instead of a platform guard.
+# + Allow trailing semicolon in function declarations
+#
+
+namespace eval genStubs {
+ # libraryName --
+ #
+ # The name of the entire library. This value is used to compute
+ # the USE_*_STUBS macro and the name of the init file.
+
+ variable libraryName "UNKNOWN"
+
+ # interfaces --
+ #
+ # An array indexed by interface name that is used to maintain
+ # the set of valid interfaces. The value is empty.
+
+ array set interfaces {}
+
+ # curName --
+ #
+ # The name of the interface currently being defined.
+
+ variable curName "UNKNOWN"
+
+ # scspec --
+ #
+ # Storage class specifier for external function declarations.
+ # Normally "EXTERN", may be set to something like XYZAPI
+ #
+ variable scspec "EXTERN"
+
+ # epoch, revision --
+ #
+ # The epoch and revision numbers of the interface currently being defined.
+ # (@@@TODO: should be an array mapping interface names -> numbers)
+ #
+
+ variable epoch {}
+ variable revision 0
+
+ # hooks --
+ #
+ # An array indexed by interface name that contains the set of
+ # subinterfaces that should be defined for a given interface.
+
+ array set hooks {}
+
+ # stubs --
+ #
+ # This three dimensional array is indexed first by interface name,
+ # second by field name, and third by a numeric offset or the
+ # constant "lastNum". The lastNum entry contains the largest
+ # numeric offset used for a given interface.
+ #
+ # Field "decl,$i" contains the C function specification that
+ # should be used for the given entry in the stub table. The spec
+ # consists of a list in the form returned by parseDecl.
+ # Other fields TBD later.
+
+ array set stubs {}
+
+ # outDir --
+ #
+ # The directory where the generated files should be placed.
+
+ variable outDir .
+}
+
+# genStubs::library --
+#
+# This function is used in the declarations file to set the name
+# of the library that the interfaces are associated with (e.g. "tcl").
+# This value will be used to define the inline conditional macro.
+#
+# Arguments:
+# name The library name.
+#
+# Results:
+# None.
+
+proc genStubs::library {name} {
+ variable libraryName $name
+}
+
+# genStubs::interface --
+#
+# This function is used in the declarations file to set the name
+# of the interface currently being defined.
+#
+# Arguments:
+# name The name of the interface.
+#
+# Results:
+# None.
+
+proc genStubs::interface {name} {
+ variable curName $name
+ variable interfaces
+ variable stubs
+
+ set interfaces($name) {}
+ set stubs($name,lastNum) 0
+ return
+}
+
+# genStubs::scspec --
+#
+# Define the storage class macro used for external function declarations.
+# Typically, this will be a macro like XYZAPI or EXTERN that
+# expands to either DLLIMPORT or DLLEXPORT, depending on whether
+# -DBUILD_XYZ has been set.
+#
+proc genStubs::scspec {value} {
+ variable scspec $value
+}
+
+# genStubs::epoch --
+#
+# Define the epoch number for this library. The epoch
+# should be incrememented when a release is made that
+# contains incompatible changes to the public API.
+#
+proc genStubs::epoch {value} {
+ variable epoch $value
+}
+
+# genStubs::hooks --
+#
+# This function defines the subinterface hooks for the current
+# interface.
+#
+# Arguments:
+# names The ordered list of interfaces that are reachable through the
+# hook vector.
+#
+# Results:
+# None.
+
+proc genStubs::hooks {names} {
+ variable curName
+ variable hooks
+
+ set hooks($curName) $names
+ return
+}
+
+# genStubs::declare --
+#
+# This function is used in the declarations file to declare a new
+# interface entry.
+#
+# Arguments:
+# index The index number of the interface.
+# status Status of the interface: one of "current",
+# "deprecated", or "obsolete".
+# decl The C function declaration, or {} for an undefined
+# entry.
+#
+# Results:
+# None.
+
+proc genStubs::declare {args} {
+ variable stubs
+ variable curName
+ variable revision
+
+ incr revision
+ if {[llength $args] == 2} {
+ lassign $args index decl
+ set status current
+ } elseif {[llength $args] == 3} {
+ lassign $args index status decl
+ } else {
+ puts stderr "wrong # args: declare $args"
+ return
+ }
+
+ # Check for duplicate declarations, then add the declaration and
+ # bump the lastNum counter if necessary.
+
+ if {[info exists stubs($curName,decl,$index)]} {
+ puts stderr "Duplicate entry: $index"
+ }
+ regsub -all "\[ \t\n\]+" [string trim $decl] " " decl
+ set decl [parseDecl $decl]
+
+ set stubs($curName,status,$index) $status
+ set stubs($curName,decl,$index) $decl
+
+ if {$index > $stubs($curName,lastNum)} {
+ set stubs($curName,lastNum) $index
+ }
+ return
+}
+
+# genStubs::export --
+#
+# This function is used in the declarations file to declare a symbol
+# that is exported from the library but is not in the stubs table.
+#
+# Arguments:
+# decl The C function declaration, or {} for an undefined
+# entry.
+#
+# Results:
+# None.
+
+proc genStubs::export {args} {
+ if {[llength $args] != 1} {
+ puts stderr "wrong # args: export $args"
+ }
+ return
+}
+
+# genStubs::rewriteFile --
+#
+# This function replaces the machine generated portion of the
+# specified file with new contents. It looks for the !BEGIN! and
+# !END! comments to determine where to place the new text.
+#
+# Arguments:
+# file The name of the file to modify.
+# text The new text to place in the file.
+#
+# Results:
+# None.
+
+proc genStubs::rewriteFile {file text} {
+ if {![file exists $file]} {
+ puts stderr "Cannot find file: $file"
+ return
+ }
+ set in [open ${file} r]
+ set out [open ${file}.new w]
+ fconfigure $out -translation lf
+
+ while {![eof $in]} {
+ set line [gets $in]
+ if {[string match "*!BEGIN!*" $line]} {
+ break
+ }
+ puts $out $line
+ }
+ puts $out "/* !BEGIN!: Do not edit below this line. */"
+ puts $out $text
+ while {![eof $in]} {
+ set line [gets $in]
+ if {[string match "*!END!*" $line]} {
+ break
+ }
+ }
+ puts $out "/* !END!: Do not edit above this line. */"
+ puts -nonewline $out [read $in]
+ close $in
+ close $out
+ file rename -force ${file}.new ${file}
+ return
+}
+
+# genStubs::addPlatformGuard --
+#
+# Wrap a string inside a platform #ifdef.
+#
+# Arguments:
+# plat Platform to test.
+#
+# Results:
+# Returns the original text inside an appropriate #ifdef.
+
+proc genStubs::addPlatformGuard {plat iftxt {eltxt {}}} {
+ set text ""
+ switch $plat {
+ win {
+ append text "#ifdef _WIN32 /* WIN */\n${iftxt}"
+ if {$eltxt ne ""} {
+ append text "#else /* WIN */\n${eltxt}"
+ }
+ append text "#endif /* WIN */\n"
+ }
+ unix {
+ append text "#if !defined(_WIN32) && !defined(MAC_OSX_TCL)\
+ /* UNIX */\n${iftxt}"
+ if {$eltxt ne ""} {
+ append text "#else /* UNIX */\n${eltxt}"
+ }
+ append text "#endif /* UNIX */\n"
+ }
+ macosx {
+ append text "#ifdef MAC_OSX_TCL /* MACOSX */\n${iftxt}"
+ if {$eltxt ne ""} {
+ append text "#else /* MACOSX */\n${eltxt}"
+ }
+ append text "#endif /* MACOSX */\n"
+ }
+ aqua {
+ append text "#ifdef MAC_OSX_TK /* AQUA */\n${iftxt}"
+ if {$eltxt ne ""} {
+ append text "#else /* AQUA */\n${eltxt}"
+ }
+ append text "#endif /* AQUA */\n"
+ }
+ x11 {
+ append text "#if !(defined(_WIN32) || defined(MAC_OSX_TK))\
+ /* X11 */\n${iftxt}"
+ if {$eltxt ne ""} {
+ append text "#else /* X11 */\n${eltxt}"
+ }
+ append text "#endif /* X11 */\n"
+ }
+ default {
+ append text "${iftxt}${eltxt}"
+ }
+ }
+ return $text
+}
+
+# genStubs::emitSlots --
+#
+# Generate the stub table slots for the given interface. If there
+# are no generic slots, then one table is generated for each
+# platform, otherwise one table is generated for all platforms.
+#
+# Arguments:
+# name The name of the interface being emitted.
+# textVar The variable to use for output.
+#
+# Results:
+# None.
+
+proc genStubs::emitSlots {name textVar} {
+ upvar $textVar text
+
+ forAllStubs $name makeSlot noGuard text {" void (*reserved$i)(void);\n"}
+ return
+}
+
+# genStubs::parseDecl --
+#
+# Parse a C function declaration into its component parts.
+#
+# Arguments:
+# decl The function declaration.
+#
+# Results:
+# Returns a list of the form {returnType name args}. The args
+# element consists of a list of type/name pairs, or a single
+# element "void". If the function declaration is malformed
+# then an error is displayed and the return value is {}.
+
+proc genStubs::parseDecl {decl} {
+ if {![regexp {^(.*)\((.*)\);?$} $decl all prefix args]} {
+ set prefix $decl
+ set args {}
+ }
+ set prefix [string trim $prefix]
+ if {![regexp {^(.+[ ][*]*)([^ *]+)$} $prefix all rtype fname]} {
+ puts stderr "Bad return type: $decl"
+ return
+ }
+ set rtype [string trim $rtype]
+ if {$args eq ""} {
+ return [list $rtype $fname {}]
+ }
+ foreach arg [split $args ,] {
+ lappend argList [string trim $arg]
+ }
+ if {![string compare [lindex $argList end] "..."]} {
+ set args TCL_VARARGS
+ foreach arg [lrange $argList 0 end-1] {
+ set argInfo [parseArg $arg]
+ if {[llength $argInfo] == 2 || [llength $argInfo] == 3} {
+ lappend args $argInfo
+ } else {
+ puts stderr "Bad argument: '$arg' in '$decl'"
+ return
+ }
+ }
+ } else {
+ set args {}
+ foreach arg $argList {
+ set argInfo [parseArg $arg]
+ if {![string compare $argInfo "void"]} {
+ lappend args "void"
+ break
+ } elseif {[llength $argInfo] == 2 || [llength $argInfo] == 3} {
+ lappend args $argInfo
+ } else {
+ puts stderr "Bad argument: '$arg' in '$decl'"
+ return
+ }
+ }
+ }
+ return [list $rtype $fname $args]
+}
+
+# genStubs::parseArg --
+#
+# This function parses a function argument into a type and name.
+#
+# Arguments:
+# arg The argument to parse.
+#
+# Results:
+# Returns a list of type and name with an optional third array
+# indicator. If the argument is malformed, returns "".
+
+proc genStubs::parseArg {arg} {
+ if {![regexp {^(.+[ ][*]*)([^][ *]+)(\[\])?$} $arg all type name array]} {
+ if {$arg eq "void"} {
+ return $arg
+ } else {
+ return
+ }
+ }
+ set result [list [string trim $type] $name]
+ if {$array ne ""} {
+ lappend result $array
+ }
+ return $result
+}
+
+# genStubs::makeDecl --
+#
+# Generate the prototype for a function.
+#
+# Arguments:
+# name The interface name.
+# decl The function declaration.
+# index The slot index for this function.
+#
+# Results:
+# Returns the formatted declaration string.
+
+proc genStubs::makeDecl {name decl index} {
+ variable scspec
+ lassign $decl rtype fname args
+
+ append text "/* $index */\n"
+ set line "$scspec $rtype"
+ set count [expr {2 - ([string length $line] / 8)}]
+ append line [string range "\t\t\t" 0 $count]
+ set pad [expr {24 - [string length $line]}]
+ if {$pad <= 0} {
+ append line " "
+ set pad 0
+ }
+ if {$args eq ""} {
+ append line $fname
+ append text $line
+ append text ";\n"
+ return $text
+ }
+ append line $fname
+
+ set arg1 [lindex $args 0]
+ switch -exact $arg1 {
+ void {
+ append line "(void)"
+ }
+ TCL_VARARGS {
+ set sep "("
+ foreach arg [lrange $args 1 end] {
+ append line $sep
+ set next {}
+ append next [lindex $arg 0]
+ if {[string index $next end] ne "*"} {
+ append next " "
+ }
+ append next [lindex $arg 1] [lindex $arg 2]
+ if {[string length $line] + [string length $next] \
+ + $pad > 76} {
+ append text [string trimright $line] \n
+ set line "\t\t\t\t"
+ set pad 28
+ }
+ append line $next
+ set sep ", "
+ }
+ append line ", ...)"
+ }
+ default {
+ set sep "("
+ foreach arg $args {
+ append line $sep
+ set next {}
+ append next [lindex $arg 0]
+ if {[string index $next end] ne "*"} {
+ append next " "
+ }
+ append next [lindex $arg 1] [lindex $arg 2]
+ if {[string length $line] + [string length $next] \
+ + $pad > 76} {
+ append text [string trimright $line] \n
+ set line "\t\t\t\t"
+ set pad 28
+ }
+ append line $next
+ set sep ", "
+ }
+ append line ")"
+ }
+ }
+ return "$text$line;\n"
+}
+
+# genStubs::makeMacro --
+#
+# Generate the inline macro for a function.
+#
+# Arguments:
+# name The interface name.
+# decl The function declaration.
+# index The slot index for this function.
+#
+# Results:
+# Returns the formatted macro definition.
+
+proc genStubs::makeMacro {name decl index} {
+ lassign $decl rtype fname args
+
+ set lfname [string tolower [string index $fname 0]]
+ append lfname [string range $fname 1 end]
+
+ set text "#define $fname \\\n\t("
+ if {$args eq ""} {
+ append text "*"
+ }
+ append text "${name}StubsPtr->$lfname)"
+ append text " /* $index */\n"
+ return $text
+}
+
+# genStubs::makeSlot --
+#
+# Generate the stub table entry for a function.
+#
+# Arguments:
+# name The interface name.
+# decl The function declaration.
+# index The slot index for this function.
+#
+# Results:
+# Returns the formatted table entry.
+
+proc genStubs::makeSlot {name decl index} {
+ lassign $decl rtype fname args
+
+ set lfname [string tolower [string index $fname 0]]
+ append lfname [string range $fname 1 end]
+
+ set text " "
+ if {$args eq ""} {
+ append text $rtype " *" $lfname "; /* $index */\n"
+ return $text
+ }
+ if {[string range $rtype end-8 end] eq "__stdcall"} {
+ append text [string trim [string range $rtype 0 end-9]] " (__stdcall *" $lfname ") "
+ } else {
+ append text $rtype " (*" $lfname ") "
+ }
+ set arg1 [lindex $args 0]
+ switch -exact $arg1 {
+ void {
+ append text "(void)"
+ }
+ TCL_VARARGS {
+ set sep "("
+ foreach arg [lrange $args 1 end] {
+ append text $sep [lindex $arg 0]
+ if {[string index $text end] ne "*"} {
+ append text " "
+ }
+ append text [lindex $arg 1] [lindex $arg 2]
+ set sep ", "
+ }
+ append text ", ...)"
+ }
+ default {
+ set sep "("
+ foreach arg $args {
+ append text $sep [lindex $arg 0]
+ if {[string index $text end] ne "*"} {
+ append text " "
+ }
+ append text [lindex $arg 1] [lindex $arg 2]
+ set sep ", "
+ }
+ append text ")"
+ }
+ }
+
+ append text "; /* $index */\n"
+ return $text
+}
+
+# genStubs::makeInit --
+#
+# Generate the prototype for a function.
+#
+# Arguments:
+# name The interface name.
+# decl The function declaration.
+# index The slot index for this function.
+#
+# Results:
+# Returns the formatted declaration string.
+
+proc genStubs::makeInit {name decl index} {
+ if {[lindex $decl 2] eq ""} {
+ append text " &" [lindex $decl 1] ", /* " $index " */\n"
+ } else {
+ append text " " [lindex $decl 1] ", /* " $index " */\n"
+ }
+ return $text
+}
+
+# genStubs::forAllStubs --
+#
+# This function iterates over all of the slots and invokes
+# a callback for each slot. The result of the callback is then
+# placed inside appropriate guards.
+#
+# Arguments:
+# name The interface name.
+# slotProc The proc to invoke to handle the slot. It will
+# have the interface name, the declaration, and
+# the index appended.
+# guardProc The proc to invoke to add guards. It will have
+# the slot status and text appended.
+# textVar The variable to use for output.
+# skipString The string to emit if a slot is skipped. This
+# string will be subst'ed in the loop so "$i" can
+# be used to substitute the index value.
+#
+# Results:
+# None.
+
+proc genStubs::forAllStubs {name slotProc guardProc textVar
+ {skipString {"/* Slot $i is reserved */\n"}}} {
+ variable stubs
+ upvar $textVar text
+
+ set lastNum $stubs($name,lastNum)
+
+ for {set i 0} {$i <= $lastNum} {incr i} {
+ if {[info exists stubs($name,decl,$i)]} {
+ append text [$guardProc $stubs($name,status,$i) \
+ [$slotProc $name $stubs($name,decl,$i) $i]]
+ } else {
+ eval {append text} $skipString
+ }
+ }
+}
+
+proc genStubs::noGuard {status text} { return $text }
+
+proc genStubs::addGuard {status text} {
+ variable libraryName
+ set upName [string toupper $libraryName]
+
+ switch -- $status {
+ current {
+ # No change
+ }
+ deprecated {
+ set text [ifdeffed "${upName}_DEPRECATED" $text]
+ }
+ obsolete {
+ set text ""
+ }
+ default {
+ puts stderr "Unrecognized status code $status"
+ }
+ }
+ return $text
+}
+
+proc genStubs::ifdeffed {macro text} {
+ join [list "#ifdef $macro" $text "#endif" ""] \n
+}
+
+# genStubs::emitDeclarations --
+#
+# This function emits the function declarations for this interface.
+#
+# Arguments:
+# name The interface name.
+# textVar The variable to use for output.
+#
+# Results:
+# None.
+
+proc genStubs::emitDeclarations {name textVar} {
+ upvar $textVar text
+
+ append text "\n/*\n * Exported function declarations:\n */\n\n"
+ forAllStubs $name makeDecl noGuard text
+ return
+}
+
+# genStubs::emitMacros --
+#
+# This function emits the inline macros for an interface.
+#
+# Arguments:
+# name The name of the interface being emitted.
+# textVar The variable to use for output.
+#
+# Results:
+# None.
+
+proc genStubs::emitMacros {name textVar} {
+ variable libraryName
+ upvar $textVar text
+
+ set upName [string toupper $libraryName]
+ append text "\n#if defined(USE_${upName}_STUBS)\n"
+ append text "\n/*\n * Inline function declarations:\n */\n\n"
+
+ forAllStubs $name makeMacro addGuard text
+
+ append text "\n#endif /* defined(USE_${upName}_STUBS) */\n"
+ return
+}
+
+# genStubs::emitHeader --
+#
+# This function emits the body of the <name>Decls.h file for
+# the specified interface.
+#
+# Arguments:
+# name The name of the interface being emitted.
+#
+# Results:
+# None.
+
+proc genStubs::emitHeader {name} {
+ variable outDir
+ variable hooks
+ variable epoch
+ variable revision
+
+ set capName [string toupper [string index $name 0]]
+ append capName [string range $name 1 end]
+
+ if {$epoch ne ""} {
+ set CAPName [string toupper $name]
+ append text "\n"
+ append text "#define ${CAPName}_STUBS_EPOCH $epoch\n"
+ append text "#define ${CAPName}_STUBS_REVISION $revision\n"
+ }
+
+ append text "\n#ifdef __cplusplus\nextern \"C\" {\n#endif\n"
+
+ emitDeclarations $name text
+
+ if {[info exists hooks($name)]} {
+ append text "\ntypedef struct {\n"
+ foreach hook $hooks($name) {
+ set capHook [string toupper [string index $hook 0]]
+ append capHook [string range $hook 1 end]
+ append text " const struct ${capHook}Stubs *${hook}Stubs;\n"
+ }
+ append text "} ${capName}StubHooks;\n"
+ }
+ append text "\ntypedef struct ${capName}Stubs {\n"
+ append text " int magic;\n"
+ if {$epoch ne ""} {
+ append text " int epoch;\n"
+ append text " int revision;\n"
+ }
+ if {[info exists hooks($name)]} {
+ append text " const ${capName}StubHooks *hooks;\n\n"
+ } else {
+ append text " void *hooks;\n\n"
+ }
+
+ emitSlots $name text
+
+ append text "} ${capName}Stubs;\n\n"
+
+ append text "extern const ${capName}Stubs *${name}StubsPtr;\n\n"
+ append text "#ifdef __cplusplus\n}\n#endif\n"
+
+ emitMacros $name text
+
+ rewriteFile [file join $outDir ${name}Decls.h] $text
+ return
+}
+
+# genStubs::emitInit --
+#
+# Generate the table initializers for an interface.
+#
+# Arguments:
+# name The name of the interface to initialize.
+# textVar The variable to use for output.
+#
+# Results:
+# Returns the formatted output.
+
+proc genStubs::emitInit {name textVar} {
+ variable hooks
+ variable interfaces
+ variable epoch
+ upvar $textVar text
+ set root 1
+
+ set capName [string toupper [string index $name 0]]
+ append capName [string range $name 1 end]
+
+ if {[info exists hooks($name)]} {
+ append text "\nstatic const ${capName}StubHooks ${name}StubHooks = \{\n"
+ set sep " "
+ foreach sub $hooks($name) {
+ append text $sep "&${sub}Stubs"
+ set sep ",\n "
+ }
+ append text "\n\};\n"
+ }
+ foreach intf [array names interfaces] {
+ if {[info exists hooks($intf)]} {
+ if {[lsearch -exact $hooks($intf) $name] >= 0} {
+ set root 0
+ break
+ }
+ }
+ }
+
+ append text "\n"
+ if {!$root} {
+ append text "static "
+ }
+ append text "const ${capName}Stubs ${name}Stubs = \{\n TCL_STUB_MAGIC,\n"
+ if {$epoch ne ""} {
+ set CAPName [string toupper $name]
+ append text " ${CAPName}_STUBS_EPOCH,\n"
+ append text " ${CAPName}_STUBS_REVISION,\n"
+ }
+ if {[info exists hooks($name)]} {
+ append text " &${name}StubHooks,\n"
+ } else {
+ append text " 0,\n"
+ }
+
+ forAllStubs $name makeInit noGuard text {" 0, /* $i */\n"}
+
+ append text "\};\n"
+ return
+}
+
+# genStubs::emitInits --
+#
+# This function emits the body of the <name>StubInit.c file for
+# the specified interface.
+#
+# Arguments:
+# name The name of the interface being emitted.
+#
+# Results:
+# None.
+
+proc genStubs::emitInits {} {
+ variable hooks
+ variable outDir
+ variable libraryName
+ variable interfaces
+
+ # Assuming that dependencies only go one level deep, we need to emit
+ # all of the leaves first to avoid needing forward declarations.
+
+ set leaves {}
+ set roots {}
+ foreach name [lsort [array names interfaces]] {
+ if {[info exists hooks($name)]} {
+ lappend roots $name
+ } else {
+ lappend leaves $name
+ }
+ }
+ foreach name $leaves {
+ emitInit $name text
+ }
+ foreach name $roots {
+ emitInit $name text
+ }
+
+ rewriteFile [file join $outDir ${libraryName}StubInit.c] $text
+}
+
+# genStubs::init --
+#
+# This is the main entry point.
+#
+# Arguments:
+# None.
+#
+# Results:
+# None.
+
+proc genStubs::init {} {
+ global argv argv0
+ variable outDir
+ variable interfaces
+
+ if {[llength $argv] < 2} {
+ puts stderr "usage: $argv0 outDir declFile ?declFile...?"
+ exit 1
+ }
+
+ set outDir [lindex $argv 0]
+
+ foreach file [lrange $argv 1 end] {
+ source $file
+ }
+
+ foreach name [lsort [array names interfaces]] {
+ puts "Emitting $name"
+ emitHeader $name
+ }
+
+ emitInits
+}
+
+# lassign --
+#
+# This function emulates the TclX lassign command.
+#
+# Arguments:
+# valueList A list containing the values to be assigned.
+# args The list of variables to be assigned.
+#
+# Results:
+# Returns any values that were not assigned to variables.
+
+if {[string length [namespace which lassign]] == 0} {
+ proc lassign {valueList args} {
+ if {[llength $args] == 0} {
+ error "wrong # args: should be \"lassign list varName ?varName ...?\""
+ }
+ uplevel [list foreach $args $valueList {break}]
+ return [lrange $valueList [llength $args] end]
+ }
+}
+
+genStubs::init
diff --git a/tk8.6/generic/ttk/ttkImage.c b/tk8.6/generic/ttk/ttkImage.c
new file mode 100644
index 0000000..a5a3a52
--- /dev/null
+++ b/tk8.6/generic/ttk/ttkImage.c
@@ -0,0 +1,422 @@
+/*
+ * Image specifications and image element factory.
+ *
+ * Copyright (C) 2004 Pat Thoyts <patthoyts@users.sf.net>
+ * Copyright (C) 2004 Joe English
+ *
+ * An imageSpec is a multi-element list; the first element
+ * is the name of the default image to use, the remainder of the
+ * list is a sequence of statespec/imagename options as per
+ * [style map].
+ */
+
+#include <string.h>
+#include <tk.h>
+#include "ttkTheme.h"
+
+#define MIN(a,b) ((a) < (b) ? (a) : (b))
+
+/*------------------------------------------------------------------------
+ * +++ ImageSpec management.
+ */
+
+struct TtkImageSpec {
+ Tk_Image baseImage; /* Base image to use */
+ int mapCount; /* #state-specific overrides */
+ Ttk_StateSpec *states; /* array[mapCount] of states ... */
+ Tk_Image *images; /* ... per-state images to use */
+};
+
+/* NullImageChanged --
+ * Do-nothing Tk_ImageChangedProc.
+ */
+static void NullImageChanged(ClientData clientData,
+ int x, int y, int width, int height, int imageWidth, int imageHeight)
+{ /* No-op */ }
+
+/* TtkGetImageSpec --
+ * Constructs a Ttk_ImageSpec * from a Tcl_Obj *.
+ * Result must be released using TtkFreeImageSpec.
+ *
+ * TODO: Need a variant of this that takes a user-specified ImageChanged proc
+ */
+Ttk_ImageSpec *
+TtkGetImageSpec(Tcl_Interp *interp, Tk_Window tkwin, Tcl_Obj *objPtr)
+{
+ Ttk_ImageSpec *imageSpec = 0;
+ int i = 0, n = 0, objc;
+ Tcl_Obj **objv;
+
+ imageSpec = ckalloc(sizeof(*imageSpec));
+ imageSpec->baseImage = 0;
+ imageSpec->mapCount = 0;
+ imageSpec->states = 0;
+ imageSpec->images = 0;
+
+ if (Tcl_ListObjGetElements(interp, objPtr, &objc, &objv) != TCL_OK) {
+ goto error;
+ }
+
+ if ((objc % 2) != 1) {
+ if (interp) {
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "image specification must contain an odd number of elements",
+ -1));
+ Tcl_SetErrorCode(interp, "TTK", "IMAGE", "SPEC", NULL);
+ }
+ goto error;
+ }
+
+ n = (objc - 1) / 2;
+ imageSpec->states = ckalloc(n * sizeof(Ttk_StateSpec));
+ imageSpec->images = ckalloc(n * sizeof(Tk_Image *));
+
+ /* Get base image:
+ */
+ imageSpec->baseImage = Tk_GetImage(
+ interp, tkwin, Tcl_GetString(objv[0]), NullImageChanged, NULL);
+ if (!imageSpec->baseImage) {
+ goto error;
+ }
+
+ /* Extract state and image specifications:
+ */
+ for (i = 0; i < n; ++i) {
+ Tcl_Obj *stateSpec = objv[2*i + 1];
+ const char *imageName = Tcl_GetString(objv[2*i + 2]);
+ Ttk_StateSpec state;
+
+ if (Ttk_GetStateSpecFromObj(interp, stateSpec, &state) != TCL_OK) {
+ goto error;
+ }
+ imageSpec->states[i] = state;
+
+ imageSpec->images[i] = Tk_GetImage(
+ interp, tkwin, imageName, NullImageChanged, NULL);
+ if (imageSpec->images[i] == NULL) {
+ goto error;
+ }
+ imageSpec->mapCount = i+1;
+ }
+
+ return imageSpec;
+
+error:
+ TtkFreeImageSpec(imageSpec);
+ return NULL;
+}
+
+/* TtkFreeImageSpec --
+ * Dispose of an image specification.
+ */
+void TtkFreeImageSpec(Ttk_ImageSpec *imageSpec)
+{
+ int i;
+
+ for (i=0; i < imageSpec->mapCount; ++i) {
+ Tk_FreeImage(imageSpec->images[i]);
+ }
+
+ if (imageSpec->baseImage) { Tk_FreeImage(imageSpec->baseImage); }
+ if (imageSpec->states) { ckfree(imageSpec->states); }
+ if (imageSpec->images) { ckfree(imageSpec->images); }
+
+ ckfree(imageSpec);
+}
+
+/* TtkSelectImage --
+ * Return a state-specific image from an ImageSpec
+ */
+Tk_Image TtkSelectImage(Ttk_ImageSpec *imageSpec, Ttk_State state)
+{
+ int i;
+ for (i = 0; i < imageSpec->mapCount; ++i) {
+ if (Ttk_StateMatches(state, imageSpec->states+i)) {
+ return imageSpec->images[i];
+ }
+ }
+ return imageSpec->baseImage;
+}
+
+/*------------------------------------------------------------------------
+ * +++ Drawing utilities.
+ */
+
+/* LPadding, CPadding, RPadding --
+ * Split a box+padding pair into left, center, and right boxes.
+ */
+static Ttk_Box LPadding(Ttk_Box b, Ttk_Padding p)
+ { return Ttk_MakeBox(b.x, b.y, p.left, b.height); }
+
+static Ttk_Box CPadding(Ttk_Box b, Ttk_Padding p)
+ { return Ttk_MakeBox(b.x+p.left, b.y, b.width-p.left-p.right, b.height); }
+
+static Ttk_Box RPadding(Ttk_Box b, Ttk_Padding p)
+ { return Ttk_MakeBox(b.x+b.width-p.right, b.y, p.right, b.height); }
+
+/* TPadding, MPadding, BPadding --
+ * Split a box+padding pair into top, middle, and bottom parts.
+ */
+static Ttk_Box TPadding(Ttk_Box b, Ttk_Padding p)
+ { return Ttk_MakeBox(b.x, b.y, b.width, p.top); }
+
+static Ttk_Box MPadding(Ttk_Box b, Ttk_Padding p)
+ { return Ttk_MakeBox(b.x, b.y+p.top, b.width, b.height-p.top-p.bottom); }
+
+static Ttk_Box BPadding(Ttk_Box b, Ttk_Padding p)
+ { return Ttk_MakeBox(b.x, b.y+b.height-p.bottom, b.width, p.bottom); }
+
+/* Ttk_Fill --
+ * Fill the destination area of the drawable by replicating
+ * the source area of the image.
+ */
+static void Ttk_Fill(
+ Tk_Window tkwin, Drawable d, Tk_Image image, Ttk_Box src, Ttk_Box dst)
+{
+ int dr = dst.x + dst.width;
+ int db = dst.y + dst.height;
+ int x,y;
+
+ if (!(src.width && src.height && dst.width && dst.height))
+ return;
+
+ for (x = dst.x; x < dr; x += src.width) {
+ int cw = MIN(src.width, dr - x);
+ for (y = dst.y; y <= db; y += src.height) {
+ int ch = MIN(src.height, db - y);
+ Tk_RedrawImage(image, src.x, src.y, cw, ch, d, x, y);
+ }
+ }
+}
+
+/* Ttk_Stripe --
+ * Fill a horizontal stripe of the destination drawable.
+ */
+static void Ttk_Stripe(
+ Tk_Window tkwin, Drawable d, Tk_Image image,
+ Ttk_Box src, Ttk_Box dst, Ttk_Padding p)
+{
+ Ttk_Fill(tkwin, d, image, LPadding(src,p), LPadding(dst,p));
+ Ttk_Fill(tkwin, d, image, CPadding(src,p), CPadding(dst,p));
+ Ttk_Fill(tkwin, d, image, RPadding(src,p), RPadding(dst,p));
+}
+
+/* Ttk_Tile --
+ * Fill successive horizontal stripes of the destination drawable.
+ */
+static void Ttk_Tile(
+ Tk_Window tkwin, Drawable d, Tk_Image image,
+ Ttk_Box src, Ttk_Box dst, Ttk_Padding p)
+{
+ Ttk_Stripe(tkwin, d, image, TPadding(src,p), TPadding(dst,p), p);
+ Ttk_Stripe(tkwin, d, image, MPadding(src,p), MPadding(dst,p), p);
+ Ttk_Stripe(tkwin, d, image, BPadding(src,p), BPadding(dst,p), p);
+}
+
+/*------------------------------------------------------------------------
+ * +++ Image element definition.
+ */
+
+typedef struct { /* ClientData for image elements */
+ Ttk_ImageSpec *imageSpec; /* Image(s) to use */
+ int minWidth; /* Minimum width; overrides image width */
+ int minHeight; /* Minimum width; overrides image width */
+ Ttk_Sticky sticky; /* -stickiness specification */
+ Ttk_Padding border; /* Fixed border region */
+ Ttk_Padding padding; /* Internal padding */
+
+#if TILE_07_COMPAT
+ Ttk_ResourceCache cache; /* Resource cache for images */
+ Ttk_StateMap imageMap; /* State-based lookup table for images */
+#endif
+} ImageData;
+
+static void FreeImageData(void *clientData)
+{
+ ImageData *imageData = clientData;
+ if (imageData->imageSpec) { TtkFreeImageSpec(imageData->imageSpec); }
+#if TILE_07_COMPAT
+ if (imageData->imageMap) { Tcl_DecrRefCount(imageData->imageMap); }
+#endif
+ ckfree(clientData);
+}
+
+static void ImageElementSize(
+ void *clientData, void *elementRecord, Tk_Window tkwin,
+ int *widthPtr, int *heightPtr, Ttk_Padding *paddingPtr)
+{
+ ImageData *imageData = clientData;
+ Tk_Image image = imageData->imageSpec->baseImage;
+
+ if (image) {
+ Tk_SizeOfImage(image, widthPtr, heightPtr);
+ }
+ if (imageData->minWidth >= 0) {
+ *widthPtr = imageData->minWidth;
+ }
+ if (imageData->minHeight >= 0) {
+ *heightPtr = imageData->minHeight;
+ }
+
+ *paddingPtr = imageData->padding;
+}
+
+static void ImageElementDraw(
+ void *clientData, void *elementRecord, Tk_Window tkwin,
+ Drawable d, Ttk_Box b, unsigned int state)
+{
+ ImageData *imageData = clientData;
+ Tk_Image image = 0;
+ int imgWidth, imgHeight;
+ Ttk_Box src, dst;
+
+#if TILE_07_COMPAT
+ if (imageData->imageMap) {
+ Tcl_Obj *imageObj = Ttk_StateMapLookup(NULL,imageData->imageMap,state);
+ if (imageObj) {
+ image = Ttk_UseImage(imageData->cache, tkwin, imageObj);
+ }
+ }
+ if (!image) {
+ image = TtkSelectImage(imageData->imageSpec, state);
+ }
+#else
+ image = TtkSelectImage(imageData->imageSpec, state);
+#endif
+
+ if (!image) {
+ return;
+ }
+
+ Tk_SizeOfImage(image, &imgWidth, &imgHeight);
+ src = Ttk_MakeBox(0, 0, imgWidth, imgHeight);
+ dst = Ttk_StickBox(b, imgWidth, imgHeight, imageData->sticky);
+
+ Ttk_Tile(tkwin, d, image, src, dst, imageData->border);
+}
+
+static Ttk_ElementSpec ImageElementSpec =
+{
+ TK_STYLE_VERSION_2,
+ sizeof(NullElement),
+ TtkNullElementOptions,
+ ImageElementSize,
+ ImageElementDraw
+};
+
+/*------------------------------------------------------------------------
+ * +++ Image element factory.
+ */
+static int
+Ttk_CreateImageElement(
+ Tcl_Interp *interp,
+ void *clientData,
+ Ttk_Theme theme,
+ const char *elementName,
+ int objc, Tcl_Obj *const objv[])
+{
+ static const char *optionStrings[] =
+ { "-border","-height","-padding","-sticky","-width",NULL };
+ enum { O_BORDER, O_HEIGHT, O_PADDING, O_STICKY, O_WIDTH };
+
+ Ttk_ImageSpec *imageSpec = 0;
+ ImageData *imageData = 0;
+ int padding_specified = 0;
+ int i;
+
+ if (objc <= 0) {
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "Must supply a base image", -1));
+ Tcl_SetErrorCode(interp, "TTK", "IMAGE", "BASE", NULL);
+ return TCL_ERROR;
+ }
+
+ imageSpec = TtkGetImageSpec(interp, Tk_MainWindow(interp), objv[0]);
+ if (!imageSpec) {
+ return TCL_ERROR;
+ }
+
+ imageData = ckalloc(sizeof(*imageData));
+ imageData->imageSpec = imageSpec;
+ imageData->minWidth = imageData->minHeight = -1;
+ imageData->sticky = TTK_FILL_BOTH;
+ imageData->border = imageData->padding = Ttk_UniformPadding(0);
+#if TILE_07_COMPAT
+ imageData->cache = Ttk_GetResourceCache(interp);
+ imageData->imageMap = 0;
+#endif
+
+ for (i = 1; i < objc; i += 2) {
+ int option;
+
+ if (i == objc - 1) {
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "Value for %s missing", Tcl_GetString(objv[i])));
+ Tcl_SetErrorCode(interp, "TTK", "IMAGE", "VALUE", NULL);
+ goto error;
+ }
+
+#if TILE_07_COMPAT
+ if (!strcmp("-map", Tcl_GetString(objv[i]))) {
+ imageData->imageMap = objv[i+1];
+ Tcl_IncrRefCount(imageData->imageMap);
+ continue;
+ }
+#endif
+
+ if (Tcl_GetIndexFromObjStruct(interp, objv[i], optionStrings,
+ sizeof(char *), "option", 0, &option) != TCL_OK) {
+ goto error;
+ }
+
+ switch (option) {
+ case O_BORDER:
+ if (Ttk_GetBorderFromObj(interp, objv[i+1], &imageData->border)
+ != TCL_OK) {
+ goto error;
+ }
+ if (!padding_specified) {
+ imageData->padding = imageData->border;
+ }
+ break;
+ case O_PADDING:
+ if (Ttk_GetBorderFromObj(interp, objv[i+1], &imageData->padding)
+ != TCL_OK) { goto error; }
+ padding_specified = 1;
+ break;
+ case O_WIDTH:
+ if (Tcl_GetIntFromObj(interp, objv[i+1], &imageData->minWidth)
+ != TCL_OK) { goto error; }
+ break;
+ case O_HEIGHT:
+ if (Tcl_GetIntFromObj(interp, objv[i+1], &imageData->minHeight)
+ != TCL_OK) { goto error; }
+ break;
+ case O_STICKY:
+ if (Ttk_GetStickyFromObj(interp, objv[i+1], &imageData->sticky)
+ != TCL_OK) { goto error; }
+ }
+ }
+
+ if (!Ttk_RegisterElement(interp, theme, elementName, &ImageElementSpec,
+ imageData))
+ {
+ goto error;
+ }
+
+ Ttk_RegisterCleanup(interp, imageData, FreeImageData);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(elementName, -1));
+ return TCL_OK;
+
+error:
+ FreeImageData(imageData);
+ return TCL_ERROR;
+}
+
+MODULE_SCOPE
+void TtkImage_Init(Tcl_Interp *interp)
+{
+ Ttk_RegisterElementFactory(interp, "image", Ttk_CreateImageElement, NULL);
+}
+
+/*EOF*/
diff --git a/tk8.6/generic/ttk/ttkInit.c b/tk8.6/generic/ttk/ttkInit.c
new file mode 100644
index 0000000..dc6e994
--- /dev/null
+++ b/tk8.6/generic/ttk/ttkInit.c
@@ -0,0 +1,283 @@
+/*
+ * Copyright (c) 2003, Joe English
+ *
+ * Ttk package: initialization routine and miscellaneous utilities.
+ */
+
+#include <string.h>
+#include <tk.h>
+#include "ttkTheme.h"
+#include "ttkWidget.h"
+
+/*
+ * Legal values for the button -default option.
+ * See also: enum Ttk_ButtonDefaultState.
+ */
+const char *ttkDefaultStrings[] = {
+ "normal", "active", "disabled", NULL
+};
+
+int Ttk_GetButtonDefaultStateFromObj(
+ Tcl_Interp *interp, Tcl_Obj *objPtr, int *statePtr)
+{
+ *statePtr = TTK_BUTTON_DEFAULT_DISABLED;
+ return Tcl_GetIndexFromObjStruct(interp, objPtr, ttkDefaultStrings,
+ sizeof(char *), "default state", 0, statePtr);
+}
+
+/*
+ * Legal values for the -compound option.
+ * See also: enum Ttk_Compound.
+ */
+const char *ttkCompoundStrings[] = {
+ "none", "text", "image", "center",
+ "top", "bottom", "left", "right", NULL
+};
+
+int Ttk_GetCompoundFromObj(
+ Tcl_Interp *interp, Tcl_Obj *objPtr, int *statePtr)
+{
+ *statePtr = TTK_COMPOUND_NONE;
+ return Tcl_GetIndexFromObjStruct(interp, objPtr, ttkCompoundStrings,
+ sizeof(char *), "compound layout", 0, statePtr);
+}
+
+/*
+ * Legal values for the -orient option.
+ * See also: enum Ttk_Orient.
+ */
+const char *ttkOrientStrings[] = {
+ "horizontal", "vertical", NULL
+};
+
+int Ttk_GetOrientFromObj(
+ Tcl_Interp *interp, Tcl_Obj *objPtr, int *resultPtr)
+{
+ *resultPtr = TTK_ORIENT_HORIZONTAL;
+ return Tcl_GetIndexFromObjStruct(interp, objPtr, ttkOrientStrings,
+ sizeof(char *), "orientation", 0, resultPtr);
+}
+
+/*
+ * Recognized values for the -state compatibility option.
+ * Other options are accepted and interpreted as synonyms for "normal".
+ */
+static const char *ttkStateStrings[] = {
+ "normal", "readonly", "disabled", "active", NULL
+};
+enum {
+ TTK_COMPAT_STATE_NORMAL,
+ TTK_COMPAT_STATE_READONLY,
+ TTK_COMPAT_STATE_DISABLED,
+ TTK_COMPAT_STATE_ACTIVE
+};
+
+/* TtkCheckStateOption --
+ * Handle -state compatibility option.
+ *
+ * NOTE: setting -state disabled / -state enabled affects the
+ * widget state, but the internal widget state does *not* affect
+ * the value of the -state option.
+ * This option is present for compatibility only.
+ */
+void TtkCheckStateOption(WidgetCore *corePtr, Tcl_Obj *objPtr)
+{
+ int stateOption = TTK_COMPAT_STATE_NORMAL;
+ unsigned all = TTK_STATE_DISABLED|TTK_STATE_READONLY|TTK_STATE_ACTIVE;
+# define SETFLAGS(f) TtkWidgetChangeState(corePtr, f, all^f)
+
+ (void)Tcl_GetIndexFromObjStruct(NULL, objPtr, ttkStateStrings,
+ sizeof(char *), "", 0, &stateOption);
+ switch (stateOption) {
+ case TTK_COMPAT_STATE_NORMAL:
+ default:
+ SETFLAGS(0);
+ break;
+ case TTK_COMPAT_STATE_READONLY:
+ SETFLAGS(TTK_STATE_READONLY);
+ break;
+ case TTK_COMPAT_STATE_DISABLED:
+ SETFLAGS(TTK_STATE_DISABLED);
+ break;
+ case TTK_COMPAT_STATE_ACTIVE:
+ SETFLAGS(TTK_STATE_ACTIVE);
+ break;
+ }
+# undef SETFLAGS
+}
+
+/* TtkSendVirtualEvent --
+ * Send a virtual event notification to the specified target window.
+ * Equivalent to "event generate $tgtWindow <<$eventName>>"
+ *
+ * Note that we use Tk_QueueWindowEvent, not Tk_HandleEvent,
+ * so this routine does not reenter the interpreter.
+ */
+void TtkSendVirtualEvent(Tk_Window tgtWin, const char *eventName)
+{
+ union {XEvent general; XVirtualEvent virtual;} event;
+
+ memset(&event, 0, sizeof(event));
+ event.general.xany.type = VirtualEvent;
+ event.general.xany.serial = NextRequest(Tk_Display(tgtWin));
+ event.general.xany.send_event = False;
+ event.general.xany.window = Tk_WindowId(tgtWin);
+ event.general.xany.display = Tk_Display(tgtWin);
+ event.virtual.name = Tk_GetUid(eventName);
+
+ Tk_QueueWindowEvent(&event.general, TCL_QUEUE_TAIL);
+}
+
+/* TtkEnumerateOptions, TtkGetOptionValue --
+ * Common factors for data accessor commands.
+ */
+int TtkEnumerateOptions(
+ Tcl_Interp *interp, void *recordPtr, const Tk_OptionSpec *specPtr,
+ Tk_OptionTable optionTable, Tk_Window tkwin)
+{
+ Tcl_Obj *result = Tcl_NewListObj(0,0);
+ while (specPtr->type != TK_OPTION_END)
+ {
+ Tcl_Obj *optionName = Tcl_NewStringObj(specPtr->optionName, -1);
+ Tcl_Obj *optionValue =
+ Tk_GetOptionValue(interp,recordPtr,optionTable,optionName,tkwin);
+ if (optionValue) {
+ Tcl_ListObjAppendElement(interp, result, optionName);
+ Tcl_ListObjAppendElement(interp, result, optionValue);
+ }
+ ++specPtr;
+
+ if (specPtr->type == TK_OPTION_END && specPtr->clientData != NULL) {
+ /* Chain to next option spec array: */
+ specPtr = specPtr->clientData;
+ }
+ }
+ Tcl_SetObjResult(interp, result);
+ return TCL_OK;
+}
+
+int TtkGetOptionValue(
+ Tcl_Interp *interp, void *recordPtr, Tcl_Obj *optionName,
+ Tk_OptionTable optionTable, Tk_Window tkwin)
+{
+ Tcl_Obj *result =
+ Tk_GetOptionValue(interp,recordPtr,optionTable,optionName,tkwin);
+ if (result) {
+ Tcl_SetObjResult(interp, result);
+ return TCL_OK;
+ }
+ return TCL_ERROR;
+}
+
+
+/*------------------------------------------------------------------------
+ * Core Option specifications:
+ * type name dbName dbClass default objOffset intOffset flags clientData mask
+ */
+
+/* public */
+Tk_OptionSpec ttkCoreOptionSpecs[] =
+{
+ {TK_OPTION_CURSOR, "-cursor", "cursor", "Cursor", NULL,
+ Tk_Offset(WidgetCore, cursorObj), -1, TK_OPTION_NULL_OK,0,0 },
+ {TK_OPTION_STRING, "-style", "style", "Style", "",
+ Tk_Offset(WidgetCore,styleObj), -1, 0,0,STYLE_CHANGED},
+ {TK_OPTION_STRING, "-class", "", "", NULL,
+ Tk_Offset(WidgetCore,classObj), -1, 0,0,READONLY_OPTION},
+ {TK_OPTION_END, NULL, NULL, NULL, NULL, 0, 0, 0, 0, 0}
+};
+
+/*------------------------------------------------------------------------
+ * +++ Initialization: elements and element factories.
+ */
+
+extern void TtkElements_Init(Tcl_Interp *);
+extern void TtkLabel_Init(Tcl_Interp *);
+extern void TtkImage_Init(Tcl_Interp *);
+
+static void RegisterElements(Tcl_Interp *interp)
+{
+ TtkElements_Init(interp);
+ TtkLabel_Init(interp);
+ TtkImage_Init(interp);
+}
+
+/*------------------------------------------------------------------------
+ * +++ Initialization: Widget definitions.
+ */
+
+extern void TtkButton_Init(Tcl_Interp *);
+extern void TtkEntry_Init(Tcl_Interp *);
+extern void TtkFrame_Init(Tcl_Interp *);
+extern void TtkNotebook_Init(Tcl_Interp *);
+extern void TtkPanedwindow_Init(Tcl_Interp *);
+extern void TtkProgressbar_Init(Tcl_Interp *);
+extern void TtkScale_Init(Tcl_Interp *);
+extern void TtkScrollbar_Init(Tcl_Interp *);
+extern void TtkSeparator_Init(Tcl_Interp *);
+extern void TtkTreeview_Init(Tcl_Interp *);
+
+#ifdef TTK_SQUARE_WIDGET
+extern int TtkSquareWidget_Init(Tcl_Interp *);
+#endif
+
+static void RegisterWidgets(Tcl_Interp *interp)
+{
+ TtkButton_Init(interp);
+ TtkEntry_Init(interp);
+ TtkFrame_Init(interp);
+ TtkNotebook_Init(interp);
+ TtkPanedwindow_Init(interp);
+ TtkProgressbar_Init(interp);
+ TtkScale_Init(interp);
+ TtkScrollbar_Init(interp);
+ TtkSeparator_Init(interp);
+ TtkTreeview_Init(interp);
+#ifdef TTK_SQUARE_WIDGET
+ TtkSquareWidget_Init(interp);
+#endif
+}
+
+/*------------------------------------------------------------------------
+ * +++ Initialization: Built-in themes.
+ */
+
+extern int TtkAltTheme_Init(Tcl_Interp *);
+extern int TtkClassicTheme_Init(Tcl_Interp *);
+extern int TtkClamTheme_Init(Tcl_Interp *);
+
+static void RegisterThemes(Tcl_Interp *interp)
+{
+
+ TtkAltTheme_Init(interp);
+ TtkClassicTheme_Init(interp);
+ TtkClamTheme_Init(interp);
+}
+
+/*
+ * Ttk initialization.
+ */
+
+extern const TtkStubs ttkStubs;
+
+MODULE_SCOPE int
+Ttk_Init(Tcl_Interp *interp)
+{
+ /*
+ * This will be run for both safe and regular interp init.
+ * Use Tcl_IsSafe if necessary to not initialize unsafe bits.
+ */
+ Ttk_StylePkgInit(interp);
+
+ RegisterElements(interp);
+ RegisterWidgets(interp);
+ RegisterThemes(interp);
+
+ Ttk_PlatformInit(interp);
+
+ Tcl_PkgProvideEx(interp, "Ttk", TTK_PATCH_LEVEL, (ClientData)&ttkStubs);
+
+ return TCL_OK;
+}
+
+/*EOF*/
diff --git a/tk8.6/generic/ttk/ttkLabel.c b/tk8.6/generic/ttk/ttkLabel.c
new file mode 100644
index 0000000..1037840
--- /dev/null
+++ b/tk8.6/generic/ttk/ttkLabel.c
@@ -0,0 +1,698 @@
+/*
+ * text, image, and label elements.
+ *
+ * The label element combines text and image elements,
+ * with layout determined by the "-compound" option.
+ *
+ */
+
+#include <tcl.h>
+#include <tkInt.h>
+#include "ttkTheme.h"
+
+/*----------------------------------------------------------------------
+ * +++ Text element.
+ *
+ * This element displays a textual label in the foreground color.
+ *
+ * Optionally underlines the mnemonic character if the -underline resource
+ * is present and >= 0.
+ */
+
+typedef struct {
+ /*
+ * Element options:
+ */
+ Tcl_Obj *textObj;
+ Tcl_Obj *fontObj;
+ Tcl_Obj *foregroundObj;
+ Tcl_Obj *underlineObj;
+ Tcl_Obj *widthObj;
+ Tcl_Obj *anchorObj;
+ Tcl_Obj *justifyObj;
+ Tcl_Obj *wrapLengthObj;
+ Tcl_Obj *embossedObj;
+
+ /*
+ * Computed resources:
+ */
+ Tk_Font tkfont;
+ Tk_TextLayout textLayout;
+ int width;
+ int height;
+ int embossed;
+
+} TextElement;
+
+/* Text element options table.
+ * NB: Keep in sync with label element option table.
+ */
+static Ttk_ElementOptionSpec TextElementOptions[] = {
+ { "-text", TK_OPTION_STRING,
+ Tk_Offset(TextElement,textObj), "" },
+ { "-font", TK_OPTION_FONT,
+ Tk_Offset(TextElement,fontObj), DEFAULT_FONT },
+ { "-foreground", TK_OPTION_COLOR,
+ Tk_Offset(TextElement,foregroundObj), "black" },
+ { "-underline", TK_OPTION_INT,
+ Tk_Offset(TextElement,underlineObj), "-1"},
+ { "-width", TK_OPTION_INT,
+ Tk_Offset(TextElement,widthObj), "-1"},
+ { "-anchor", TK_OPTION_ANCHOR,
+ Tk_Offset(TextElement,anchorObj), "w"},
+ { "-justify", TK_OPTION_JUSTIFY,
+ Tk_Offset(TextElement,justifyObj), "left" },
+ { "-wraplength", TK_OPTION_PIXELS,
+ Tk_Offset(TextElement,wrapLengthObj), "0" },
+ { "-embossed", TK_OPTION_INT,
+ Tk_Offset(TextElement,embossedObj), "0"},
+ { NULL, 0, 0, NULL }
+};
+
+static int TextSetup(TextElement *text, Tk_Window tkwin)
+{
+ const char *string = Tcl_GetString(text->textObj);
+ Tk_Justify justify = TK_JUSTIFY_LEFT;
+ int wrapLength = 0;
+
+ text->tkfont = Tk_GetFontFromObj(tkwin, text->fontObj);
+ Tk_GetJustifyFromObj(NULL, text->justifyObj, &justify);
+ Tk_GetPixelsFromObj(NULL, tkwin, text->wrapLengthObj, &wrapLength);
+ Tcl_GetBooleanFromObj(NULL, text->embossedObj, &text->embossed);
+
+ text->textLayout = Tk_ComputeTextLayout(
+ text->tkfont, string, -1/*numChars*/, wrapLength, justify,
+ 0/*flags*/, &text->width, &text->height);
+
+ return 1;
+}
+
+/*
+ * TextReqWidth -- compute the requested width of a text element.
+ *
+ * If -width is positive, use that as the width
+ * If -width is negative, use that as the minimum width
+ * If not specified or empty, use the natural size of the text
+ */
+
+static int TextReqWidth(TextElement *text)
+{
+ int reqWidth;
+
+ if ( text->widthObj
+ && Tcl_GetIntFromObj(NULL, text->widthObj, &reqWidth) == TCL_OK)
+ {
+ int avgWidth = Tk_TextWidth(text->tkfont, "0", 1);
+ if (reqWidth <= 0) {
+ int specWidth = avgWidth * -reqWidth;
+ if (specWidth > text->width)
+ return specWidth;
+ } else {
+ return avgWidth * reqWidth;
+ }
+ }
+ return text->width;
+}
+
+static void TextCleanup(TextElement *text)
+{
+ Tk_FreeTextLayout(text->textLayout);
+}
+
+/*
+ * TextDraw --
+ * Draw a text element.
+ * Called by TextElementDraw() and LabelElementDraw().
+ */
+static void TextDraw(TextElement *text, Tk_Window tkwin, Drawable d, Ttk_Box b)
+{
+ XColor *color = Tk_GetColorFromObj(tkwin, text->foregroundObj);
+ int underline = -1;
+ XGCValues gcValues;
+ GC gc1, gc2;
+ Tk_Anchor anchor = TK_ANCHOR_CENTER;
+ TkRegion clipRegion = NULL;
+
+ gcValues.font = Tk_FontId(text->tkfont);
+ gcValues.foreground = color->pixel;
+ gc1 = Tk_GetGC(tkwin, GCFont | GCForeground, &gcValues);
+ gcValues.foreground = WhitePixelOfScreen(Tk_Screen(tkwin));
+ gc2 = Tk_GetGC(tkwin, GCFont | GCForeground, &gcValues);
+
+ /*
+ * Place text according to -anchor:
+ */
+ Tk_GetAnchorFromObj(NULL, text->anchorObj, &anchor);
+ b = Ttk_AnchorBox(b, text->width, text->height, anchor);
+
+ /*
+ * Clip text if it's too wide:
+ */
+ if (b.width < text->width) {
+ XRectangle rect;
+
+ clipRegion = TkCreateRegion();
+ rect.x = b.x;
+ rect.y = b.y;
+ rect.width = b.width + (text->embossed ? 1 : 0);
+ rect.height = b.height + (text->embossed ? 1 : 0);
+ TkUnionRectWithRegion(&rect, clipRegion, clipRegion);
+ TkSetRegion(Tk_Display(tkwin), gc1, clipRegion);
+ TkSetRegion(Tk_Display(tkwin), gc2, clipRegion);
+#ifdef HAVE_XFT
+ TkUnixSetXftClipRegion(clipRegion);
+#endif
+ }
+
+ if (text->embossed) {
+ Tk_DrawTextLayout(Tk_Display(tkwin), d, gc2,
+ text->textLayout, b.x+1, b.y+1, 0/*firstChar*/, -1/*lastChar*/);
+ }
+ Tk_DrawTextLayout(Tk_Display(tkwin), d, gc1,
+ text->textLayout, b.x, b.y, 0/*firstChar*/, -1/*lastChar*/);
+
+ Tcl_GetIntFromObj(NULL, text->underlineObj, &underline);
+ if (underline >= 0) {
+ if (text->embossed) {
+ Tk_UnderlineTextLayout(Tk_Display(tkwin), d, gc2,
+ text->textLayout, b.x+1, b.y+1, underline);
+ }
+ Tk_UnderlineTextLayout(Tk_Display(tkwin), d, gc1,
+ text->textLayout, b.x, b.y, underline);
+ }
+
+ if (clipRegion != NULL) {
+#ifdef HAVE_XFT
+ TkUnixSetXftClipRegion(None);
+#endif
+ XSetClipMask(Tk_Display(tkwin), gc1, None);
+ XSetClipMask(Tk_Display(tkwin), gc2, None);
+ TkDestroyRegion(clipRegion);
+ }
+ Tk_FreeGC(Tk_Display(tkwin), gc1);
+ Tk_FreeGC(Tk_Display(tkwin), gc2);
+}
+
+static void TextElementSize(
+ void *clientData, void *elementRecord, Tk_Window tkwin,
+ int *widthPtr, int *heightPtr, Ttk_Padding *paddingPtr)
+{
+ TextElement *text = elementRecord;
+
+ if (!TextSetup(text, tkwin))
+ return;
+
+ *heightPtr = text->height;
+ *widthPtr = TextReqWidth(text);
+
+ TextCleanup(text);
+
+ return;
+}
+
+static void TextElementDraw(
+ void *clientData, void *elementRecord, Tk_Window tkwin,
+ Drawable d, Ttk_Box b, Ttk_State state)
+{
+ TextElement *text = elementRecord;
+ if (TextSetup(text, tkwin)) {
+ TextDraw(text, tkwin, d, b);
+ TextCleanup(text);
+ }
+}
+
+static Ttk_ElementSpec TextElementSpec = {
+ TK_STYLE_VERSION_2,
+ sizeof(TextElement),
+ TextElementOptions,
+ TextElementSize,
+ TextElementDraw
+};
+
+/*----------------------------------------------------------------------
+ * +++ Image element.
+ * Draws an image.
+ */
+
+typedef struct {
+ Tcl_Obj *imageObj;
+ Tcl_Obj *stippleObj; /* For TTK_STATE_DISABLED */
+ Tcl_Obj *backgroundObj; /* " " */
+
+ Ttk_ImageSpec *imageSpec;
+ Tk_Image tkimg;
+ int width;
+ int height;
+} ImageElement;
+
+/* ===> NB: Keep in sync with label element option table. <===
+ */
+static Ttk_ElementOptionSpec ImageElementOptions[] = {
+ { "-image", TK_OPTION_STRING,
+ Tk_Offset(ImageElement,imageObj), "" },
+ { "-stipple", TK_OPTION_STRING, /* Really: TK_OPTION_BITMAP */
+ Tk_Offset(ImageElement,stippleObj), "gray50" },
+ { "-background", TK_OPTION_COLOR,
+ Tk_Offset(ImageElement,backgroundObj), DEFAULT_BACKGROUND },
+ { NULL, 0, 0, NULL }
+};
+
+/*
+ * ImageSetup() --
+ * Look up the Tk_Image from the image element's imageObj resource.
+ * Caller must release the image with ImageCleanup().
+ *
+ * Returns:
+ * 1 if successful, 0 if there was an error (unreported)
+ * or the image resource was not specified.
+ */
+
+static int ImageSetup(
+ ImageElement *image, Tk_Window tkwin, Ttk_State state)
+{
+
+ if (!image->imageObj) {
+ return 0;
+ }
+ image->imageSpec = TtkGetImageSpec(NULL, tkwin, image->imageObj);
+ if (!image->imageSpec) {
+ return 0;
+ }
+ image->tkimg = TtkSelectImage(image->imageSpec, state);
+ if (!image->tkimg) {
+ TtkFreeImageSpec(image->imageSpec);
+ return 0;
+ }
+ Tk_SizeOfImage(image->tkimg, &image->width, &image->height);
+
+ return 1;
+}
+
+static void ImageCleanup(ImageElement *image)
+{
+ TtkFreeImageSpec(image->imageSpec);
+}
+
+#ifndef MAC_OSX_TK
+/*
+ * StippleOver --
+ * Draw a stipple over the image area, to make it look "grayed-out"
+ * when TTK_STATE_DISABLED is set.
+ */
+static void StippleOver(
+ ImageElement *image, Tk_Window tkwin, Drawable d, int x, int y)
+{
+ Pixmap stipple = Tk_AllocBitmapFromObj(NULL, tkwin, image->stippleObj);
+ XColor *color = Tk_GetColorFromObj(tkwin, image->backgroundObj);
+
+ if (stipple != None) {
+ unsigned long mask = GCFillStyle | GCStipple | GCForeground;
+ XGCValues gcvalues;
+ GC gc;
+ gcvalues.foreground = color->pixel;
+ gcvalues.fill_style = FillStippled;
+ gcvalues.stipple = stipple;
+ gc = Tk_GetGC(tkwin, mask, &gcvalues);
+ XFillRectangle(Tk_Display(tkwin),d,gc,x,y,image->width,image->height);
+ Tk_FreeGC(Tk_Display(tkwin), gc);
+ Tk_FreeBitmapFromObj(tkwin, image->stippleObj);
+ }
+}
+#endif
+
+static void ImageDraw(
+ ImageElement *image, Tk_Window tkwin,Drawable d,Ttk_Box b,Ttk_State state)
+{
+ int width = image->width, height = image->height;
+
+ /* Clip width and height to remain within window bounds:
+ */
+ if (b.x + width > Tk_Width(tkwin)) {
+ width = Tk_Width(tkwin) - b.x;
+ }
+ if (b.y + height > Tk_Height(tkwin)) {
+ height = Tk_Height(tkwin) - b.y;
+ }
+
+ if (height <= 0 || width <= 0) {
+ /* Completely clipped - bail out.
+ */
+ return;
+ }
+
+ Tk_RedrawImage(image->tkimg, 0,0, width, height, d, b.x, b.y);
+
+ /* If we're disabled there's no state-specific 'disabled' image,
+ * stipple the image.
+ * @@@ Possibly: Don't do disabled-stippling at all;
+ * @@@ it's ugly and out of fashion.
+ * Do not stipple at all under Aqua, just draw the image: it shows up
+ * as a white rectangle otherwise.
+ */
+
+
+ if (state & TTK_STATE_DISABLED) {
+ if (TtkSelectImage(image->imageSpec, 0ul) == image->tkimg) {
+#ifndef MAC_OSX_TK
+ StippleOver(image, tkwin, d, b.x,b.y);
+#endif
+ }
+ }
+}
+
+static void ImageElementSize(
+ void *clientData, void *elementRecord, Tk_Window tkwin,
+ int *widthPtr, int *heightPtr, Ttk_Padding *paddingPtr)
+{
+ ImageElement *image = elementRecord;
+
+ if (ImageSetup(image, tkwin, 0)) {
+ *widthPtr = image->width;
+ *heightPtr = image->height;
+ ImageCleanup(image);
+ }
+}
+
+static void ImageElementDraw(
+ void *clientData, void *elementRecord, Tk_Window tkwin,
+ Drawable d, Ttk_Box b, Ttk_State state)
+{
+ ImageElement *image = elementRecord;
+
+ if (ImageSetup(image, tkwin, state)) {
+ ImageDraw(image, tkwin, d, b, state);
+ ImageCleanup(image);
+ }
+}
+
+static Ttk_ElementSpec ImageElementSpec = {
+ TK_STYLE_VERSION_2,
+ sizeof(ImageElement),
+ ImageElementOptions,
+ ImageElementSize,
+ ImageElementDraw
+};
+
+/*------------------------------------------------------------------------
+ * +++ Label element.
+ *
+ * Displays an image and/or text, as determined by the -compound option.
+ *
+ * Differences from Tk 8.4 compound elements:
+ *
+ * This adds two new values for the -compound option, "text"
+ * and "image". (This is useful for configuring toolbars to
+ * display icons, text and icons, or text only, as found in
+ * many browsers.)
+ *
+ * "-compound none" is supported, but I'd like to get rid of it;
+ * it makes the logic more complex, and the only benefit is
+ * backwards compatibility with Tk < 8.3.0 scripts.
+ *
+ * This adds a new resource, -space, for determining how much
+ * space to leave between the text and image; Tk 8.4 reuses the
+ * -padx or -pady option for this purpose.
+ *
+ * -width always specifies the length in characters of the text part;
+ * in Tk 8.4 it's either characters or pixels, depending on the
+ * value of -compound.
+ *
+ * Negative values of -width are interpreted as a minimum width
+ * on all platforms, not just on Windows.
+ *
+ * Tk 8.4 ignores -padx and -pady if -compound is set to "none".
+ * Here, padding is handled by a different element.
+ */
+
+typedef struct {
+ /*
+ * Element options:
+ */
+ Tcl_Obj *compoundObj;
+ Tcl_Obj *spaceObj;
+ TextElement text;
+ ImageElement image;
+
+ /*
+ * Computed values (see LabelSetup)
+ */
+ Ttk_Compound compound;
+ int space;
+ int totalWidth, totalHeight;
+} LabelElement;
+
+static Ttk_ElementOptionSpec LabelElementOptions[] = {
+ { "-compound", TK_OPTION_ANY,
+ Tk_Offset(LabelElement,compoundObj), "none" },
+ { "-space", TK_OPTION_PIXELS,
+ Tk_Offset(LabelElement,spaceObj), "4" },
+
+ /* Text element part:
+ * NB: Keep in sync with TextElementOptions.
+ */
+ { "-text", TK_OPTION_STRING,
+ Tk_Offset(LabelElement,text.textObj), "" },
+ { "-font", TK_OPTION_FONT,
+ Tk_Offset(LabelElement,text.fontObj), DEFAULT_FONT },
+ { "-foreground", TK_OPTION_COLOR,
+ Tk_Offset(LabelElement,text.foregroundObj), "black" },
+ { "-underline", TK_OPTION_INT,
+ Tk_Offset(LabelElement,text.underlineObj), "-1"},
+ { "-width", TK_OPTION_INT,
+ Tk_Offset(LabelElement,text.widthObj), ""},
+ { "-anchor", TK_OPTION_ANCHOR,
+ Tk_Offset(LabelElement,text.anchorObj), "w"},
+ { "-justify", TK_OPTION_JUSTIFY,
+ Tk_Offset(LabelElement,text.justifyObj), "left" },
+ { "-wraplength", TK_OPTION_PIXELS,
+ Tk_Offset(LabelElement,text.wrapLengthObj), "0" },
+ { "-embossed", TK_OPTION_INT,
+ Tk_Offset(LabelElement,text.embossedObj), "0"},
+
+ /* Image element part:
+ * NB: Keep in sync with ImageElementOptions.
+ */
+ { "-image", TK_OPTION_STRING,
+ Tk_Offset(LabelElement,image.imageObj), "" },
+ { "-stipple", TK_OPTION_STRING, /* Really: TK_OPTION_BITMAP */
+ Tk_Offset(LabelElement,image.stippleObj), "gray50" },
+ { "-background", TK_OPTION_COLOR,
+ Tk_Offset(LabelElement,image.backgroundObj), DEFAULT_BACKGROUND },
+ { NULL, 0, 0, NULL }
+};
+
+/*
+ * LabelSetup --
+ * Fills in computed fields of the label element.
+ *
+ * Calculate the text, image, and total width and height.
+ */
+
+#undef MAX
+#define MAX(a,b) ((a) > (b) ? a : b);
+static void LabelSetup(
+ LabelElement *c, Tk_Window tkwin, Ttk_State state)
+{
+ Ttk_Compound *compoundPtr = &c->compound;
+
+ Tk_GetPixelsFromObj(NULL,tkwin,c->spaceObj,&c->space);
+ Ttk_GetCompoundFromObj(NULL,c->compoundObj,(int*)compoundPtr);
+
+ /*
+ * Deal with TTK_COMPOUND_NONE.
+ */
+ if (c->compound == TTK_COMPOUND_NONE) {
+ if (ImageSetup(&c->image, tkwin, state)) {
+ c->compound = TTK_COMPOUND_IMAGE;
+ } else {
+ c->compound = TTK_COMPOUND_TEXT;
+ }
+ } else if (c->compound != TTK_COMPOUND_TEXT) {
+ if (!ImageSetup(&c->image, tkwin, state)) {
+ c->compound = TTK_COMPOUND_TEXT;
+ }
+ }
+ if (c->compound != TTK_COMPOUND_IMAGE)
+ TextSetup(&c->text, tkwin);
+
+ /*
+ * ASSERT:
+ * if c->compound != IMAGE, then TextSetup() has been called
+ * if c->compound != TEXT, then ImageSetup() has returned successfully
+ * c->compound != COMPOUND_NONE.
+ */
+
+ switch (c->compound)
+ {
+ case TTK_COMPOUND_NONE:
+ /* Can't happen */
+ break;
+ case TTK_COMPOUND_TEXT:
+ c->totalWidth = c->text.width;
+ c->totalHeight = c->text.height;
+ break;
+ case TTK_COMPOUND_IMAGE:
+ c->totalWidth = c->image.width;
+ c->totalHeight = c->image.height;
+ break;
+ case TTK_COMPOUND_CENTER:
+ c->totalWidth = MAX(c->image.width, c->text.width);
+ c->totalHeight = MAX(c->image.height, c->text.height);
+ break;
+ case TTK_COMPOUND_TOP:
+ case TTK_COMPOUND_BOTTOM:
+ c->totalWidth = MAX(c->image.width, c->text.width);
+ c->totalHeight = c->image.height + c->text.height + c->space;
+ break;
+
+ case TTK_COMPOUND_LEFT:
+ case TTK_COMPOUND_RIGHT:
+ c->totalWidth = c->image.width + c->text.width + c->space;
+ c->totalHeight = MAX(c->image.height, c->text.height);
+ break;
+ }
+}
+
+static void LabelCleanup(LabelElement *c)
+{
+ if (c->compound != TTK_COMPOUND_TEXT)
+ ImageCleanup(&c->image);
+ if (c->compound != TTK_COMPOUND_IMAGE)
+ TextCleanup(&c->text);
+}
+
+static void LabelElementSize(
+ void *clientData, void *elementRecord, Tk_Window tkwin,
+ int *widthPtr, int *heightPtr, Ttk_Padding *paddingPtr)
+{
+ LabelElement *label = elementRecord;
+ int textReqWidth = 0;
+
+ LabelSetup(label, tkwin, 0);
+
+ *heightPtr = label->totalHeight;
+
+ /* Requested width based on -width option, not actual text width:
+ */
+ if (label->compound != TTK_COMPOUND_IMAGE)
+ textReqWidth = TextReqWidth(&label->text);
+
+ switch (label->compound)
+ {
+ case TTK_COMPOUND_TEXT:
+ *widthPtr = textReqWidth;
+ break;
+ case TTK_COMPOUND_IMAGE:
+ *widthPtr = label->image.width;
+ break;
+ case TTK_COMPOUND_TOP:
+ case TTK_COMPOUND_BOTTOM:
+ case TTK_COMPOUND_CENTER:
+ *widthPtr = MAX(label->image.width, textReqWidth);
+ break;
+ case TTK_COMPOUND_LEFT:
+ case TTK_COMPOUND_RIGHT:
+ *widthPtr = label->image.width + textReqWidth + label->space;
+ break;
+ case TTK_COMPOUND_NONE:
+ break; /* Can't happen */
+ }
+
+ LabelCleanup(label);
+}
+
+/*
+ * DrawCompound --
+ * Helper routine for LabelElementDraw;
+ * Handles layout for -compound {left,right,top,bottom}
+ */
+static void DrawCompound(
+ LabelElement *l, Ttk_Box b, Tk_Window tkwin, Drawable d, Ttk_State state,
+ int imageSide, int textSide)
+{
+ Ttk_Box imageBox =
+ Ttk_PlaceBox(&b, l->image.width, l->image.height, imageSide, 0);
+ Ttk_Box textBox =
+ Ttk_PlaceBox(&b, l->text.width, l->text.height, textSide, 0);
+ ImageDraw(&l->image,tkwin,d,imageBox,state);
+ TextDraw(&l->text,tkwin,d,textBox);
+}
+
+static void LabelElementDraw(
+ void *clientData, void *elementRecord, Tk_Window tkwin,
+ Drawable d, Ttk_Box b, Ttk_State state)
+{
+ LabelElement *l = elementRecord;
+ Tk_Anchor anchor = TK_ANCHOR_CENTER;
+
+ LabelSetup(l, tkwin, state);
+
+ /*
+ * Adjust overall parcel based on -anchor:
+ */
+ Tk_GetAnchorFromObj(NULL, l->text.anchorObj, &anchor);
+ b = Ttk_AnchorBox(b, l->totalWidth, l->totalHeight, anchor);
+
+ /*
+ * Draw text and/or image parts based on -compound:
+ */
+ switch (l->compound)
+ {
+ case TTK_COMPOUND_NONE:
+ /* Can't happen */
+ break;
+ case TTK_COMPOUND_TEXT:
+ TextDraw(&l->text,tkwin,d,b);
+ break;
+ case TTK_COMPOUND_IMAGE:
+ ImageDraw(&l->image,tkwin,d,b,state);
+ break;
+ case TTK_COMPOUND_CENTER:
+ {
+ Ttk_Box pb = Ttk_AnchorBox(
+ b, l->image.width, l->image.height, TK_ANCHOR_CENTER);
+ ImageDraw(&l->image, tkwin, d, pb, state);
+ pb = Ttk_AnchorBox(
+ b, l->text.width, l->text.height, TK_ANCHOR_CENTER);
+ TextDraw(&l->text, tkwin, d, pb);
+ break;
+ }
+ case TTK_COMPOUND_TOP:
+ DrawCompound(l, b, tkwin, d, state, TTK_SIDE_TOP, TTK_SIDE_BOTTOM);
+ break;
+ case TTK_COMPOUND_BOTTOM:
+ DrawCompound(l, b, tkwin, d, state, TTK_SIDE_BOTTOM, TTK_SIDE_TOP);
+ break;
+ case TTK_COMPOUND_LEFT:
+ DrawCompound(l, b, tkwin, d, state, TTK_SIDE_LEFT, TTK_SIDE_RIGHT);
+ break;
+ case TTK_COMPOUND_RIGHT:
+ DrawCompound(l, b, tkwin, d, state, TTK_SIDE_RIGHT, TTK_SIDE_LEFT);
+ break;
+ }
+
+ LabelCleanup(l);
+}
+
+static Ttk_ElementSpec LabelElementSpec = {
+ TK_STYLE_VERSION_2,
+ sizeof(LabelElement),
+ LabelElementOptions,
+ LabelElementSize,
+ LabelElementDraw
+};
+
+/*------------------------------------------------------------------------
+ * +++ Initialization.
+ */
+
+MODULE_SCOPE
+void TtkLabel_Init(Tcl_Interp *interp)
+{
+ Ttk_Theme theme = Ttk_GetDefaultTheme(interp);
+
+ Ttk_RegisterElement(interp, theme, "text", &TextElementSpec, NULL);
+ Ttk_RegisterElement(interp, theme, "image", &ImageElementSpec, NULL);
+ Ttk_RegisterElement(interp, theme, "label", &LabelElementSpec, NULL);
+}
+
diff --git a/tk8.6/generic/ttk/ttkLayout.c b/tk8.6/generic/ttk/ttkLayout.c
new file mode 100644
index 0000000..ba24589
--- /dev/null
+++ b/tk8.6/generic/ttk/ttkLayout.c
@@ -0,0 +1,1257 @@
+/*
+ * ttkLayout.c --
+ *
+ * Generic layout processing.
+ *
+ * Copyright (c) 2003 Joe English. Freely redistributable.
+ */
+
+#include <string.h>
+#include <tk.h>
+#include "ttkThemeInt.h"
+
+#define MAX(a,b) (a > b ? a : b)
+#define MIN(a,b) (a < b ? a : b)
+
+/*------------------------------------------------------------------------
+ * +++ Ttk_Box and Ttk_Padding utilities:
+ */
+
+Ttk_Box
+Ttk_MakeBox(int x, int y, int width, int height)
+{
+ Ttk_Box b;
+ b.x = x; b.y = y; b.width = width; b.height = height;
+ return b;
+}
+
+int
+Ttk_BoxContains(Ttk_Box box, int x, int y)
+{
+ return box.x <= x && x < box.x + box.width
+ && box.y <= y && y < box.y + box.height;
+}
+
+Tcl_Obj *
+Ttk_NewBoxObj(Ttk_Box box)
+{
+ Tcl_Obj *result[4];
+
+ result[0] = Tcl_NewIntObj(box.x);
+ result[1] = Tcl_NewIntObj(box.y);
+ result[2] = Tcl_NewIntObj(box.width);
+ result[3] = Tcl_NewIntObj(box.height);
+
+ return Tcl_NewListObj(4, result);
+}
+
+/*
+ * packTop, packBottom, packLeft, packRight --
+ * Carve out a parcel of the specified height (resp width)
+ * from the specified cavity.
+ *
+ * Returns:
+ * The new parcel.
+ *
+ * Side effects:
+ * Adjust the cavity.
+ */
+
+static Ttk_Box packTop(Ttk_Box *cavity, int height)
+{
+ Ttk_Box parcel;
+ height = MIN(height, cavity->height);
+ parcel = Ttk_MakeBox(cavity->x, cavity->y, cavity->width, height);
+ cavity->y += height;
+ cavity->height -= height;
+ return parcel;
+}
+
+static Ttk_Box packBottom(Ttk_Box *cavity, int height)
+{
+ height = MIN(height, cavity->height);
+ cavity->height -= height;
+ return Ttk_MakeBox(
+ cavity->x, cavity->y + cavity->height,
+ cavity->width, height);
+}
+
+static Ttk_Box packLeft(Ttk_Box *cavity, int width)
+{
+ Ttk_Box parcel;
+ width = MIN(width, cavity->width);
+ parcel = Ttk_MakeBox(cavity->x, cavity->y, width,cavity->height);
+ cavity->x += width;
+ cavity->width -= width;
+ return parcel;
+}
+
+static Ttk_Box packRight(Ttk_Box *cavity, int width)
+{
+ width = MIN(width, cavity->width);
+ cavity->width -= width;
+ return Ttk_MakeBox(cavity->x + cavity->width,
+ cavity->y, width, cavity->height);
+}
+
+/*
+ * Ttk_PackBox --
+ * Carve out a parcel of the specified size on the specified side
+ * in the specified cavity.
+ *
+ * Returns:
+ * The new parcel.
+ *
+ * Side effects:
+ * Adjust the cavity.
+ */
+
+Ttk_Box Ttk_PackBox(Ttk_Box *cavity, int width, int height, Ttk_Side side)
+{
+ switch (side) {
+ default:
+ case TTK_SIDE_TOP: return packTop(cavity, height);
+ case TTK_SIDE_BOTTOM: return packBottom(cavity, height);
+ case TTK_SIDE_LEFT: return packLeft(cavity, width);
+ case TTK_SIDE_RIGHT: return packRight(cavity, width);
+ }
+}
+
+/*
+ * Ttk_PadBox --
+ * Shrink a box by the specified padding amount.
+ */
+Ttk_Box Ttk_PadBox(Ttk_Box b, Ttk_Padding p)
+{
+ b.x += p.left;
+ b.y += p.top;
+ b.width -= (p.left + p.right);
+ b.height -= (p.top + p.bottom);
+ if (b.width <= 0) b.width = 1;
+ if (b.height <= 0) b.height = 1;
+ return b;
+}
+
+/*
+ * Ttk_ExpandBox --
+ * Grow a box by the specified padding amount.
+ */
+Ttk_Box Ttk_ExpandBox(Ttk_Box b, Ttk_Padding p)
+{
+ b.x -= p.left;
+ b.y -= p.top;
+ b.width += (p.left + p.right);
+ b.height += (p.top + p.bottom);
+ return b;
+}
+
+/*
+ * Ttk_StickBox --
+ * Place a box of size w * h in the specified parcel,
+ * according to the specified sticky bits.
+ */
+Ttk_Box Ttk_StickBox(Ttk_Box parcel, int width, int height, unsigned sticky)
+{
+ int dx, dy;
+
+ if (width > parcel.width) width = parcel.width;
+ if (height > parcel.height) height = parcel.height;
+
+ dx = parcel.width - width;
+ dy = parcel.height - height;
+
+ /*
+ * X coordinate adjustment:
+ */
+ switch (sticky & (TTK_STICK_W | TTK_STICK_E))
+ {
+ case TTK_STICK_W | TTK_STICK_E:
+ /* no-op -- use entire parcel width */
+ break;
+ case TTK_STICK_W:
+ parcel.width = width;
+ break;
+ case TTK_STICK_E:
+ parcel.x += dx;
+ parcel.width = width;
+ break;
+ default :
+ parcel.x += dx / 2;
+ parcel.width = width;
+ break;
+ }
+
+ /*
+ * Y coordinate adjustment:
+ */
+ switch (sticky & (TTK_STICK_N | TTK_STICK_S))
+ {
+ case TTK_STICK_N | TTK_STICK_S:
+ /* use entire parcel height */
+ break;
+ case TTK_STICK_N:
+ parcel.height = height;
+ break;
+ case TTK_STICK_S:
+ parcel.y += dy;
+ parcel.height = height;
+ break;
+ default :
+ parcel.y += dy / 2;
+ parcel.height = height;
+ break;
+ }
+
+ return parcel;
+}
+
+/*
+ * AnchorToSticky --
+ * Convert a Tk_Anchor enum to a TTK_STICKY bitmask.
+ */
+static Ttk_Sticky AnchorToSticky(Tk_Anchor anchor)
+{
+ switch (anchor)
+ {
+ case TK_ANCHOR_N: return TTK_STICK_N;
+ case TK_ANCHOR_NE: return TTK_STICK_N | TTK_STICK_E;
+ case TK_ANCHOR_E: return TTK_STICK_E;
+ case TK_ANCHOR_SE: return TTK_STICK_S | TTK_STICK_E;
+ case TK_ANCHOR_S: return TTK_STICK_S;
+ case TK_ANCHOR_SW: return TTK_STICK_S | TTK_STICK_W;
+ case TK_ANCHOR_W: return TTK_STICK_W;
+ case TK_ANCHOR_NW: return TTK_STICK_N | TTK_STICK_W;
+ default:
+ case TK_ANCHOR_CENTER: return 0;
+ }
+}
+
+/*
+ * Ttk_AnchorBox --
+ * Place a box of size w * h in the specified parcel,
+ * according to the specified anchor.
+ */
+Ttk_Box Ttk_AnchorBox(Ttk_Box parcel, int width, int height, Tk_Anchor anchor)
+{
+ return Ttk_StickBox(parcel, width, height, AnchorToSticky(anchor));
+}
+
+/*
+ * Ttk_PlaceBox --
+ * Combine Ttk_PackBox() and Ttk_StickBox().
+ */
+Ttk_Box Ttk_PlaceBox(
+ Ttk_Box *cavity, int width, int height, Ttk_Side side, unsigned sticky)
+{
+ return Ttk_StickBox(
+ Ttk_PackBox(cavity, width, height, side), width, height, sticky);
+}
+
+/*
+ * Ttk_PositionBox --
+ * Pack and stick a box according to PositionSpec flags.
+ */
+MODULE_SCOPE Ttk_Box
+Ttk_PositionBox(Ttk_Box *cavity, int width, int height, Ttk_PositionSpec flags)
+{
+ Ttk_Box parcel;
+
+ if (flags & TTK_EXPAND) parcel = *cavity;
+ else if (flags & TTK_PACK_TOP) parcel = packTop(cavity, height);
+ else if (flags & TTK_PACK_LEFT) parcel = packLeft(cavity, width);
+ else if (flags & TTK_PACK_BOTTOM) parcel = packBottom(cavity, height);
+ else if (flags & TTK_PACK_RIGHT) parcel = packRight(cavity, width);
+ else parcel = *cavity;
+
+ return Ttk_StickBox(parcel, width, height, flags);
+}
+
+/*
+ * TTKInitPadding --
+ * Common factor of Ttk_GetPaddingFromObj and Ttk_GetBorderFromObj.
+ * Initializes Ttk_Padding record, supplying default values
+ * for missing entries.
+ */
+static void TTKInitPadding(int padc, int pixels[4], Ttk_Padding *pad)
+{
+ switch (padc)
+ {
+ case 0: pixels[0] = 0; /*FALLTHRU*/
+ case 1: pixels[1] = pixels[0]; /*FALLTHRU*/
+ case 2: pixels[2] = pixels[0]; /*FALLTHRU*/
+ case 3: pixels[3] = pixels[1]; /*FALLTHRU*/
+ }
+
+ pad->left = (short)pixels[0];
+ pad->top = (short)pixels[1];
+ pad->right = (short)pixels[2];
+ pad->bottom = (short)pixels[3];
+}
+
+/*
+ * Ttk_GetPaddingFromObj --
+ *
+ * Extract a padding specification from a Tcl_Obj * scaled
+ * to work with a particular Tk_Window.
+ *
+ * The string representation of a Ttk_Padding is a list
+ * of one to four Tk_Pixel specifications, corresponding
+ * to the left, top, right, and bottom padding.
+ *
+ * If the 'bottom' (fourth) element is missing, it defaults to 'top'.
+ * If the 'right' (third) element is missing, it defaults to 'left'.
+ * If the 'top' (second) element is missing, it defaults to 'left'.
+ *
+ * The internal representation is a Tcl_ListObj containing
+ * one to four Tk_PixelObj objects.
+ *
+ * Returns:
+ * TCL_OK or TCL_ERROR. In the latter case an error message is
+ * left in 'interp' and '*paddingPtr' is set to all-zeros.
+ * Otherwise, *paddingPtr is filled in with the padding specification.
+ *
+ */
+int Ttk_GetPaddingFromObj(
+ Tcl_Interp *interp,
+ Tk_Window tkwin,
+ Tcl_Obj *objPtr,
+ Ttk_Padding *pad)
+{
+ Tcl_Obj **padv;
+ int i, padc, pixels[4];
+
+ if (TCL_OK != Tcl_ListObjGetElements(interp, objPtr, &padc, &padv)) {
+ goto error;
+ }
+
+ if (padc > 4) {
+ if (interp) {
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "Wrong #elements in padding spec", -1));
+ Tcl_SetErrorCode(interp, "TTK", "VALUE", "PADDING", NULL);
+ }
+ goto error;
+ }
+
+ for (i=0; i < padc; ++i) {
+ if (Tk_GetPixelsFromObj(interp, tkwin, padv[i], &pixels[i]) != TCL_OK) {
+ goto error;
+ }
+ }
+
+ TTKInitPadding(padc, pixels, pad);
+ return TCL_OK;
+
+error:
+ pad->left = pad->top = pad->right = pad->bottom = 0;
+ return TCL_ERROR;
+}
+
+/* Ttk_GetBorderFromObj --
+ * Same as Ttk_GetPaddingFromObj, except padding is a list of integers
+ * instead of Tk_Pixel specifications. Does not require a Tk_Window
+ * parameter.
+ *
+ */
+int Ttk_GetBorderFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr, Ttk_Padding *pad)
+{
+ Tcl_Obj **padv;
+ int i, padc, pixels[4];
+
+ if (TCL_OK != Tcl_ListObjGetElements(interp, objPtr, &padc, &padv)) {
+ goto error;
+ }
+
+ if (padc > 4) {
+ if (interp) {
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "Wrong #elements in padding spec", -1));
+ Tcl_SetErrorCode(interp, "TTK", "VALUE", "BORDER", NULL);
+ }
+ goto error;
+ }
+
+ for (i=0; i < padc; ++i) {
+ if (Tcl_GetIntFromObj(interp, padv[i], &pixels[i]) != TCL_OK) {
+ goto error;
+ }
+ }
+
+ TTKInitPadding(padc, pixels, pad);
+ return TCL_OK;
+
+error:
+ pad->left = pad->top = pad->right = pad->bottom = 0;
+ return TCL_ERROR;
+}
+
+/*
+ * Ttk_MakePadding --
+ * Return an initialized Ttk_Padding structure.
+ */
+Ttk_Padding Ttk_MakePadding(short left, short top, short right, short bottom)
+{
+ Ttk_Padding pad;
+ pad.left = left;
+ pad.top = top;
+ pad.right = right;
+ pad.bottom = bottom;
+ return pad;
+}
+
+/*
+ * Ttk_UniformPadding --
+ * Returns a uniform Ttk_Padding structure, with the same
+ * border width on all sides.
+ */
+Ttk_Padding Ttk_UniformPadding(short borderWidth)
+{
+ Ttk_Padding pad;
+ pad.left = pad.top = pad.right = pad.bottom = borderWidth;
+ return pad;
+}
+
+/*
+ * Ttk_AddPadding --
+ * Combine two padding records.
+ */
+Ttk_Padding Ttk_AddPadding(Ttk_Padding p1, Ttk_Padding p2)
+{
+ p1.left += p2.left;
+ p1.top += p2.top;
+ p1.right += p2.right;
+ p1.bottom += p2.bottom;
+ return p1;
+}
+
+/* Ttk_RelievePadding --
+ * Add an extra n pixels of padding according to specified relief.
+ * This may be used in element geometry procedures to simulate
+ * a "pressed-in" look for pushbuttons.
+ */
+Ttk_Padding Ttk_RelievePadding(Ttk_Padding padding, int relief, int n)
+{
+ switch (relief)
+ {
+ case TK_RELIEF_RAISED:
+ padding.right += n;
+ padding.bottom += n;
+ break;
+ case TK_RELIEF_SUNKEN: /* shift */
+ padding.left += n;
+ padding.top += n;
+ break;
+ default:
+ {
+ int h1 = n/2, h2 = h1 + n % 2;
+ padding.left += h1;
+ padding.top += h1;
+ padding.right += h2;
+ padding.bottom += h2;
+ break;
+ }
+ }
+ return padding;
+}
+
+/*
+ * Ttk_GetStickyFromObj --
+ * Returns a stickiness specification from the specified Tcl_Obj*,
+ * consisting of any combination of n, s, e, and w.
+ *
+ * Returns: TCL_OK if objPtr holds a valid stickiness specification,
+ * otherwise TCL_ERROR. interp is used for error reporting if non-NULL.
+ *
+ */
+int Ttk_GetStickyFromObj(
+ Tcl_Interp *interp, Tcl_Obj *objPtr, Ttk_Sticky *result)
+{
+ const char *string = Tcl_GetString(objPtr);
+ Ttk_Sticky sticky = 0;
+ char c;
+
+ while ((c = *string++) != '\0') {
+ switch (c) {
+ case 'w': case 'W': sticky |= TTK_STICK_W; break;
+ case 'e': case 'E': sticky |= TTK_STICK_E; break;
+ case 'n': case 'N': sticky |= TTK_STICK_N; break;
+ case 's': case 'S': sticky |= TTK_STICK_S; break;
+ default:
+ if (interp) {
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "Bad -sticky specification %s",
+ Tcl_GetString(objPtr)));
+ Tcl_SetErrorCode(interp, "TTK", "VALUE", "STICKY", NULL);
+ }
+ return TCL_ERROR;
+ }
+ }
+
+ *result = sticky;
+ return TCL_OK;
+}
+
+/* Ttk_NewStickyObj --
+ * Construct a new Tcl_Obj * containing a stickiness specification.
+ */
+Tcl_Obj *Ttk_NewStickyObj(Ttk_Sticky sticky)
+{
+ char buf[5];
+ char *p = buf;
+
+ if (sticky & TTK_STICK_N) *p++ = 'n';
+ if (sticky & TTK_STICK_S) *p++ = 's';
+ if (sticky & TTK_STICK_W) *p++ = 'w';
+ if (sticky & TTK_STICK_E) *p++ = 'e';
+
+ *p = '\0';
+ return Tcl_NewStringObj(buf, p - buf);
+}
+
+/*------------------------------------------------------------------------
+ * +++ Layout nodes.
+ */
+
+typedef struct Ttk_LayoutNode_ Ttk_LayoutNode;
+struct Ttk_LayoutNode_
+{
+ unsigned flags; /* Packing and sticky flags */
+ Ttk_ElementClass *eclass; /* Class record */
+ Ttk_State state; /* Current state */
+ Ttk_Box parcel; /* allocated parcel */
+ Ttk_LayoutNode *next, *child;
+};
+
+static Ttk_LayoutNode *Ttk_NewLayoutNode(
+ unsigned flags, Ttk_ElementClass *elementClass)
+{
+ Ttk_LayoutNode *node = ckalloc(sizeof(*node));
+
+ node->flags = flags;
+ node->eclass = elementClass;
+ node->state = 0u;
+ node->next = node->child = 0;
+ node->parcel = Ttk_MakeBox(0,0,0,0);
+
+ return node;
+}
+
+static void Ttk_FreeLayoutNode(Ttk_LayoutNode *node)
+{
+ while (node) {
+ Ttk_LayoutNode *next = node->next;
+ Ttk_FreeLayoutNode(node->child);
+ ckfree(node);
+ node = next;
+ }
+}
+
+/*------------------------------------------------------------------------
+ * +++ Layout templates.
+ */
+
+struct Ttk_TemplateNode_ {
+ char *name;
+ unsigned flags;
+ struct Ttk_TemplateNode_ *next, *child;
+};
+
+static Ttk_TemplateNode *Ttk_NewTemplateNode(const char *name, unsigned flags)
+{
+ Ttk_TemplateNode *op = ckalloc(sizeof(*op));
+ op->name = ckalloc(strlen(name) + 1); strcpy(op->name, name);
+ op->flags = flags;
+ op->next = op->child = 0;
+ return op;
+}
+
+void Ttk_FreeLayoutTemplate(Ttk_LayoutTemplate op)
+{
+ while (op) {
+ Ttk_LayoutTemplate next = op->next;
+ Ttk_FreeLayoutTemplate(op->child);
+ ckfree(op->name);
+ ckfree(op);
+ op = next;
+ }
+}
+
+/* InstantiateLayout --
+ * Create a layout tree from a template.
+ */
+static Ttk_LayoutNode *
+Ttk_InstantiateLayout(Ttk_Theme theme, Ttk_TemplateNode *op)
+{
+ Ttk_ElementClass *elementClass = Ttk_GetElement(theme, op->name);
+ Ttk_LayoutNode *node = Ttk_NewLayoutNode(op->flags, elementClass);
+
+ if (op->next) {
+ node->next = Ttk_InstantiateLayout(theme,op->next);
+ }
+ if (op->child) {
+ node->child = Ttk_InstantiateLayout(theme,op->child);
+ }
+
+ return node;
+}
+
+/*
+ * Ttk_ParseLayoutTemplate --
+ * Convert a Tcl list into a layout template.
+ *
+ * Syntax:
+ * layoutSpec ::= { elementName ?-option value ...? }+
+ */
+
+/* NB: This must match bit definitions TTK_PACK_LEFT etc. */
+static const char *packSideStrings[] =
+ { "left", "right", "top", "bottom", NULL };
+
+Ttk_LayoutTemplate Ttk_ParseLayoutTemplate(Tcl_Interp *interp, Tcl_Obj *objPtr)
+{
+ enum { OP_SIDE, OP_STICKY, OP_EXPAND, OP_BORDER, OP_UNIT, OP_CHILDREN };
+ static const char *optStrings[] = {
+ "-side", "-sticky", "-expand", "-border", "-unit", "-children", 0 };
+
+ int i = 0, objc;
+ Tcl_Obj **objv;
+ Ttk_TemplateNode *head = 0, *tail = 0;
+
+ if (Tcl_ListObjGetElements(interp, objPtr, &objc, &objv) != TCL_OK)
+ return 0;
+
+ while (i < objc) {
+ const char *elementName = Tcl_GetString(objv[i]);
+ unsigned flags = 0x0, sticky = TTK_FILL_BOTH;
+ Tcl_Obj *childSpec = 0;
+
+ /*
+ * Parse options:
+ */
+ ++i;
+ while (i < objc) {
+ const char *optName = Tcl_GetString(objv[i]);
+ int option, value;
+
+ if (optName[0] != '-')
+ break;
+
+ if (Tcl_GetIndexFromObjStruct(interp, objv[i], optStrings,
+ sizeof(char *), "option", 0, &option)
+ != TCL_OK)
+ {
+ goto error;
+ }
+
+ if (++i >= objc) {
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "Missing value for option %s",
+ Tcl_GetString(objv[i-1])));
+ Tcl_SetErrorCode(interp, "TTK", "VALUE", "LAYOUT", NULL);
+ goto error;
+ }
+
+ switch (option) {
+ case OP_SIDE: /* <<NOTE-PACKSIDE>> */
+ if (Tcl_GetIndexFromObjStruct(interp, objv[i], packSideStrings,
+ sizeof(char *), "side", 0, &value) != TCL_OK)
+ {
+ goto error;
+ }
+ flags |= (TTK_PACK_LEFT << value);
+
+ break;
+ case OP_STICKY:
+ if (Ttk_GetStickyFromObj(interp,objv[i],&sticky) != TCL_OK)
+ goto error;
+ break;
+ case OP_EXPAND:
+ if (Tcl_GetBooleanFromObj(interp,objv[i],&value) != TCL_OK)
+ goto error;
+ if (value)
+ flags |= TTK_EXPAND;
+ break;
+ case OP_BORDER:
+ if (Tcl_GetBooleanFromObj(interp,objv[i],&value) != TCL_OK)
+ goto error;
+ if (value)
+ flags |= TTK_BORDER;
+ break;
+ case OP_UNIT:
+ if (Tcl_GetBooleanFromObj(interp,objv[i],&value) != TCL_OK)
+ goto error;
+ if (value)
+ flags |= TTK_UNIT;
+ break;
+ case OP_CHILDREN:
+ childSpec = objv[i];
+ break;
+ }
+ ++i;
+ }
+
+ /*
+ * Build new node:
+ */
+ if (tail) {
+ tail->next = Ttk_NewTemplateNode(elementName, flags | sticky);
+ tail = tail->next;
+ } else {
+ head = tail = Ttk_NewTemplateNode(elementName, flags | sticky);
+ }
+ if (childSpec) {
+ tail->child = Ttk_ParseLayoutTemplate(interp, childSpec);
+ if (!tail->child) {
+ goto error;
+ }
+ }
+ }
+
+ return head;
+
+error:
+ Ttk_FreeLayoutTemplate(head);
+ return 0;
+}
+
+/* Ttk_BuildLayoutTemplate --
+ * Build a layout template tree from a statically defined
+ * Ttk_LayoutSpec array.
+ */
+Ttk_LayoutTemplate Ttk_BuildLayoutTemplate(Ttk_LayoutSpec spec)
+{
+ Ttk_TemplateNode *first = 0, *last = 0;
+
+ for ( ; !(spec->opcode & _TTK_LAYOUT_END) ; ++spec) {
+ if (spec->elementName) {
+ Ttk_TemplateNode *node =
+ Ttk_NewTemplateNode(spec->elementName, spec->opcode);
+
+ if (last) {
+ last->next = node;
+ } else {
+ first = node;
+ }
+ last = node;
+ }
+
+ if (spec->opcode & _TTK_CHILDREN && last) {
+ int depth = 1;
+ last->child = Ttk_BuildLayoutTemplate(spec+1);
+
+ /* Skip to end of group:
+ */
+ while (depth) {
+ ++spec;
+ if (spec->opcode & _TTK_CHILDREN) {
+ ++depth;
+ }
+ if (spec->opcode & _TTK_LAYOUT_END) {
+ --depth;
+ }
+ }
+ }
+
+ } /* for */
+
+ return first;
+}
+
+void Ttk_RegisterLayouts(Ttk_Theme theme, Ttk_LayoutSpec spec)
+{
+ while (!(spec->opcode & _TTK_LAYOUT_END)) {
+ Ttk_LayoutTemplate layoutTemplate = Ttk_BuildLayoutTemplate(spec+1);
+ Ttk_RegisterLayoutTemplate(theme, spec->elementName, layoutTemplate);
+ do {
+ ++spec;
+ } while (!(spec->opcode & _TTK_LAYOUT));
+ }
+}
+
+Tcl_Obj *Ttk_UnparseLayoutTemplate(Ttk_TemplateNode *node)
+{
+ Tcl_Obj *result = Tcl_NewListObj(0,0);
+
+# define APPENDOBJ(obj) Tcl_ListObjAppendElement(NULL, result, obj)
+# define APPENDSTR(str) APPENDOBJ(Tcl_NewStringObj(str,-1))
+
+ while (node) {
+ unsigned flags = node->flags;
+
+ APPENDSTR(node->name);
+
+ /* Back-compute -side. <<NOTE-PACKSIDE>>
+ * @@@ NOTES: Ick.
+ */
+ if (flags & TTK_EXPAND) {
+ APPENDSTR("-expand");
+ APPENDSTR("1");
+ } else {
+ if (flags & _TTK_MASK_PACK) {
+ int side = 0;
+ unsigned sideFlags = flags & _TTK_MASK_PACK;
+
+ while (!(sideFlags & TTK_PACK_LEFT)) {
+ ++side;
+ sideFlags >>= 1;
+ }
+ APPENDSTR("-side");
+ APPENDSTR(packSideStrings[side]);
+ }
+ }
+
+ /*
+ * In Ttk_ParseLayoutTemplate, default -sticky is "nsew", so always
+ * include this even if no sticky bits are set.
+ */
+
+ APPENDSTR("-sticky");
+ APPENDOBJ(Ttk_NewStickyObj(flags & _TTK_MASK_STICK));
+
+ /* @@@ Check again: are these necessary? */
+ if (flags & TTK_BORDER) { APPENDSTR("-border"); APPENDSTR("1"); }
+ if (flags & TTK_UNIT) { APPENDSTR("-unit"); APPENDSTR("1"); }
+
+ if (node->child) {
+ APPENDSTR("-children");
+ APPENDOBJ(Ttk_UnparseLayoutTemplate(node->child));
+ }
+ node = node->next;
+ }
+
+# undef APPENDOBJ
+# undef APPENDSTR
+
+ return result;
+}
+
+/*------------------------------------------------------------------------
+ * +++ Layouts.
+ */
+struct Ttk_Layout_
+{
+ Ttk_Style style;
+ void *recordPtr;
+ Tk_OptionTable optionTable;
+ Tk_Window tkwin;
+ Ttk_LayoutNode *root;
+};
+
+static Ttk_Layout TTKNewLayout(
+ Ttk_Style style,
+ void *recordPtr,Tk_OptionTable optionTable, Tk_Window tkwin,
+ Ttk_LayoutNode *root)
+{
+ Ttk_Layout layout = ckalloc(sizeof(*layout));
+ layout->style = style;
+ layout->recordPtr = recordPtr;
+ layout->optionTable = optionTable;
+ layout->tkwin = tkwin;
+ layout->root = root;
+ return layout;
+}
+
+void Ttk_FreeLayout(Ttk_Layout layout)
+{
+ Ttk_FreeLayoutNode(layout->root);
+ ckfree(layout);
+}
+
+/*
+ * Ttk_CreateLayout --
+ * Create a layout from the specified theme and style name.
+ * Returns: New layout, 0 on error.
+ * Leaves an error message in interp's result if there is an error.
+ */
+Ttk_Layout Ttk_CreateLayout(
+ Tcl_Interp *interp, /* where to leave error messages */
+ Ttk_Theme themePtr,
+ const char *styleName,
+ void *recordPtr,
+ Tk_OptionTable optionTable,
+ Tk_Window tkwin)
+{
+ Ttk_Style style = Ttk_GetStyle(themePtr, styleName);
+ Ttk_LayoutTemplate layoutTemplate =
+ Ttk_FindLayoutTemplate(themePtr,styleName);
+ Ttk_ElementClass *bgelement = Ttk_GetElement(themePtr, "background");
+ Ttk_LayoutNode *bgnode;
+
+ if (!layoutTemplate) {
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "Layout %s not found", styleName));
+ Tcl_SetErrorCode(interp, "TTK", "LOOKUP", "LAYOUT", styleName, NULL);
+ return 0;
+ }
+
+ bgnode = Ttk_NewLayoutNode(TTK_FILL_BOTH, bgelement);
+ bgnode->next = Ttk_InstantiateLayout(themePtr, layoutTemplate);
+
+ return TTKNewLayout(style, recordPtr, optionTable, tkwin, bgnode);
+}
+
+/* Ttk_CreateSublayout --
+ * Creates a new sublayout.
+ *
+ * Sublayouts are used to draw subparts of a compound widget.
+ * They use the same Tk_Window, but a different option table
+ * and data record.
+ */
+Ttk_Layout
+Ttk_CreateSublayout(
+ Tcl_Interp *interp,
+ Ttk_Theme themePtr,
+ Ttk_Layout parentLayout,
+ const char *baseName,
+ Tk_OptionTable optionTable)
+{
+ Tcl_DString buf;
+ const char *styleName;
+ Ttk_Style style;
+ Ttk_LayoutTemplate layoutTemplate;
+
+ Tcl_DStringInit(&buf);
+ Tcl_DStringAppend(&buf, Ttk_StyleName(parentLayout->style), -1);
+ Tcl_DStringAppend(&buf, baseName, -1);
+ styleName = Tcl_DStringValue(&buf);
+
+ style = Ttk_GetStyle(themePtr, styleName);
+ layoutTemplate = Ttk_FindLayoutTemplate(themePtr, styleName);
+
+ if (!layoutTemplate) {
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "Layout %s not found", styleName));
+ Tcl_SetErrorCode(interp, "TTK", "LOOKUP", "LAYOUT", styleName, NULL);
+ return 0;
+ }
+
+ Tcl_DStringFree(&buf);
+
+ return TTKNewLayout(
+ style, 0, optionTable, parentLayout->tkwin,
+ Ttk_InstantiateLayout(themePtr, layoutTemplate));
+}
+
+/* Ttk_RebindSublayout --
+ * Bind sublayout to new data source.
+ */
+void Ttk_RebindSublayout(Ttk_Layout layout, void *recordPtr)
+{
+ layout->recordPtr = recordPtr;
+}
+
+/*
+ * Ttk_QueryOption --
+ * Look up an option from a layout's associated option.
+ */
+Tcl_Obj *Ttk_QueryOption(
+ Ttk_Layout layout, const char *optionName, Ttk_State state)
+{
+ return Ttk_QueryStyle(
+ layout->style,layout->recordPtr,layout->optionTable,optionName,state);
+}
+
+/*
+ * Ttk_LayoutStyle --
+ * Extract Ttk_Style from Ttk_Layout.
+ */
+Ttk_Style Ttk_LayoutStyle(Ttk_Layout layout)
+{
+ return layout->style;
+}
+
+/*------------------------------------------------------------------------
+ * +++ Size computation.
+ */
+static void Ttk_NodeListSize(
+ Ttk_Layout layout, Ttk_LayoutNode *node,
+ Ttk_State state, int *widthPtr, int *heightPtr); /* Forward */
+
+static void Ttk_NodeSize(
+ Ttk_Layout layout, Ttk_LayoutNode *node, Ttk_State state,
+ int *widthPtr, int *heightPtr, Ttk_Padding *paddingPtr)
+{
+ int elementWidth, elementHeight, subWidth, subHeight;
+ Ttk_Padding elementPadding;
+
+ Ttk_ElementSize(node->eclass,
+ layout->style, layout->recordPtr,layout->optionTable, layout->tkwin,
+ state|node->state,
+ &elementWidth, &elementHeight, &elementPadding);
+
+ Ttk_NodeListSize(layout,node->child,state,&subWidth,&subHeight);
+ subWidth += Ttk_PaddingWidth(elementPadding);
+ subHeight += Ttk_PaddingHeight(elementPadding);
+
+ *widthPtr = MAX(elementWidth, subWidth);
+ *heightPtr = MAX(elementHeight, subHeight);
+ *paddingPtr = elementPadding;
+}
+
+static void Ttk_NodeListSize(
+ Ttk_Layout layout, Ttk_LayoutNode *node,
+ Ttk_State state, int *widthPtr, int *heightPtr)
+{
+ if (!node) {
+ *widthPtr = *heightPtr = 0;
+ } else {
+ int width, height, restWidth, restHeight;
+ Ttk_Padding unused;
+
+ Ttk_NodeSize(layout, node, state, &width, &height, &unused);
+ Ttk_NodeListSize(layout, node->next, state, &restWidth, &restHeight);
+
+ if (node->flags & (TTK_PACK_LEFT|TTK_PACK_RIGHT)) {
+ *widthPtr = width + restWidth;
+ } else {
+ *widthPtr = MAX(width, restWidth);
+ }
+
+ if (node->flags & (TTK_PACK_TOP|TTK_PACK_BOTTOM)) {
+ *heightPtr = height + restHeight;
+ } else {
+ *heightPtr = MAX(height, restHeight);
+ }
+ }
+}
+
+/*
+ * Ttk_LayoutNodeInternalPadding --
+ * Returns the internal padding of a layout node.
+ */
+Ttk_Padding Ttk_LayoutNodeInternalPadding(
+ Ttk_Layout layout, Ttk_LayoutNode *node)
+{
+ int unused;
+ Ttk_Padding padding;
+ Ttk_ElementSize(node->eclass,
+ layout->style, layout->recordPtr, layout->optionTable, layout->tkwin,
+ 0/*state*/, &unused, &unused, &padding);
+ return padding;
+}
+
+/*
+ * Ttk_LayoutNodeInternalParcel --
+ * Returns the inner area of a specified layout node,
+ * based on current parcel and element's internal padding.
+ */
+Ttk_Box Ttk_LayoutNodeInternalParcel(Ttk_Layout layout, Ttk_LayoutNode *node)
+{
+ Ttk_Padding padding = Ttk_LayoutNodeInternalPadding(layout, node);
+ return Ttk_PadBox(node->parcel, padding);
+}
+
+/* Ttk_LayoutSize --
+ * Compute requested size of a layout.
+ */
+void Ttk_LayoutSize(
+ Ttk_Layout layout, Ttk_State state, int *widthPtr, int *heightPtr)
+{
+ Ttk_NodeListSize(layout, layout->root, state, widthPtr, heightPtr);
+}
+
+void Ttk_LayoutNodeReqSize( /* @@@ Rename this */
+ Ttk_Layout layout, Ttk_LayoutNode *node, int *widthPtr, int *heightPtr)
+{
+ Ttk_Padding unused;
+ Ttk_NodeSize(layout, node, 0/*state*/, widthPtr, heightPtr, &unused);
+}
+
+/*------------------------------------------------------------------------
+ * +++ Layout placement.
+ */
+
+/* Ttk_PlaceNodeList --
+ * Compute parcel for each node in a layout tree
+ * according to position specification and overall size.
+ */
+static void Ttk_PlaceNodeList(
+ Ttk_Layout layout, Ttk_LayoutNode *node, Ttk_State state, Ttk_Box cavity)
+{
+ for (; node; node = node->next)
+ {
+ int width, height;
+ Ttk_Padding padding;
+
+ /* Compute node size: (@@@ cache this instead?)
+ */
+ Ttk_NodeSize(layout, node, state, &width, &height, &padding);
+
+ /* Compute parcel:
+ */
+ node->parcel = Ttk_PositionBox(&cavity, width, height, node->flags);
+
+ /* Place child nodes:
+ */
+ if (node->child) {
+ Ttk_Box childBox = Ttk_PadBox(node->parcel, padding);
+ Ttk_PlaceNodeList(layout,node->child, state, childBox);
+ }
+ }
+}
+
+void Ttk_PlaceLayout(Ttk_Layout layout, Ttk_State state, Ttk_Box b)
+{
+ Ttk_PlaceNodeList(layout, layout->root, state, b);
+}
+
+/*------------------------------------------------------------------------
+ * +++ Layout drawing.
+ */
+
+/*
+ * Ttk_DrawLayout --
+ * Draw a layout tree.
+ */
+static void Ttk_DrawNodeList(
+ Ttk_Layout layout, Ttk_State state, Ttk_LayoutNode *node, Drawable d)
+{
+ for (; node; node = node->next)
+ {
+ int border = node->flags & TTK_BORDER;
+ int substate = state;
+
+ if (node->flags & TTK_UNIT)
+ substate |= node->state;
+
+ if (node->child && border)
+ Ttk_DrawNodeList(layout, substate, node->child, d);
+
+ Ttk_DrawElement(
+ node->eclass,
+ layout->style,layout->recordPtr,layout->optionTable,layout->tkwin,
+ d, node->parcel, state | node->state);
+
+ if (node->child && !border)
+ Ttk_DrawNodeList(layout, substate, node->child, d);
+ }
+}
+
+void Ttk_DrawLayout(Ttk_Layout layout, Ttk_State state, Drawable d)
+{
+ Ttk_DrawNodeList(layout, state, layout->root, d);
+}
+
+/*------------------------------------------------------------------------
+ * +++ Inquiry and modification.
+ */
+
+/*
+ * Ttk_IdentifyElement --
+ * Find the element at the specified x,y coordinate.
+ */
+static Ttk_Element IdentifyNode(Ttk_Element node, int x, int y)
+{
+ Ttk_Element closest = NULL;
+
+ for (; node; node = node->next) {
+ if (Ttk_BoxContains(node->parcel, x, y)) {
+ closest = node;
+ if (node->child && !(node->flags & TTK_UNIT)) {
+ Ttk_Element childNode = IdentifyNode(node->child, x,y);
+ if (childNode) {
+ closest = childNode;
+ }
+ }
+ }
+ }
+ return closest;
+}
+
+Ttk_Element Ttk_IdentifyElement(Ttk_Layout layout, int x, int y)
+{
+ return IdentifyNode(layout->root, x, y);
+}
+
+/*
+ * tail --
+ * Return the last component of an element name, e.g.,
+ * "Scrollbar.thumb" => "thumb"
+ */
+static const char *tail(const char *elementName)
+{
+ const char *dot;
+ while ((dot=strchr(elementName,'.')) != NULL)
+ elementName = dot + 1;
+ return elementName;
+}
+
+/*
+ * Ttk_FindElement --
+ * Look up an element by name
+ */
+static Ttk_Element
+FindNode(Ttk_Element node, const char *nodeName)
+{
+ for (; node ; node = node->next) {
+ if (!strcmp(tail(Ttk_ElementName(node)), nodeName))
+ return node;
+
+ if (node->child) {
+ Ttk_Element childNode = FindNode(node->child, nodeName);
+ if (childNode)
+ return childNode;
+ }
+ }
+ return 0;
+}
+
+Ttk_Element Ttk_FindElement(Ttk_Layout layout, const char *nodeName)
+{
+ return FindNode(layout->root, nodeName);
+}
+
+/*
+ * Ttk_ClientRegion --
+ * Find the internal parcel of a named element within a given layout.
+ * If the element is not present, use the entire window.
+ */
+Ttk_Box Ttk_ClientRegion(Ttk_Layout layout, const char *elementName)
+{
+ Ttk_Element element = Ttk_FindElement(layout, elementName);
+ return element
+ ? Ttk_LayoutNodeInternalParcel(layout, element)
+ : Ttk_WinBox(layout->tkwin)
+ ;
+}
+
+/*
+ * Ttk_ElementName --
+ * Return the name (class name) of the element.
+ */
+const char *Ttk_ElementName(Ttk_Element node)
+{
+ return Ttk_ElementClassName(node->eclass);
+}
+
+/*
+ * Ttk_ElementParcel --
+ * Return the element's current parcel.
+ */
+Ttk_Box Ttk_ElementParcel(Ttk_Element node)
+{
+ return node->parcel;
+}
+
+/*
+ * Ttk_PlaceElement --
+ * Explicitly specify an element's parcel.
+ */
+void Ttk_PlaceElement(Ttk_Layout layout, Ttk_Element node, Ttk_Box b)
+{
+ node->parcel = b;
+ if (node->child) {
+ Ttk_PlaceNodeList(layout, node->child, 0,
+ Ttk_PadBox(b, Ttk_LayoutNodeInternalPadding(layout, node)));
+ }
+}
+
+/*
+ * Ttk_ChangeElementState --
+ */
+void Ttk_ChangeElementState(Ttk_LayoutNode *node,unsigned set,unsigned clr)
+{
+ node->state = (node->state | set) & ~clr;
+}
+
+/*EOF*/
diff --git a/tk8.6/generic/ttk/ttkManager.c b/tk8.6/generic/ttk/ttkManager.c
new file mode 100644
index 0000000..24a0fb1
--- /dev/null
+++ b/tk8.6/generic/ttk/ttkManager.c
@@ -0,0 +1,549 @@
+/*
+ * Copyright 2005, Joe English. Freely redistributable.
+ *
+ * Support routines for geometry managers.
+ */
+
+#include <string.h>
+#include <tk.h>
+#include "ttkManager.h"
+
+/*------------------------------------------------------------------------
+ * +++ The Geometry Propagation Dance.
+ *
+ * When a slave window requests a new size or some other parameter changes,
+ * the manager recomputes the required size for the master window and calls
+ * Tk_GeometryRequest(). This is scheduled as an idle handler so multiple
+ * updates can be processed as a single batch.
+ *
+ * If all goes well, the master's manager will process the request
+ * (and so on up the chain to the toplevel window), and the master
+ * window will eventually receive a <Configure> event. At this point
+ * it recomputes the size and position of all slaves and places them.
+ *
+ * If all does not go well, however, the master's request may be ignored
+ * (typically because the top-level window has a fixed, user-specified size).
+ * Tk doesn't provide any notification when this happens; to account for this,
+ * we also schedule an idle handler to call the layout procedure
+ * after making a geometry request.
+ *
+ * +++ Slave removal <<NOTE-LOSTSLAVE>>.
+ *
+ * There are three conditions under which a slave is removed:
+ *
+ * (1) Another GM claims control
+ * (2) Manager voluntarily relinquishes control
+ * (3) Slave is destroyed
+ *
+ * In case (1), Tk calls the manager's lostSlaveProc.
+ * Case (2) is performed by calling Tk_ManageGeometry(slave,NULL,0);
+ * in this case Tk does _not_ call the LostSlaveProc (documented behavior).
+ * Tk doesn't handle case (3) either; to account for that we
+ * register an event handler on the slave widget to track <Destroy> events.
+ */
+
+/* ++ Data structures.
+ */
+typedef struct
+{
+ Tk_Window slaveWindow;
+ Ttk_Manager *manager;
+ void *slaveData;
+ unsigned flags;
+} Ttk_Slave;
+
+/* slave->flags bits:
+ */
+#define SLAVE_MAPPED 0x1 /* slave to be mapped when master is */
+
+struct TtkManager_
+{
+ Ttk_ManagerSpec *managerSpec;
+ void *managerData;
+ Tk_Window masterWindow;
+ unsigned flags;
+ int nSlaves;
+ Ttk_Slave **slaves;
+};
+
+/* manager->flags bits:
+ */
+#define MGR_UPDATE_PENDING 0x1
+#define MGR_RESIZE_REQUIRED 0x2
+#define MGR_RELAYOUT_REQUIRED 0x4
+
+static void ManagerIdleProc(void *); /* forward */
+
+/* ++ ScheduleUpdate --
+ * Schedule a call to recompute the size and/or layout,
+ * depending on flags.
+ */
+static void ScheduleUpdate(Ttk_Manager *mgr, unsigned flags)
+{
+ if (!(mgr->flags & MGR_UPDATE_PENDING)) {
+ Tcl_DoWhenIdle(ManagerIdleProc, mgr);
+ mgr->flags |= MGR_UPDATE_PENDING;
+ }
+ mgr->flags |= flags;
+}
+
+/* ++ RecomputeSize --
+ * Recomputes the required size of the master window,
+ * makes geometry request.
+ */
+static void RecomputeSize(Ttk_Manager *mgr)
+{
+ int width = 1, height = 1;
+
+ if (mgr->managerSpec->RequestedSize(mgr->managerData, &width, &height)) {
+ Tk_GeometryRequest(mgr->masterWindow, width, height);
+ ScheduleUpdate(mgr, MGR_RELAYOUT_REQUIRED);
+ }
+ mgr->flags &= ~MGR_RESIZE_REQUIRED;
+}
+
+/* ++ RecomputeLayout --
+ * Recompute geometry of all slaves.
+ */
+static void RecomputeLayout(Ttk_Manager *mgr)
+{
+ mgr->managerSpec->PlaceSlaves(mgr->managerData);
+ mgr->flags &= ~MGR_RELAYOUT_REQUIRED;
+}
+
+/* ++ ManagerIdleProc --
+ * DoWhenIdle procedure for deferred updates.
+ */
+static void ManagerIdleProc(ClientData clientData)
+{
+ Ttk_Manager *mgr = clientData;
+ mgr->flags &= ~MGR_UPDATE_PENDING;
+
+ if (mgr->flags & MGR_RESIZE_REQUIRED) {
+ RecomputeSize(mgr);
+ }
+ if (mgr->flags & MGR_RELAYOUT_REQUIRED) {
+ if (mgr->flags & MGR_UPDATE_PENDING) {
+ /* RecomputeSize has scheduled another update; relayout later */
+ return;
+ }
+ RecomputeLayout(mgr);
+ }
+}
+
+/*------------------------------------------------------------------------
+ * +++ Event handlers.
+ */
+
+/* ++ ManagerEventHandler --
+ * Recompute slave layout when master widget is resized.
+ * Keep the slave's map state in sync with the master's.
+ */
+static const int ManagerEventMask = StructureNotifyMask;
+static void ManagerEventHandler(ClientData clientData, XEvent *eventPtr)
+{
+ Ttk_Manager *mgr = clientData;
+ int i;
+
+ switch (eventPtr->type)
+ {
+ case ConfigureNotify:
+ RecomputeLayout(mgr);
+ break;
+ case MapNotify:
+ for (i = 0; i < mgr->nSlaves; ++i) {
+ Ttk_Slave *slave = mgr->slaves[i];
+ if (slave->flags & SLAVE_MAPPED) {
+ Tk_MapWindow(slave->slaveWindow);
+ }
+ }
+ break;
+ case UnmapNotify:
+ for (i = 0; i < mgr->nSlaves; ++i) {
+ Ttk_Slave *slave = mgr->slaves[i];
+ Tk_UnmapWindow(slave->slaveWindow);
+ }
+ break;
+ }
+}
+
+/* ++ SlaveEventHandler --
+ * Notifies manager when a slave is destroyed
+ * (see <<NOTE-LOSTSLAVE>>).
+ */
+static const unsigned SlaveEventMask = StructureNotifyMask;
+static void SlaveEventHandler(ClientData clientData, XEvent *eventPtr)
+{
+ Ttk_Slave *slave = clientData;
+ if (eventPtr->type == DestroyNotify) {
+ slave->manager->managerSpec->tkGeomMgr.lostSlaveProc(
+ slave->manager, slave->slaveWindow);
+ }
+}
+
+/*------------------------------------------------------------------------
+ * +++ Slave initialization and cleanup.
+ */
+
+static Ttk_Slave *NewSlave(
+ Ttk_Manager *mgr, Tk_Window slaveWindow, void *slaveData)
+{
+ Ttk_Slave *slave = ckalloc(sizeof(*slave));
+
+ slave->slaveWindow = slaveWindow;
+ slave->manager = mgr;
+ slave->flags = 0;
+ slave->slaveData = slaveData;
+
+ return slave;
+}
+
+static void DeleteSlave(Ttk_Slave *slave)
+{
+ ckfree(slave);
+}
+
+/*------------------------------------------------------------------------
+ * +++ Manager initialization and cleanup.
+ */
+
+Ttk_Manager *Ttk_CreateManager(
+ Ttk_ManagerSpec *managerSpec, void *managerData, Tk_Window masterWindow)
+{
+ Ttk_Manager *mgr = ckalloc(sizeof(*mgr));
+
+ mgr->managerSpec = managerSpec;
+ mgr->managerData = managerData;
+ mgr->masterWindow = masterWindow;
+ mgr->nSlaves = 0;
+ mgr->slaves = NULL;
+ mgr->flags = 0;
+
+ Tk_CreateEventHandler(
+ mgr->masterWindow, ManagerEventMask, ManagerEventHandler, mgr);
+
+ return mgr;
+}
+
+void Ttk_DeleteManager(Ttk_Manager *mgr)
+{
+ Tk_DeleteEventHandler(
+ mgr->masterWindow, ManagerEventMask, ManagerEventHandler, mgr);
+
+ while (mgr->nSlaves > 0) {
+ Ttk_ForgetSlave(mgr, mgr->nSlaves - 1);
+ }
+ if (mgr->slaves) {
+ ckfree(mgr->slaves);
+ }
+
+ Tcl_CancelIdleCall(ManagerIdleProc, mgr);
+
+ ckfree(mgr);
+}
+
+/*------------------------------------------------------------------------
+ * +++ Slave management.
+ */
+
+/* ++ InsertSlave --
+ * Adds slave to the list of managed windows.
+ */
+static void InsertSlave(Ttk_Manager *mgr, Ttk_Slave *slave, int index)
+{
+ int endIndex = mgr->nSlaves++;
+ mgr->slaves = ckrealloc(mgr->slaves, mgr->nSlaves * sizeof(Ttk_Slave *));
+
+ while (endIndex > index) {
+ mgr->slaves[endIndex] = mgr->slaves[endIndex - 1];
+ --endIndex;
+ }
+
+ mgr->slaves[index] = slave;
+
+ Tk_ManageGeometry(slave->slaveWindow,
+ &mgr->managerSpec->tkGeomMgr, (ClientData)mgr);
+
+ Tk_CreateEventHandler(slave->slaveWindow,
+ SlaveEventMask, SlaveEventHandler, (ClientData)slave);
+
+ ScheduleUpdate(mgr, MGR_RESIZE_REQUIRED);
+}
+
+/* RemoveSlave --
+ * Unmanage and delete the slave.
+ *
+ * NOTES/ASSUMPTIONS:
+ *
+ * [1] It's safe to call Tk_UnmapWindow / Tk_UnmaintainGeometry even if this
+ * routine is called from the slave's DestroyNotify event handler.
+ */
+static void RemoveSlave(Ttk_Manager *mgr, int index)
+{
+ Ttk_Slave *slave = mgr->slaves[index];
+ int i;
+
+ /* Notify manager:
+ */
+ mgr->managerSpec->SlaveRemoved(mgr->managerData, index);
+
+ /* Remove from array:
+ */
+ --mgr->nSlaves;
+ for (i = index ; i < mgr->nSlaves; ++i) {
+ mgr->slaves[i] = mgr->slaves[i+1];
+ }
+
+ /* Clean up:
+ */
+ Tk_DeleteEventHandler(
+ slave->slaveWindow, SlaveEventMask, SlaveEventHandler, slave);
+
+ /* Note [1] */
+ Tk_UnmaintainGeometry(slave->slaveWindow, mgr->masterWindow);
+ Tk_UnmapWindow(slave->slaveWindow);
+
+ DeleteSlave(slave);
+
+ ScheduleUpdate(mgr, MGR_RESIZE_REQUIRED);
+}
+
+/*------------------------------------------------------------------------
+ * +++ Tk_GeomMgr hooks.
+ */
+
+void Ttk_GeometryRequestProc(ClientData clientData, Tk_Window slaveWindow)
+{
+ Ttk_Manager *mgr = clientData;
+ int slaveIndex = Ttk_SlaveIndex(mgr, slaveWindow);
+ int reqWidth = Tk_ReqWidth(slaveWindow);
+ int reqHeight= Tk_ReqHeight(slaveWindow);
+
+ if (mgr->managerSpec->SlaveRequest(
+ mgr->managerData, slaveIndex, reqWidth, reqHeight))
+ {
+ ScheduleUpdate(mgr, MGR_RESIZE_REQUIRED);
+ }
+}
+
+void Ttk_LostSlaveProc(ClientData clientData, Tk_Window slaveWindow)
+{
+ Ttk_Manager *mgr = clientData;
+ int index = Ttk_SlaveIndex(mgr, slaveWindow);
+
+ /* ASSERT: index >= 0 */
+ RemoveSlave(mgr, index);
+}
+
+/*------------------------------------------------------------------------
+ * +++ Public API.
+ */
+
+/* ++ Ttk_InsertSlave --
+ * Add a new slave window at the specified index.
+ */
+void Ttk_InsertSlave(
+ Ttk_Manager *mgr, int index, Tk_Window tkwin, void *slaveData)
+{
+ Ttk_Slave *slave = NewSlave(mgr, tkwin, slaveData);
+ InsertSlave(mgr, slave, index);
+}
+
+/* ++ Ttk_ForgetSlave --
+ * Unmanage the specified slave.
+ */
+void Ttk_ForgetSlave(Ttk_Manager *mgr, int slaveIndex)
+{
+ Tk_Window slaveWindow = mgr->slaves[slaveIndex]->slaveWindow;
+ RemoveSlave(mgr, slaveIndex);
+ Tk_ManageGeometry(slaveWindow, NULL, 0);
+}
+
+/* ++ Ttk_PlaceSlave --
+ * Set the position and size of the specified slave window.
+ *
+ * NOTES:
+ * Contrary to documentation, Tk_MaintainGeometry doesn't always
+ * map the slave.
+ */
+void Ttk_PlaceSlave(
+ Ttk_Manager *mgr, int slaveIndex, int x, int y, int width, int height)
+{
+ Ttk_Slave *slave = mgr->slaves[slaveIndex];
+ Tk_MaintainGeometry(slave->slaveWindow,mgr->masterWindow,x,y,width,height);
+ slave->flags |= SLAVE_MAPPED;
+ if (Tk_IsMapped(mgr->masterWindow)) {
+ Tk_MapWindow(slave->slaveWindow);
+ }
+}
+
+/* ++ Ttk_UnmapSlave --
+ * Unmap the specified slave, but leave it managed.
+ */
+void Ttk_UnmapSlave(Ttk_Manager *mgr, int slaveIndex)
+{
+ Ttk_Slave *slave = mgr->slaves[slaveIndex];
+ Tk_UnmaintainGeometry(slave->slaveWindow, mgr->masterWindow);
+ slave->flags &= ~SLAVE_MAPPED;
+ /* Contrary to documentation, Tk_UnmaintainGeometry doesn't always
+ * unmap the slave:
+ */
+ Tk_UnmapWindow(slave->slaveWindow);
+}
+
+/* LayoutChanged, SizeChanged --
+ * Schedule a relayout, resp. resize request.
+ */
+void Ttk_ManagerLayoutChanged(Ttk_Manager *mgr)
+{
+ ScheduleUpdate(mgr, MGR_RELAYOUT_REQUIRED);
+}
+
+void Ttk_ManagerSizeChanged(Ttk_Manager *mgr)
+{
+ ScheduleUpdate(mgr, MGR_RESIZE_REQUIRED);
+}
+
+/* +++ Accessors.
+ */
+int Ttk_NumberSlaves(Ttk_Manager *mgr)
+{
+ return mgr->nSlaves;
+}
+void *Ttk_SlaveData(Ttk_Manager *mgr, int slaveIndex)
+{
+ return mgr->slaves[slaveIndex]->slaveData;
+}
+Tk_Window Ttk_SlaveWindow(Ttk_Manager *mgr, int slaveIndex)
+{
+ return mgr->slaves[slaveIndex]->slaveWindow;
+}
+
+/*------------------------------------------------------------------------
+ * +++ Utility routines.
+ */
+
+/* ++ Ttk_SlaveIndex --
+ * Returns the index of specified slave window, -1 if not found.
+ */
+int Ttk_SlaveIndex(Ttk_Manager *mgr, Tk_Window slaveWindow)
+{
+ int index;
+ for (index = 0; index < mgr->nSlaves; ++index)
+ if (mgr->slaves[index]->slaveWindow == slaveWindow)
+ return index;
+ return -1;
+}
+
+/* ++ Ttk_GetSlaveIndexFromObj(interp, mgr, objPtr, indexPtr) --
+ * Return the index of the slave specified by objPtr.
+ * Slaves may be specified as an integer index or
+ * as the name of the managed window.
+ *
+ * Returns:
+ * Standard Tcl completion code. Leaves an error message in case of error.
+ */
+
+int Ttk_GetSlaveIndexFromObj(
+ Tcl_Interp *interp, Ttk_Manager *mgr, Tcl_Obj *objPtr, int *indexPtr)
+{
+ const char *string = Tcl_GetString(objPtr);
+ int slaveIndex = 0;
+ Tk_Window tkwin;
+
+ /* Try interpreting as an integer first:
+ */
+ if (Tcl_GetIntFromObj(NULL, objPtr, &slaveIndex) == TCL_OK) {
+ if (slaveIndex < 0 || slaveIndex >= mgr->nSlaves) {
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "Slave index %d out of bounds", slaveIndex));
+ Tcl_SetErrorCode(interp, "TTK", "SLAVE", "INDEX", NULL);
+ return TCL_ERROR;
+ }
+ *indexPtr = slaveIndex;
+ return TCL_OK;
+ }
+
+ /* Try interpreting as a slave window name;
+ */
+ if ((*string == '.') &&
+ (tkwin = Tk_NameToWindow(interp, string, mgr->masterWindow))) {
+ slaveIndex = Ttk_SlaveIndex(mgr, tkwin);
+ if (slaveIndex < 0) {
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "%s is not managed by %s", string,
+ Tk_PathName(mgr->masterWindow)));
+ Tcl_SetErrorCode(interp, "TTK", "SLAVE", "MANAGER", NULL);
+ return TCL_ERROR;
+ }
+ *indexPtr = slaveIndex;
+ return TCL_OK;
+ }
+
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "Invalid slave specification %s", string));
+ Tcl_SetErrorCode(interp, "TTK", "SLAVE", "SPEC", NULL);
+ return TCL_ERROR;
+}
+
+/* ++ Ttk_ReorderSlave(mgr, fromIndex, toIndex) --
+ * Change slave order.
+ */
+void Ttk_ReorderSlave(Ttk_Manager *mgr, int fromIndex, int toIndex)
+{
+ Ttk_Slave *moved = mgr->slaves[fromIndex];
+
+ /* Shuffle down: */
+ while (fromIndex > toIndex) {
+ mgr->slaves[fromIndex] = mgr->slaves[fromIndex - 1];
+ --fromIndex;
+ }
+ /* Or, shuffle up: */
+ while (fromIndex < toIndex) {
+ mgr->slaves[fromIndex] = mgr->slaves[fromIndex + 1];
+ ++fromIndex;
+ }
+ /* ASSERT: fromIndex == toIndex */
+ mgr->slaves[fromIndex] = moved;
+
+ /* Schedule a relayout. In general, rearranging slaves
+ * may also change the size:
+ */
+ ScheduleUpdate(mgr, MGR_RESIZE_REQUIRED);
+}
+
+/* ++ Ttk_Maintainable(interp, slave, master) --
+ * Utility routine. Verifies that 'master' may be used to maintain
+ * the geometry of 'slave' via Tk_MaintainGeometry:
+ *
+ * + 'master' is either 'slave's parent -OR-
+ * + 'master is a descendant of 'slave's parent.
+ * + 'slave' is not a toplevel window
+ * + 'slave' belongs to the same toplevel as 'master'
+ *
+ * Returns: 1 if OK; otherwise 0, leaving an error message in 'interp'.
+ */
+int Ttk_Maintainable(Tcl_Interp *interp, Tk_Window slave, Tk_Window master)
+{
+ Tk_Window ancestor = master, parent = Tk_Parent(slave);
+
+ if (Tk_IsTopLevel(slave) || slave == master) {
+ goto badWindow;
+ }
+
+ while (ancestor != parent) {
+ if (Tk_IsTopLevel(ancestor)) {
+ goto badWindow;
+ }
+ ancestor = Tk_Parent(ancestor);
+ }
+
+ return 1;
+
+badWindow:
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf("can't add %s as slave of %s",
+ Tk_PathName(slave), Tk_PathName(master)));
+ Tcl_SetErrorCode(interp, "TTK", "GEOMETRY", "MAINTAINABLE", NULL);
+ return 0;
+}
+
diff --git a/tk8.6/generic/ttk/ttkManager.h b/tk8.6/generic/ttk/ttkManager.h
new file mode 100644
index 0000000..d22ff98
--- /dev/null
+++ b/tk8.6/generic/ttk/ttkManager.h
@@ -0,0 +1,92 @@
+/*
+ * Copyright (c) 2005, Joe English. Freely redistributable.
+ *
+ * Geometry manager utilities.
+ */
+
+#ifndef _TTKMANAGER
+#define _TTKMANAGER
+
+#include "ttkTheme.h"
+
+typedef struct TtkManager_ Ttk_Manager;
+
+/*
+ * Geometry manager specification record:
+ *
+ * RequestedSize computes the requested size of the master window.
+ *
+ * PlaceSlaves sets the position and size of all managed slaves
+ * by calling Ttk_PlaceSlave().
+ *
+ * SlaveRemoved() is called immediately before a slave is removed.
+ * NB: the associated slave window may have been destroyed when this
+ * routine is called.
+ *
+ * SlaveRequest() is called when a slave requests a size change.
+ * It should return 1 if the request should propagate, 0 otherwise.
+ */
+typedef struct { /* Manager hooks */
+ Tk_GeomMgr tkGeomMgr; /* "real" Tk Geometry Manager */
+
+ int (*RequestedSize)(void *managerData, int *widthPtr, int *heightPtr);
+ void (*PlaceSlaves)(void *managerData);
+ int (*SlaveRequest)(void *managerData, int slaveIndex, int w, int h);
+ void (*SlaveRemoved)(void *managerData, int slaveIndex);
+} Ttk_ManagerSpec;
+
+/*
+ * Default implementations for Tk_GeomMgr hooks:
+ */
+MODULE_SCOPE void Ttk_GeometryRequestProc(ClientData, Tk_Window slave);
+MODULE_SCOPE void Ttk_LostSlaveProc(ClientData, Tk_Window slave);
+
+/*
+ * Public API:
+ */
+MODULE_SCOPE Ttk_Manager *Ttk_CreateManager(
+ Ttk_ManagerSpec *, void *managerData, Tk_Window masterWindow);
+MODULE_SCOPE void Ttk_DeleteManager(Ttk_Manager *);
+
+MODULE_SCOPE void Ttk_InsertSlave(
+ Ttk_Manager *, int position, Tk_Window, void *slaveData);
+
+MODULE_SCOPE void Ttk_ForgetSlave(Ttk_Manager *, int slaveIndex);
+
+MODULE_SCOPE void Ttk_ReorderSlave(Ttk_Manager *, int fromIndex, int toIndex);
+ /* Rearrange slave positions */
+
+MODULE_SCOPE void Ttk_PlaceSlave(
+ Ttk_Manager *, int slaveIndex, int x, int y, int width, int height);
+ /* Position and map the slave */
+
+MODULE_SCOPE void Ttk_UnmapSlave(Ttk_Manager *, int slaveIndex);
+ /* Unmap the slave */
+
+MODULE_SCOPE void Ttk_ManagerSizeChanged(Ttk_Manager *);
+MODULE_SCOPE void Ttk_ManagerLayoutChanged(Ttk_Manager *);
+ /* Notify manager that size (resp. layout) needs to be recomputed */
+
+/* Utilities:
+ */
+MODULE_SCOPE int Ttk_SlaveIndex(Ttk_Manager *, Tk_Window);
+ /* Returns: index in slave array of specified window, -1 if not found */
+
+MODULE_SCOPE int Ttk_GetSlaveIndexFromObj(
+ Tcl_Interp *, Ttk_Manager *, Tcl_Obj *, int *indexPtr);
+
+/* Accessor functions:
+ */
+MODULE_SCOPE int Ttk_NumberSlaves(Ttk_Manager *);
+ /* Returns: number of managed slaves */
+
+MODULE_SCOPE void *Ttk_SlaveData(Ttk_Manager *, int slaveIndex);
+ /* Returns: client data associated with slave */
+
+MODULE_SCOPE Tk_Window Ttk_SlaveWindow(Ttk_Manager *, int slaveIndex);
+ /* Returns: slave window */
+
+MODULE_SCOPE int Ttk_Maintainable(Tcl_Interp *, Tk_Window slave, Tk_Window master);
+ /* Returns: 1 if master can manage slave; 0 otherwise leaving error msg */
+
+#endif /* _TTKMANAGER */
diff --git a/tk8.6/generic/ttk/ttkNotebook.c b/tk8.6/generic/ttk/ttkNotebook.c
new file mode 100644
index 0000000..81a8b64
--- /dev/null
+++ b/tk8.6/generic/ttk/ttkNotebook.c
@@ -0,0 +1,1412 @@
+/*
+ * Copyright (c) 2004, Joe English
+ */
+
+#include <string.h>
+#include <ctype.h>
+#include <stdio.h>
+#include <tk.h>
+
+#include "ttkTheme.h"
+#include "ttkWidget.h"
+#include "ttkManager.h"
+
+#define MIN(a,b) ((a) < (b) ? (a) : (b))
+#define MAX(a,b) ((a) > (b) ? (a) : (b))
+
+/*------------------------------------------------------------------------
+ * +++ Tab resources.
+ */
+
+#define DEFAULT_MIN_TAB_WIDTH 24
+
+static const char *const TabStateStrings[] = { "normal", "disabled", "hidden", 0 };
+typedef enum {
+ TAB_STATE_NORMAL, TAB_STATE_DISABLED, TAB_STATE_HIDDEN
+} TAB_STATE;
+
+typedef struct
+{
+ /* Internal data:
+ */
+ int width, height; /* Requested size of tab */
+ Ttk_Box parcel; /* Tab position */
+
+ /* Tab options:
+ */
+ TAB_STATE state;
+
+ /* Child window options:
+ */
+ Tcl_Obj *paddingObj; /* Padding inside pane */
+ Ttk_Padding padding;
+ Tcl_Obj *stickyObj;
+ Ttk_Sticky sticky;
+
+ /* Label options:
+ */
+ Tcl_Obj *textObj;
+ Tcl_Obj *imageObj;
+ Tcl_Obj *compoundObj;
+ Tcl_Obj *underlineObj;
+
+} Tab;
+
+/* Two different option tables are used for tabs:
+ * TabOptionSpecs is used to draw the tab, and only includes resources
+ * relevant to the tab.
+ *
+ * PaneOptionSpecs includes additional options for child window placement
+ * and is used to configure the slave.
+ */
+static Tk_OptionSpec TabOptionSpecs[] =
+{
+ {TK_OPTION_STRING_TABLE, "-state", "", "",
+ "normal", -1,Tk_Offset(Tab,state),
+ 0,(ClientData)TabStateStrings,0 },
+ {TK_OPTION_STRING, "-text", "text", "Text", "",
+ Tk_Offset(Tab,textObj), -1, 0,0,GEOMETRY_CHANGED },
+ {TK_OPTION_STRING, "-image", "image", "Image", NULL/*default*/,
+ Tk_Offset(Tab,imageObj), -1, TK_OPTION_NULL_OK,0,GEOMETRY_CHANGED },
+ {TK_OPTION_STRING_TABLE, "-compound", "compound", "Compound",
+ "none", Tk_Offset(Tab,compoundObj), -1,
+ 0,(ClientData)ttkCompoundStrings,GEOMETRY_CHANGED },
+ {TK_OPTION_INT, "-underline", "underline", "Underline", "-1",
+ Tk_Offset(Tab,underlineObj), -1, 0,0,GEOMETRY_CHANGED },
+ {TK_OPTION_END, NULL, NULL, NULL, NULL, 0, 0, 0, 0, 0 }
+};
+
+static Tk_OptionSpec PaneOptionSpecs[] =
+{
+ {TK_OPTION_STRING, "-padding", "padding", "Padding", "0",
+ Tk_Offset(Tab,paddingObj), -1, 0,0,GEOMETRY_CHANGED },
+ {TK_OPTION_STRING, "-sticky", "sticky", "Sticky", "nsew",
+ Tk_Offset(Tab,stickyObj), -1, 0,0,GEOMETRY_CHANGED },
+
+ WIDGET_INHERIT_OPTIONS(TabOptionSpecs)
+};
+
+/*------------------------------------------------------------------------
+ * +++ Notebook resources.
+ */
+typedef struct
+{
+ Tcl_Obj *widthObj; /* Default width */
+ Tcl_Obj *heightObj; /* Default height */
+ Tcl_Obj *paddingObj; /* Padding around notebook */
+
+ Ttk_Manager *mgr; /* Geometry manager */
+ Tk_OptionTable tabOptionTable; /* Tab options */
+ Tk_OptionTable paneOptionTable; /* Tab+pane options */
+ int currentIndex; /* index of currently selected tab */
+ int activeIndex; /* index of currently active tab */
+ Ttk_Layout tabLayout; /* Sublayout for tabs */
+
+ Ttk_Box clientArea; /* Where to pack slave widgets */
+} NotebookPart;
+
+typedef struct
+{
+ WidgetCore core;
+ NotebookPart notebook;
+} Notebook;
+
+static Tk_OptionSpec NotebookOptionSpecs[] =
+{
+ {TK_OPTION_INT, "-width", "width", "Width", "0",
+ Tk_Offset(Notebook,notebook.widthObj),-1,
+ 0,0,GEOMETRY_CHANGED },
+ {TK_OPTION_INT, "-height", "height", "Height", "0",
+ Tk_Offset(Notebook,notebook.heightObj),-1,
+ 0,0,GEOMETRY_CHANGED },
+ {TK_OPTION_STRING, "-padding", "padding", "Padding", NULL,
+ Tk_Offset(Notebook,notebook.paddingObj),-1,
+ TK_OPTION_NULL_OK,0,GEOMETRY_CHANGED },
+
+ WIDGET_TAKEFOCUS_TRUE,
+ WIDGET_INHERIT_OPTIONS(ttkCoreOptionSpecs)
+};
+
+/* Notebook style options:
+ */
+typedef struct
+{
+ Ttk_PositionSpec tabPosition; /* Where to place tabs */
+ Ttk_Padding tabMargins; /* Margins around tab row */
+ Ttk_PositionSpec tabPlacement; /* How to pack tabs within tab row */
+ Ttk_Orient tabOrient; /* ... */
+ int minTabWidth; /* Minimum tab width */
+ Ttk_Padding padding; /* External padding */
+} NotebookStyle;
+
+static void NotebookStyleOptions(Notebook *nb, NotebookStyle *nbstyle)
+{
+ Tcl_Obj *objPtr;
+
+ nbstyle->tabPosition = TTK_PACK_TOP | TTK_STICK_W;
+ if ((objPtr = Ttk_QueryOption(nb->core.layout, "-tabposition", 0)) != 0) {
+ TtkGetLabelAnchorFromObj(NULL, objPtr, &nbstyle->tabPosition);
+ }
+
+ /* Guess default tabPlacement as function of tabPosition:
+ */
+ if (nbstyle->tabPosition & TTK_PACK_LEFT) {
+ nbstyle->tabPlacement = TTK_PACK_TOP | TTK_STICK_E;
+ } else if (nbstyle->tabPosition & TTK_PACK_RIGHT) {
+ nbstyle->tabPlacement = TTK_PACK_TOP | TTK_STICK_W;
+ } else if (nbstyle->tabPosition & TTK_PACK_BOTTOM) {
+ nbstyle->tabPlacement = TTK_PACK_LEFT | TTK_STICK_N;
+ } else { /* Assume TTK_PACK_TOP */
+ nbstyle->tabPlacement = TTK_PACK_LEFT | TTK_STICK_S;
+ }
+ if ((objPtr = Ttk_QueryOption(nb->core.layout, "-tabplacement", 0)) != 0) {
+ TtkGetLabelAnchorFromObj(NULL, objPtr, &nbstyle->tabPlacement);
+ }
+
+ /* Compute tabOrient as function of tabPlacement:
+ */
+ if (nbstyle->tabPlacement & (TTK_PACK_LEFT|TTK_PACK_RIGHT)) {
+ nbstyle->tabOrient = TTK_ORIENT_HORIZONTAL;
+ } else {
+ nbstyle->tabOrient = TTK_ORIENT_VERTICAL;
+ }
+
+ nbstyle->tabMargins = Ttk_UniformPadding(0);
+ if ((objPtr = Ttk_QueryOption(nb->core.layout, "-tabmargins", 0)) != 0) {
+ Ttk_GetBorderFromObj(NULL, objPtr, &nbstyle->tabMargins);
+ }
+
+ nbstyle->padding = Ttk_UniformPadding(0);
+ if ((objPtr = Ttk_QueryOption(nb->core.layout, "-padding", 0)) != 0) {
+ Ttk_GetPaddingFromObj(NULL,nb->core.tkwin,objPtr,&nbstyle->padding);
+ }
+
+ nbstyle->minTabWidth = DEFAULT_MIN_TAB_WIDTH;
+ if ((objPtr = Ttk_QueryOption(nb->core.layout, "-mintabwidth", 0)) != 0) {
+ Tcl_GetIntFromObj(NULL, objPtr, &nbstyle->minTabWidth);
+ }
+}
+
+/*------------------------------------------------------------------------
+ * +++ Tab management.
+ */
+
+static Tab *CreateTab(Tcl_Interp *interp, Notebook *nb, Tk_Window slaveWindow)
+{
+ Tk_OptionTable optionTable = nb->notebook.paneOptionTable;
+ void *record = ckalloc(sizeof(Tab));
+ memset(record, 0, sizeof(Tab));
+
+ if (Tk_InitOptions(interp, record, optionTable, slaveWindow) != TCL_OK) {
+ ckfree(record);
+ return NULL;
+ }
+
+ return record;
+}
+
+static void DestroyTab(Notebook *nb, Tab *tab)
+{
+ void *record = tab;
+ Tk_FreeConfigOptions(record, nb->notebook.paneOptionTable, nb->core.tkwin);
+ ckfree(record);
+}
+
+static int ConfigureTab(
+ Tcl_Interp *interp, Notebook *nb, Tab *tab, Tk_Window slaveWindow,
+ int objc, Tcl_Obj *const objv[])
+{
+ Ttk_Sticky sticky = tab->sticky;
+ Ttk_Padding padding = tab->padding;
+ Tk_SavedOptions savedOptions;
+ int mask = 0;
+
+ if (Tk_SetOptions(interp, (ClientData)tab, nb->notebook.paneOptionTable,
+ objc, objv, slaveWindow, &savedOptions, &mask) != TCL_OK)
+ {
+ return TCL_ERROR;
+ }
+
+ /* Check options:
+ * @@@ TODO: validate -image option.
+ */
+ if (Ttk_GetStickyFromObj(interp, tab->stickyObj, &sticky) != TCL_OK)
+ {
+ goto error;
+ }
+ if (Ttk_GetPaddingFromObj(interp, slaveWindow, tab->paddingObj, &padding)
+ != TCL_OK)
+ {
+ goto error;
+ }
+
+ tab->sticky = sticky;
+ tab->padding = padding;
+
+ Tk_FreeSavedOptions(&savedOptions);
+ Ttk_ManagerSizeChanged(nb->notebook.mgr);
+ TtkRedisplayWidget(&nb->core);
+
+ return TCL_OK;
+error:
+ Tk_RestoreSavedOptions(&savedOptions);
+ return TCL_ERROR;
+}
+
+/*
+ * IdentifyTab --
+ * Return the index of the tab at point x,y,
+ * or -1 if no tab at that point.
+ */
+static int IdentifyTab(Notebook *nb, int x, int y)
+{
+ int index;
+ for (index = 0; index < Ttk_NumberSlaves(nb->notebook.mgr); ++index) {
+ Tab *tab = Ttk_SlaveData(nb->notebook.mgr,index);
+ if ( tab->state != TAB_STATE_HIDDEN
+ && Ttk_BoxContains(tab->parcel, x,y))
+ {
+ return index;
+ }
+ }
+ return -1;
+}
+
+/*
+ * ActivateTab --
+ * Set the active tab index, redisplay if necessary.
+ */
+static void ActivateTab(Notebook *nb, int index)
+{
+ if (index != nb->notebook.activeIndex) {
+ nb->notebook.activeIndex = index;
+ TtkRedisplayWidget(&nb->core);
+ }
+}
+
+/*
+ * TabState --
+ * Return the state of the specified tab, based on
+ * notebook state, currentIndex, activeIndex, and user-specified tab state.
+ * The USER1 bit is set for the leftmost tab, and USER2
+ * is set for the rightmost tab.
+ */
+static Ttk_State TabState(Notebook *nb, int index)
+{
+ Ttk_State state = nb->core.state;
+ Tab *tab = Ttk_SlaveData(nb->notebook.mgr, index);
+
+ if (index == nb->notebook.currentIndex) {
+ state |= TTK_STATE_SELECTED;
+ } else {
+ state &= ~TTK_STATE_FOCUS;
+ }
+
+ if (index == nb->notebook.activeIndex) {
+ state |= TTK_STATE_ACTIVE;
+ }
+ if (index == 0) {
+ state |= TTK_STATE_USER1;
+ }
+ if (index == Ttk_NumberSlaves(nb->notebook.mgr) - 1) {
+ state |= TTK_STATE_USER2;
+ }
+ if (tab->state == TAB_STATE_DISABLED) {
+ state |= TTK_STATE_DISABLED;
+ }
+
+ return state;
+}
+
+/*------------------------------------------------------------------------
+ * +++ Geometry management - size computation.
+ */
+
+/* TabrowSize --
+ * Compute max height and total width of all tabs (horizontal layouts)
+ * or total height and max width (vertical layouts).
+ *
+ * Side effects:
+ * Sets width and height fields for all tabs.
+ *
+ * Notes:
+ * Hidden tabs are included in the perpendicular computation
+ * (max height/width) but not parallel (total width/height).
+ */
+static void TabrowSize(
+ Notebook *nb, Ttk_Orient orient, int *widthPtr, int *heightPtr)
+{
+ Ttk_Layout tabLayout = nb->notebook.tabLayout;
+ int tabrowWidth = 0, tabrowHeight = 0;
+ int i;
+
+ for (i = 0; i < Ttk_NumberSlaves(nb->notebook.mgr); ++i) {
+ Tab *tab = Ttk_SlaveData(nb->notebook.mgr, i);
+ Ttk_State tabState = TabState(nb,i);
+
+ Ttk_RebindSublayout(tabLayout, tab);
+ Ttk_LayoutSize(tabLayout,tabState,&tab->width,&tab->height);
+
+ if (orient == TTK_ORIENT_HORIZONTAL) {
+ tabrowHeight = MAX(tabrowHeight, tab->height);
+ if (tab->state != TAB_STATE_HIDDEN) { tabrowWidth += tab->width; }
+ } else {
+ tabrowWidth = MAX(tabrowWidth, tab->width);
+ if (tab->state != TAB_STATE_HIDDEN) { tabrowHeight += tab->height; }
+ }
+ }
+
+ *widthPtr = tabrowWidth;
+ *heightPtr = tabrowHeight;
+}
+
+/* NotebookSize -- GM and widget size hook.
+ *
+ * Total height is tab height + client area height + pane internal padding
+ * Total width is max(client width, tab width) + pane internal padding
+ * Client area size determined by max size of slaves,
+ * overridden by -width and/or -height if nonzero.
+ */
+
+static int NotebookSize(void *clientData, int *widthPtr, int *heightPtr)
+{
+ Notebook *nb = clientData;
+ NotebookStyle nbstyle;
+ Ttk_Padding padding;
+ Ttk_Element clientNode = Ttk_FindElement(nb->core.layout, "client");
+ int clientWidth = 0, clientHeight = 0,
+ reqWidth = 0, reqHeight = 0,
+ tabrowWidth = 0, tabrowHeight = 0;
+ int i;
+
+ NotebookStyleOptions(nb, &nbstyle);
+
+ /* Compute max requested size of all slaves:
+ */
+ for (i = 0; i < Ttk_NumberSlaves(nb->notebook.mgr); ++i) {
+ Tk_Window slaveWindow = Ttk_SlaveWindow(nb->notebook.mgr, i);
+ Tab *tab = Ttk_SlaveData(nb->notebook.mgr, i);
+ int slaveWidth
+ = Tk_ReqWidth(slaveWindow) + Ttk_PaddingWidth(tab->padding);
+ int slaveHeight
+ = Tk_ReqHeight(slaveWindow) + Ttk_PaddingHeight(tab->padding);
+
+ clientWidth = MAX(clientWidth, slaveWidth);
+ clientHeight = MAX(clientHeight, slaveHeight);
+ }
+
+ /* Client width/height overridable by widget options:
+ */
+ Tcl_GetIntFromObj(NULL, nb->notebook.widthObj,&reqWidth);
+ Tcl_GetIntFromObj(NULL, nb->notebook.heightObj,&reqHeight);
+ if (reqWidth > 0)
+ clientWidth = reqWidth;
+ if (reqHeight > 0)
+ clientHeight = reqHeight;
+
+ /* Tab row:
+ */
+ TabrowSize(nb, nbstyle.tabOrient, &tabrowWidth, &tabrowHeight);
+ tabrowHeight += Ttk_PaddingHeight(nbstyle.tabMargins);
+ tabrowWidth += Ttk_PaddingWidth(nbstyle.tabMargins);
+
+ /* Account for exterior and interior padding:
+ */
+ padding = nbstyle.padding;
+ if (clientNode) {
+ Ttk_Padding ipad =
+ Ttk_LayoutNodeInternalPadding(nb->core.layout, clientNode);
+ padding = Ttk_AddPadding(padding, ipad);
+ }
+
+ if (nbstyle.tabPosition & (TTK_PACK_TOP|TTK_PACK_BOTTOM)) {
+ *widthPtr = MAX(tabrowWidth, clientWidth) + Ttk_PaddingWidth(padding);
+ *heightPtr = tabrowHeight + clientHeight + Ttk_PaddingHeight(padding);
+ } else {
+ *widthPtr = tabrowWidth + clientWidth + Ttk_PaddingWidth(padding);
+ *heightPtr = MAX(tabrowHeight,clientHeight) + Ttk_PaddingHeight(padding);
+ }
+
+ return 1;
+}
+
+/*------------------------------------------------------------------------
+ * +++ Geometry management - layout.
+ */
+
+/* SqueezeTabs --
+ * Squeeze or stretch tabs to fit within the tab area parcel.
+ *
+ * All tabs are adjusted by an equal amount, but will not be made
+ * smaller than the minimum width. (If all the tabs still do
+ * not fit in the available space, the rightmost ones will
+ * be further squozen by PlaceTabs()).
+ *
+ * The algorithm does not always yield an optimal layout, but does
+ * have the important property that decreasing the available width
+ * by one pixel will cause at most one tab to shrink by one pixel;
+ * this means that tabs resize "smoothly" when the window shrinks
+ * and grows.
+ *
+ * @@@ <<NOTE-TABPOSITION>> bug: only works for horizontal orientations
+ * @@@ <<NOTE-SQUEEZE-HIDDEN>> does not account for hidden tabs.
+ */
+
+static void SqueezeTabs(
+ Notebook *nb, int needed, int available, int minTabWidth)
+{
+ int nTabs = Ttk_NumberSlaves(nb->notebook.mgr);
+
+ if (nTabs > 0) {
+ int difference = available - needed,
+ delta = difference / nTabs,
+ remainder = difference % nTabs,
+ slack = 0;
+ int i;
+
+ if (remainder < 0) { remainder += nTabs; --delta; }
+
+ for (i = 0; i < nTabs; ++i) {
+ Tab *tab = Ttk_SlaveData(nb->notebook.mgr,i);
+ int adj = delta + (i < remainder) + slack;
+
+ if (tab->width + adj >= minTabWidth) {
+ tab->width += adj;
+ slack = 0;
+ } else {
+ slack = adj - (minTabWidth - tab->width);
+ tab->width = minTabWidth;
+ }
+ }
+ }
+}
+
+/* PlaceTabs --
+ * Compute all tab parcels.
+ */
+static void PlaceTabs(
+ Notebook *nb, Ttk_Box tabrowBox, Ttk_PositionSpec tabPlacement)
+{
+ Ttk_Layout tabLayout = nb->notebook.tabLayout;
+ int nTabs = Ttk_NumberSlaves(nb->notebook.mgr);
+ int i;
+
+ for (i = 0; i < nTabs; ++i) {
+ Tab *tab = Ttk_SlaveData(nb->notebook.mgr, i);
+ Ttk_State tabState = TabState(nb, i);
+
+ if (tab->state != TAB_STATE_HIDDEN) {
+ Ttk_Padding expand = Ttk_UniformPadding(0);
+ Tcl_Obj *expandObj = Ttk_QueryOption(tabLayout,"-expand",tabState);
+
+ if (expandObj) {
+ Ttk_GetBorderFromObj(NULL, expandObj, &expand);
+ }
+
+ tab->parcel =
+ Ttk_ExpandBox(
+ Ttk_PositionBox(&tabrowBox,
+ tab->width, tab->height, tabPlacement),
+ expand);
+ }
+ }
+}
+
+/* NotebookDoLayout --
+ * Computes notebook layout and places tabs.
+ *
+ * Side effects:
+ * Sets clientArea, used to place slave panes.
+ */
+static void NotebookDoLayout(void *recordPtr)
+{
+ Notebook *nb = recordPtr;
+ Tk_Window nbwin = nb->core.tkwin;
+ Ttk_Box cavity = Ttk_WinBox(nbwin);
+ int tabrowWidth = 0, tabrowHeight = 0;
+ Ttk_Element clientNode = Ttk_FindElement(nb->core.layout, "client");
+ Ttk_Box tabrowBox;
+ NotebookStyle nbstyle;
+
+ NotebookStyleOptions(nb, &nbstyle);
+
+ /* Notebook internal padding:
+ */
+ cavity = Ttk_PadBox(cavity, nbstyle.padding);
+
+ /* Layout for notebook background (base layout):
+ */
+ Ttk_PlaceLayout(nb->core.layout, nb->core.state, Ttk_WinBox(nbwin));
+
+ /* Place tabs:
+ */
+ TabrowSize(nb, nbstyle.tabOrient, &tabrowWidth, &tabrowHeight);
+ tabrowBox = Ttk_PadBox(
+ Ttk_PositionBox(&cavity,
+ tabrowWidth + Ttk_PaddingWidth(nbstyle.tabMargins),
+ tabrowHeight + Ttk_PaddingHeight(nbstyle.tabMargins),
+ nbstyle.tabPosition),
+ nbstyle.tabMargins);
+
+ SqueezeTabs(nb, tabrowWidth, tabrowBox.width, nbstyle.minTabWidth);
+ PlaceTabs(nb, tabrowBox, nbstyle.tabPlacement);
+
+ /* Layout for client area frame:
+ */
+ if (clientNode) {
+ Ttk_PlaceElement(nb->core.layout, clientNode, cavity);
+ cavity = Ttk_LayoutNodeInternalParcel(nb->core.layout, clientNode);
+ }
+
+ if (cavity.height <= 0) cavity.height = 1;
+ if (cavity.width <= 0) cavity.width = 1;
+
+ nb->notebook.clientArea = cavity;
+}
+
+/*
+ * NotebookPlaceSlave --
+ * Set the position and size of a child widget
+ * based on the current client area and slave options:
+ */
+static void NotebookPlaceSlave(Notebook *nb, int slaveIndex)
+{
+ Tab *tab = Ttk_SlaveData(nb->notebook.mgr, slaveIndex);
+ Tk_Window slaveWindow = Ttk_SlaveWindow(nb->notebook.mgr, slaveIndex);
+ Ttk_Box slaveBox =
+ Ttk_StickBox(Ttk_PadBox(nb->notebook.clientArea, tab->padding),
+ Tk_ReqWidth(slaveWindow), Tk_ReqHeight(slaveWindow),tab->sticky);
+
+ Ttk_PlaceSlave(nb->notebook.mgr, slaveIndex,
+ slaveBox.x, slaveBox.y, slaveBox.width, slaveBox.height);
+}
+
+/* NotebookPlaceSlaves --
+ * Geometry manager hook.
+ */
+static void NotebookPlaceSlaves(void *recordPtr)
+{
+ Notebook *nb = recordPtr;
+ int currentIndex = nb->notebook.currentIndex;
+ if (currentIndex >= 0) {
+ NotebookDoLayout(nb);
+ NotebookPlaceSlave(nb, currentIndex);
+ }
+}
+
+/*
+ * SelectTab(nb, index) --
+ * Change the currently-selected tab.
+ */
+static void SelectTab(Notebook *nb, int index)
+{
+ Tab *tab = Ttk_SlaveData(nb->notebook.mgr,index);
+ int currentIndex = nb->notebook.currentIndex;
+
+ if (index == currentIndex) {
+ return;
+ }
+
+ if (TabState(nb, index) & TTK_STATE_DISABLED) {
+ return;
+ }
+
+ /* Unhide the tab if it is currently hidden and being selected.
+ */
+ if (tab->state == TAB_STATE_HIDDEN) {
+ tab->state = TAB_STATE_NORMAL;
+ }
+
+ if (currentIndex >= 0) {
+ Ttk_UnmapSlave(nb->notebook.mgr, currentIndex);
+ }
+
+ NotebookPlaceSlave(nb, index);
+
+ nb->notebook.currentIndex = index;
+ TtkRedisplayWidget(&nb->core);
+
+ TtkSendVirtualEvent(nb->core.tkwin, "NotebookTabChanged");
+}
+
+/* NextTab --
+ * Returns the index of the next tab after the specified tab
+ * in the normal state (e.g., not hidden or disabled),
+ * or -1 if all tabs are disabled or hidden.
+ */
+static int NextTab(Notebook *nb, int index)
+{
+ int nTabs = Ttk_NumberSlaves(nb->notebook.mgr);
+ int nextIndex;
+
+ /* Scan forward for following usable tab:
+ */
+ for (nextIndex = index + 1; nextIndex < nTabs; ++nextIndex) {
+ Tab *tab = Ttk_SlaveData(nb->notebook.mgr, nextIndex);
+ if (tab->state == TAB_STATE_NORMAL) {
+ return nextIndex;
+ }
+ }
+
+ /* Not found -- scan backwards.
+ */
+ for (nextIndex = index - 1; nextIndex >= 0; --nextIndex) {
+ Tab *tab = Ttk_SlaveData(nb->notebook.mgr, nextIndex);
+ if (tab->state == TAB_STATE_NORMAL) {
+ return nextIndex;
+ }
+ }
+
+ /* Still nothing. Give up.
+ */
+ return -1;
+}
+
+/* SelectNearestTab --
+ * Handles the case where the current tab is forgotten, hidden,
+ * or destroyed.
+ *
+ * Unmap the current tab and schedule the next available one
+ * to be mapped at the next GM update.
+ */
+static void SelectNearestTab(Notebook *nb)
+{
+ int currentIndex = nb->notebook.currentIndex;
+ int nextIndex = NextTab(nb, currentIndex);
+
+ if (currentIndex >= 0) {
+ Ttk_UnmapSlave(nb->notebook.mgr, currentIndex);
+ }
+ if (currentIndex != nextIndex) {
+ TtkSendVirtualEvent(nb->core.tkwin, "NotebookTabChanged");
+ }
+
+ nb->notebook.currentIndex = nextIndex;
+ Ttk_ManagerLayoutChanged(nb->notebook.mgr);
+ TtkRedisplayWidget(&nb->core);
+}
+
+/* TabRemoved -- GM SlaveRemoved hook.
+ * Select the next tab if the current one is being removed.
+ * Adjust currentIndex to account for removed slave.
+ */
+static void TabRemoved(void *managerData, int index)
+{
+ Notebook *nb = managerData;
+ Tab *tab = Ttk_SlaveData(nb->notebook.mgr, index);
+
+ if (index == nb->notebook.currentIndex) {
+ SelectNearestTab(nb);
+ }
+
+ if (index < nb->notebook.currentIndex) {
+ --nb->notebook.currentIndex;
+ }
+
+ DestroyTab(nb, tab);
+
+ TtkRedisplayWidget(&nb->core);
+}
+
+static int TabRequest(void *managerData, int index, int width, int height)
+{
+ return 1;
+}
+
+/* AddTab --
+ * Add new tab at specified index.
+ */
+static int AddTab(
+ Tcl_Interp *interp, Notebook *nb,
+ int destIndex, Tk_Window slaveWindow,
+ int objc, Tcl_Obj *const objv[])
+{
+ Tab *tab;
+ if (!Ttk_Maintainable(interp, slaveWindow, nb->core.tkwin)) {
+ return TCL_ERROR;
+ }
+#if 0 /* can't happen */
+ if (Ttk_SlaveIndex(nb->notebook.mgr, slaveWindow) >= 0) {
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf("%s already added",
+ Tk_PathName(slaveWindow)));
+ Tcl_SetErrorCode(interp, "TTK", "NOTEBOOK", "PRESENT", NULL);
+ return TCL_ERROR;
+ }
+#endif
+
+ /* Create and insert tab.
+ */
+ tab = CreateTab(interp, nb, slaveWindow);
+ if (!tab) {
+ return TCL_ERROR;
+ }
+ if (ConfigureTab(interp, nb, tab, slaveWindow, objc, objv) != TCL_OK) {
+ DestroyTab(nb, tab);
+ return TCL_ERROR;
+ }
+
+ Ttk_InsertSlave(nb->notebook.mgr, destIndex, slaveWindow, tab);
+
+ /* Adjust indices and/or autoselect first tab:
+ */
+ if (nb->notebook.currentIndex < 0) {
+ SelectTab(nb, destIndex);
+ } else if (nb->notebook.currentIndex >= destIndex) {
+ ++nb->notebook.currentIndex;
+ }
+
+ return TCL_OK;
+}
+
+static Ttk_ManagerSpec NotebookManagerSpec = {
+ { "notebook", Ttk_GeometryRequestProc, Ttk_LostSlaveProc },
+ NotebookSize,
+ NotebookPlaceSlaves,
+ TabRequest,
+ TabRemoved
+};
+
+/*------------------------------------------------------------------------
+ * +++ Event handlers.
+ */
+
+/* NotebookEventHandler --
+ * Tracks the active tab.
+ */
+static const int NotebookEventMask
+ = StructureNotifyMask
+ | PointerMotionMask
+ | LeaveWindowMask
+ ;
+static void NotebookEventHandler(ClientData clientData, XEvent *eventPtr)
+{
+ Notebook *nb = clientData;
+
+ if (eventPtr->type == DestroyNotify) { /* Remove self */
+ Tk_DeleteEventHandler(nb->core.tkwin,
+ NotebookEventMask, NotebookEventHandler, clientData);
+ } else if (eventPtr->type == MotionNotify) {
+ int index = IdentifyTab(nb, eventPtr->xmotion.x, eventPtr->xmotion.y);
+ ActivateTab(nb, index);
+ } else if (eventPtr->type == LeaveNotify) {
+ ActivateTab(nb, -1);
+ }
+}
+
+/*------------------------------------------------------------------------
+ * +++ Utilities.
+ */
+
+/* FindTabIndex --
+ * Find the index of the specified tab.
+ * Tab identifiers are one of:
+ *
+ * + positional specifications @x,y,
+ * + "current",
+ * + numeric indices [0..nTabs],
+ * + slave window names
+ *
+ * Stores index of specified tab in *index_rtn, -1 if not found.
+ *
+ * Returns TCL_ERROR and leaves an error message in interp->result
+ * if the tab identifier was incorrect.
+ *
+ * See also: GetTabIndex.
+ */
+static int FindTabIndex(
+ Tcl_Interp *interp, Notebook *nb, Tcl_Obj *objPtr, int *index_rtn)
+{
+ const char *string = Tcl_GetString(objPtr);
+ int x, y;
+
+ *index_rtn = -1;
+
+ /* Check for @x,y ...
+ */
+ if (string[0] == '@' && sscanf(string, "@%d,%d",&x,&y) == 2) {
+ *index_rtn = IdentifyTab(nb, x, y);
+ return TCL_OK;
+ }
+
+ /* ... or "current" ...
+ */
+ if (!strcmp(string, "current")) {
+ *index_rtn = nb->notebook.currentIndex;
+ return TCL_OK;
+ }
+
+ /* ... or integer index or slave window name:
+ */
+ if (Ttk_GetSlaveIndexFromObj(
+ interp, nb->notebook.mgr, objPtr, index_rtn) == TCL_OK)
+ {
+ return TCL_OK;
+ }
+
+ /* Nothing matched; Ttk_GetSlaveIndexFromObj will have left error message.
+ */
+ return TCL_ERROR;
+}
+
+/* GetTabIndex --
+ * Get the index of an existing tab.
+ * Tab identifiers are as per FindTabIndex.
+ * Returns TCL_ERROR if the tab does not exist.
+ */
+static int GetTabIndex(
+ Tcl_Interp *interp, Notebook *nb, Tcl_Obj *objPtr, int *index_rtn)
+{
+ int status = FindTabIndex(interp, nb, objPtr, index_rtn);
+
+ if (status == TCL_OK && *index_rtn < 0) {
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "tab '%s' not found", Tcl_GetString(objPtr)));
+ Tcl_SetErrorCode(interp, "TTK", "NOTEBOOK", "TAB", NULL);
+ status = TCL_ERROR;
+ }
+ return status;
+}
+
+/*------------------------------------------------------------------------
+ * +++ Widget command routines.
+ */
+
+/* $nb add window ?options ... ?
+ */
+static int NotebookAddCommand(
+ void *recordPtr, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[])
+{
+ Notebook *nb = recordPtr;
+ int index = Ttk_NumberSlaves(nb->notebook.mgr);
+ Tk_Window slaveWindow;
+ int slaveIndex;
+ Tab *tab;
+
+ if (objc <= 2 || objc % 2 != 1) {
+ Tcl_WrongNumArgs(interp, 2, objv, "window ?-option value ...?");
+ return TCL_ERROR;
+ }
+
+ slaveWindow = Tk_NameToWindow(interp,Tcl_GetString(objv[2]),nb->core.tkwin);
+ if (!slaveWindow) {
+ return TCL_ERROR;
+ }
+ slaveIndex = Ttk_SlaveIndex(nb->notebook.mgr, slaveWindow);
+
+ if (slaveIndex < 0) { /* New tab */
+ return AddTab(interp, nb, index, slaveWindow, objc-3,objv+3);
+ }
+
+ tab = Ttk_SlaveData(nb->notebook.mgr, slaveIndex);
+ if (tab->state == TAB_STATE_HIDDEN) {
+ tab->state = TAB_STATE_NORMAL;
+ }
+ if (ConfigureTab(interp, nb, tab, slaveWindow, objc-3,objv+3) != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ TtkRedisplayWidget(&nb->core);
+
+ return TCL_OK;
+}
+
+/* $nb insert $index $tab ?-option value ...?
+ * Insert new tab, or move existing one.
+ */
+static int NotebookInsertCommand(
+ void *recordPtr, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[])
+{
+ Notebook *nb = recordPtr;
+ int current = nb->notebook.currentIndex;
+ int nSlaves = Ttk_NumberSlaves(nb->notebook.mgr);
+ int srcIndex, destIndex;
+
+ if (objc < 4) {
+ Tcl_WrongNumArgs(interp, 2,objv, "index slave ?-option value ...?");
+ return TCL_ERROR;
+ }
+
+ if (!strcmp(Tcl_GetString(objv[2]), "end")) {
+ destIndex = Ttk_NumberSlaves(nb->notebook.mgr);
+ } else if (TCL_OK != Ttk_GetSlaveIndexFromObj(
+ interp, nb->notebook.mgr, objv[2], &destIndex)) {
+ return TCL_ERROR;
+ }
+
+ if (Tcl_GetString(objv[3])[0] == '.') {
+ /* Window name -- could be new or existing slave.
+ */
+ Tk_Window slaveWindow =
+ Tk_NameToWindow(interp,Tcl_GetString(objv[3]),nb->core.tkwin);
+
+ if (!slaveWindow) {
+ return TCL_ERROR;
+ }
+
+ srcIndex = Ttk_SlaveIndex(nb->notebook.mgr, slaveWindow);
+ if (srcIndex < 0) { /* New slave */
+ return AddTab(interp, nb, destIndex, slaveWindow, objc-4,objv+4);
+ }
+ } else if (Ttk_GetSlaveIndexFromObj(
+ interp, nb->notebook.mgr, objv[3], &srcIndex) != TCL_OK)
+ {
+ return TCL_ERROR;
+ }
+
+ /* Move existing slave:
+ */
+ if (ConfigureTab(interp, nb,
+ Ttk_SlaveData(nb->notebook.mgr,srcIndex),
+ Ttk_SlaveWindow(nb->notebook.mgr,srcIndex),
+ objc-4,objv+4) != TCL_OK)
+ {
+ return TCL_ERROR;
+ }
+
+ if (destIndex >= nSlaves) {
+ destIndex = nSlaves - 1;
+ }
+ Ttk_ReorderSlave(nb->notebook.mgr, srcIndex, destIndex);
+
+ /* Adjust internal indexes:
+ */
+ nb->notebook.activeIndex = -1;
+ if (current == srcIndex) {
+ nb->notebook.currentIndex = destIndex;
+ } else if (destIndex <= current && current < srcIndex) {
+ ++nb->notebook.currentIndex;
+ } else if (srcIndex < current && current <= destIndex) {
+ --nb->notebook.currentIndex;
+ }
+
+ TtkRedisplayWidget(&nb->core);
+
+ return TCL_OK;
+}
+
+/* $nb forget $tab --
+ * Removes the specified tab.
+ */
+static int NotebookForgetCommand(
+ void *recordPtr, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[])
+{
+ Notebook *nb = recordPtr;
+ int index;
+
+ if (objc != 3) {
+ Tcl_WrongNumArgs(interp, 2, objv, "tab");
+ return TCL_ERROR;
+ }
+
+ if (GetTabIndex(interp, nb, objv[2], &index) != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ Ttk_ForgetSlave(nb->notebook.mgr, index);
+ TtkRedisplayWidget(&nb->core);
+
+ return TCL_OK;
+}
+
+/* $nb hide $tab --
+ * Hides the specified tab.
+ */
+static int NotebookHideCommand(
+ void *recordPtr, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[])
+{
+ Notebook *nb = recordPtr;
+ int index;
+ Tab *tab;
+
+ if (objc != 3) {
+ Tcl_WrongNumArgs(interp, 2, objv, "tab");
+ return TCL_ERROR;
+ }
+
+ if (GetTabIndex(interp, nb, objv[2], &index) != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ tab = Ttk_SlaveData(nb->notebook.mgr, index);
+ tab->state = TAB_STATE_HIDDEN;
+ if (index == nb->notebook.currentIndex) {
+ SelectNearestTab(nb);
+ }
+
+ TtkRedisplayWidget(&nb->core);
+
+ return TCL_OK;
+}
+
+/* $nb identify $x $y --
+ * Returns name of tab element at $x,$y; empty string if none.
+ */
+static int NotebookIdentifyCommand(
+ void *recordPtr, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[])
+{
+ static const char *whatTable[] = { "element", "tab", NULL };
+ enum { IDENTIFY_ELEMENT, IDENTIFY_TAB };
+ int what = IDENTIFY_ELEMENT;
+ Notebook *nb = recordPtr;
+ Ttk_Element element = NULL;
+ int x, y, tabIndex;
+
+ if (objc < 4 || objc > 5) {
+ Tcl_WrongNumArgs(interp, 2,objv, "?what? x y");
+ return TCL_ERROR;
+ }
+
+ if ( Tcl_GetIntFromObj(interp, objv[objc-2], &x) != TCL_OK
+ || Tcl_GetIntFromObj(interp, objv[objc-1], &y) != TCL_OK
+ || (objc == 5 && Tcl_GetIndexFromObjStruct(interp, objv[2], whatTable,
+ sizeof(char *), "option", 0, &what) != TCL_OK)
+ ) {
+ return TCL_ERROR;
+ }
+
+ tabIndex = IdentifyTab(nb, x, y);
+ if (tabIndex >= 0) {
+ Tab *tab = Ttk_SlaveData(nb->notebook.mgr, tabIndex);
+ Ttk_State state = TabState(nb, tabIndex);
+ Ttk_Layout tabLayout = nb->notebook.tabLayout;
+
+ Ttk_RebindSublayout(tabLayout, tab);
+ Ttk_PlaceLayout(tabLayout, state, tab->parcel);
+
+ element = Ttk_IdentifyElement(tabLayout, x, y);
+ }
+
+ switch (what) {
+ case IDENTIFY_ELEMENT:
+ if (element) {
+ const char *elementName = Ttk_ElementName(element);
+
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(elementName, -1));
+ }
+ break;
+ case IDENTIFY_TAB:
+ if (tabIndex >= 0) {
+ Tcl_SetObjResult(interp, Tcl_NewIntObj(tabIndex));
+ }
+ break;
+ }
+ return TCL_OK;
+}
+
+/* $nb index $item --
+ * Returns the integer index of the tab specified by $item,
+ * the empty string if $item does not identify a tab.
+ * See above for valid item formats.
+ */
+static int NotebookIndexCommand(
+ void *recordPtr, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[])
+{
+ Notebook *nb = recordPtr;
+ int index, status;
+
+ if (objc != 3) {
+ Tcl_WrongNumArgs(interp, 2, objv, "tab");
+ return TCL_ERROR;
+ }
+
+ /*
+ * Special-case for "end":
+ */
+ if (!strcmp("end", Tcl_GetString(objv[2]))) {
+ int nSlaves = Ttk_NumberSlaves(nb->notebook.mgr);
+ Tcl_SetObjResult(interp, Tcl_NewIntObj(nSlaves));
+ return TCL_OK;
+ }
+
+ status = FindTabIndex(interp, nb, objv[2], &index);
+ if (status == TCL_OK && index >= 0) {
+ Tcl_SetObjResult(interp, Tcl_NewIntObj(index));
+ }
+
+ return status;
+}
+
+/* $nb select ?$item? --
+ * Select the specified tab, or return the widget path of
+ * the currently-selected pane.
+ */
+static int NotebookSelectCommand(
+ void *recordPtr, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[])
+{
+ Notebook *nb = recordPtr;
+
+ if (objc == 2) {
+ if (nb->notebook.currentIndex >= 0) {
+ Tk_Window pane = Ttk_SlaveWindow(
+ nb->notebook.mgr, nb->notebook.currentIndex);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(Tk_PathName(pane), -1));
+ }
+ return TCL_OK;
+ } else if (objc == 3) {
+ int index, status = GetTabIndex(interp, nb, objv[2], &index);
+ if (status == TCL_OK) {
+ SelectTab(nb, index);
+ }
+ return status;
+ } /*else*/
+ Tcl_WrongNumArgs(interp, 2, objv, "?tab?");
+ return TCL_ERROR;
+}
+
+/* $nb tabs --
+ * Return list of tabs.
+ */
+static int NotebookTabsCommand(
+ void *recordPtr, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[])
+{
+ Notebook *nb = recordPtr;
+ Ttk_Manager *mgr = nb->notebook.mgr;
+ Tcl_Obj *result;
+ int i;
+
+ if (objc != 2) {
+ Tcl_WrongNumArgs(interp, 2, objv, "");
+ return TCL_ERROR;
+ }
+
+ result = Tcl_NewListObj(0, NULL);
+ for (i = 0; i < Ttk_NumberSlaves(mgr); ++i) {
+ const char *pathName = Tk_PathName(Ttk_SlaveWindow(mgr,i));
+
+ Tcl_ListObjAppendElement(NULL, result, Tcl_NewStringObj(pathName,-1));
+ }
+ Tcl_SetObjResult(interp, result);
+ return TCL_OK;
+}
+
+/* $nb tab $tab ?-option ?value -option value...??
+ */
+static int NotebookTabCommand(
+ void *recordPtr, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[])
+{
+ Notebook *nb = recordPtr;
+ Ttk_Manager *mgr = nb->notebook.mgr;
+ int index;
+ Tk_Window slaveWindow;
+ Tab *tab;
+
+ if (objc < 3) {
+ Tcl_WrongNumArgs(interp, 2, objv, "tab ?-option ?value??...");
+ return TCL_ERROR;
+ }
+
+ if (GetTabIndex(interp, nb, objv[2], &index) != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ tab = Ttk_SlaveData(mgr, index);
+ slaveWindow = Ttk_SlaveWindow(mgr, index);
+
+ if (objc == 3) {
+ return TtkEnumerateOptions(interp, tab,
+ PaneOptionSpecs, nb->notebook.paneOptionTable, slaveWindow);
+ } else if (objc == 4) {
+ return TtkGetOptionValue(interp, tab, objv[3],
+ nb->notebook.paneOptionTable, slaveWindow);
+ } /* else */
+
+ if (ConfigureTab(interp, nb, tab, slaveWindow, objc-3,objv+3) != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ /* If the current tab has become disabled or hidden,
+ * select the next nondisabled, unhidden one:
+ */
+ if (index == nb->notebook.currentIndex && tab->state != TAB_STATE_NORMAL) {
+ SelectNearestTab(nb);
+ }
+
+ return TCL_OK;
+}
+
+/* Subcommand table:
+ */
+static const Ttk_Ensemble NotebookCommands[] = {
+ { "add", NotebookAddCommand,0 },
+ { "configure", TtkWidgetConfigureCommand,0 },
+ { "cget", TtkWidgetCgetCommand,0 },
+ { "forget", NotebookForgetCommand,0 },
+ { "hide", NotebookHideCommand,0 },
+ { "identify", NotebookIdentifyCommand,0 },
+ { "index", NotebookIndexCommand,0 },
+ { "insert", NotebookInsertCommand,0 },
+ { "instate", TtkWidgetInstateCommand,0 },
+ { "select", NotebookSelectCommand,0 },
+ { "state", TtkWidgetStateCommand,0 },
+ { "tab", NotebookTabCommand,0 },
+ { "tabs", NotebookTabsCommand,0 },
+ { 0,0,0 }
+};
+
+/*------------------------------------------------------------------------
+ * +++ Widget class hooks.
+ */
+
+static void NotebookInitialize(Tcl_Interp *interp, void *recordPtr)
+{
+ Notebook *nb = recordPtr;
+
+ nb->notebook.mgr = Ttk_CreateManager(
+ &NotebookManagerSpec, recordPtr, nb->core.tkwin);
+
+ nb->notebook.tabOptionTable = Tk_CreateOptionTable(interp,TabOptionSpecs);
+ nb->notebook.paneOptionTable = Tk_CreateOptionTable(interp,PaneOptionSpecs);
+
+ nb->notebook.currentIndex = -1;
+ nb->notebook.activeIndex = -1;
+ nb->notebook.tabLayout = 0;
+
+ nb->notebook.clientArea = Ttk_MakeBox(0,0,1,1);
+
+ Tk_CreateEventHandler(
+ nb->core.tkwin, NotebookEventMask, NotebookEventHandler, recordPtr);
+}
+
+static void NotebookCleanup(void *recordPtr)
+{
+ Notebook *nb = recordPtr;
+
+ Ttk_DeleteManager(nb->notebook.mgr);
+ if (nb->notebook.tabLayout)
+ Ttk_FreeLayout(nb->notebook.tabLayout);
+}
+
+static int NotebookConfigure(Tcl_Interp *interp, void *clientData, int mask)
+{
+ Notebook *nb = clientData;
+
+ /*
+ * Error-checks:
+ */
+ if (nb->notebook.paddingObj) {
+ /* Check for valid -padding: */
+ Ttk_Padding unused;
+ if (Ttk_GetPaddingFromObj(
+ interp, nb->core.tkwin, nb->notebook.paddingObj, &unused)
+ != TCL_OK) {
+ return TCL_ERROR;
+ }
+ }
+
+ return TtkCoreConfigure(interp, clientData, mask);
+}
+
+/* NotebookGetLayout --
+ * GetLayout widget hook.
+ */
+static Ttk_Layout NotebookGetLayout(
+ Tcl_Interp *interp, Ttk_Theme theme, void *recordPtr)
+{
+ Notebook *nb = recordPtr;
+ Ttk_Layout notebookLayout = TtkWidgetGetLayout(interp, theme, recordPtr);
+ Ttk_Layout tabLayout;
+
+ if (!notebookLayout) {
+ return NULL;
+ }
+
+ tabLayout = Ttk_CreateSublayout(
+ interp, theme, notebookLayout, ".Tab", nb->notebook.tabOptionTable);
+
+ if (tabLayout) {
+ if (nb->notebook.tabLayout) {
+ Ttk_FreeLayout(nb->notebook.tabLayout);
+ }
+ nb->notebook.tabLayout = tabLayout;
+ }
+
+ return notebookLayout;
+}
+
+/*------------------------------------------------------------------------
+ * +++ Display routines.
+ */
+
+static void DisplayTab(Notebook *nb, int index, Drawable d)
+{
+ Ttk_Layout tabLayout = nb->notebook.tabLayout;
+ Tab *tab = Ttk_SlaveData(nb->notebook.mgr, index);
+ Ttk_State state = TabState(nb, index);
+
+ if (tab->state != TAB_STATE_HIDDEN) {
+ Ttk_RebindSublayout(tabLayout, tab);
+ Ttk_PlaceLayout(tabLayout, state, tab->parcel);
+ Ttk_DrawLayout(tabLayout, state, d);
+ }
+}
+
+static void NotebookDisplay(void *clientData, Drawable d)
+{
+ Notebook *nb = clientData;
+ int nSlaves = Ttk_NumberSlaves(nb->notebook.mgr);
+ int index;
+
+ /* Draw notebook background (base layout):
+ */
+ Ttk_DrawLayout(nb->core.layout, nb->core.state, d);
+
+ /* Draw tabs from left to right, but draw the current tab last
+ * so it will overwrite its neighbors.
+ */
+ for (index = 0; index < nSlaves; ++index) {
+ if (index != nb->notebook.currentIndex) {
+ DisplayTab(nb, index, d);
+ }
+ }
+ if (nb->notebook.currentIndex >= 0) {
+ DisplayTab(nb, nb->notebook.currentIndex, d);
+ }
+}
+
+/*------------------------------------------------------------------------
+ * +++ Widget specification and layout definitions.
+ */
+
+static WidgetSpec NotebookWidgetSpec =
+{
+ "TNotebook", /* className */
+ sizeof(Notebook), /* recordSize */
+ NotebookOptionSpecs, /* optionSpecs */
+ NotebookCommands, /* subcommands */
+ NotebookInitialize, /* initializeProc */
+ NotebookCleanup, /* cleanupProc */
+ NotebookConfigure, /* configureProc */
+ TtkNullPostConfigure, /* postConfigureProc */
+ NotebookGetLayout, /* getLayoutProc */
+ NotebookSize, /* geometryProc */
+ NotebookDoLayout, /* layoutProc */
+ NotebookDisplay /* displayProc */
+};
+
+TTK_BEGIN_LAYOUT(NotebookLayout)
+ TTK_NODE("Notebook.client", TTK_FILL_BOTH)
+TTK_END_LAYOUT
+
+TTK_BEGIN_LAYOUT(TabLayout)
+ TTK_GROUP("Notebook.tab", TTK_FILL_BOTH,
+ TTK_GROUP("Notebook.padding", TTK_PACK_TOP|TTK_FILL_BOTH,
+ TTK_GROUP("Notebook.focus", TTK_PACK_TOP|TTK_FILL_BOTH,
+ TTK_NODE("Notebook.label", TTK_PACK_TOP))))
+TTK_END_LAYOUT
+
+/*------------------------------------------------------------------------
+ * +++ Initialization.
+ */
+
+MODULE_SCOPE
+void TtkNotebook_Init(Tcl_Interp *interp)
+{
+ Ttk_Theme themePtr = Ttk_GetDefaultTheme(interp);
+
+ Ttk_RegisterLayout(themePtr, "Tab", TabLayout);
+ Ttk_RegisterLayout(themePtr, "TNotebook", NotebookLayout);
+
+ RegisterWidget(interp, "ttk::notebook", &NotebookWidgetSpec);
+}
+
+/*EOF*/
diff --git a/tk8.6/generic/ttk/ttkPanedwindow.c b/tk8.6/generic/ttk/ttkPanedwindow.c
new file mode 100644
index 0000000..adc2aef
--- /dev/null
+++ b/tk8.6/generic/ttk/ttkPanedwindow.c
@@ -0,0 +1,976 @@
+/*
+ * Copyright (c) 2005, Joe English. Freely redistributable.
+ *
+ * ttk::panedwindow widget implementation.
+ *
+ * TODO: track active/pressed sash.
+ */
+
+#include <string.h>
+#include <tk.h>
+#include "ttkManager.h"
+#include "ttkTheme.h"
+#include "ttkWidget.h"
+
+/*------------------------------------------------------------------------
+ * +++ Layout algorithm.
+ *
+ * (pos=x/y, size=width/height, depending on -orient=horizontal/vertical)
+ *
+ * Each pane carries two pieces of state: the request size and the
+ * position of the following sash. (The final pane has no sash,
+ * its sash position is used as a sentinel value).
+ *
+ * Pane geometry is determined by the sash positions.
+ * When resizing, sash positions are computed from the request sizes,
+ * the available space, and pane weights (see PlaceSashes()).
+ * This ensures continuous resize behavior (that is: changing
+ * the size by X pixels then changing the size by Y pixels
+ * gives the same result as changing the size by X+Y pixels
+ * in one step).
+ *
+ * The request size is initially set to the slave window's requested size.
+ * When the user drags a sash, each pane's request size is set to its
+ * actual size. This ensures that panes "stay put" on the next resize.
+ *
+ * If reqSize == 0, use 0 for the weight as well. This ensures that
+ * "collapsed" panes stay collapsed during a resize, regardless of
+ * their nominal -weight.
+ *
+ * +++ Invariants.
+ *
+ * #sash = #pane - 1
+ * pos(pane[0]) = 0
+ * pos(sash[i]) = pos(pane[i]) + size(pane[i]), 0 <= i <= #sash
+ * pos(pane[i+1]) = pos(sash[i]) + size(sash[i]), 0 <= i < #sash
+ * pos(sash[#sash]) = size(pw) // sentinel value, constraint
+ *
+ * size(pw) = sum(size(pane(0..#pane))) + sum(size(sash(0..#sash)))
+ * size(pane[i]) >= 0, for 0 <= i < #pane
+ * size(sash[i]) >= 0, for 0 <= i < #sash
+ * ==> pos(pane[i]) <= pos(sash[i]) <= pos(pane[i+1]), for 0 <= i < #sash
+ *
+ * Assumption: all sashes are the same size.
+ */
+
+/*------------------------------------------------------------------------
+ * +++ Widget record.
+ */
+
+typedef struct {
+ Tcl_Obj *orientObj;
+ int orient;
+ int width;
+ int height;
+ Ttk_Manager *mgr;
+ Tk_OptionTable paneOptionTable;
+ Ttk_Layout sashLayout;
+ int sashThickness;
+} PanedPart;
+
+typedef struct {
+ WidgetCore core;
+ PanedPart paned;
+} Paned;
+
+/* @@@ NOTE: -orient is readonly 'cause dynamic oriention changes NYI
+ */
+static Tk_OptionSpec PanedOptionSpecs[] = {
+ {TK_OPTION_STRING_TABLE, "-orient", "orient", "Orient", "vertical",
+ Tk_Offset(Paned,paned.orientObj), Tk_Offset(Paned,paned.orient),
+ 0,(ClientData)ttkOrientStrings,READONLY_OPTION|STYLE_CHANGED },
+ {TK_OPTION_INT, "-width", "width", "Width", "0",
+ -1,Tk_Offset(Paned,paned.width),
+ 0,0,GEOMETRY_CHANGED },
+ {TK_OPTION_INT, "-height", "height", "Height", "0",
+ -1,Tk_Offset(Paned,paned.height),
+ 0,0,GEOMETRY_CHANGED },
+
+ WIDGET_TAKEFOCUS_FALSE,
+ WIDGET_INHERIT_OPTIONS(ttkCoreOptionSpecs)
+};
+
+/*------------------------------------------------------------------------
+ * +++ Slave pane record.
+ */
+typedef struct {
+ int reqSize; /* Pane request size */
+ int sashPos; /* Folowing sash position */
+ int weight; /* Pane -weight, for resizing */
+} Pane;
+
+static Tk_OptionSpec PaneOptionSpecs[] = {
+ {TK_OPTION_INT, "-weight", "weight", "Weight", "0",
+ -1,Tk_Offset(Pane,weight), 0,0,GEOMETRY_CHANGED },
+ {TK_OPTION_END, 0,0,0, NULL, -1,-1, 0,0,0}
+};
+
+/* CreatePane --
+ * Create a new pane record.
+ */
+static Pane *CreatePane(Tcl_Interp *interp, Paned *pw, Tk_Window slaveWindow)
+{
+ Tk_OptionTable optionTable = pw->paned.paneOptionTable;
+ void *record = ckalloc(sizeof(Pane));
+ Pane *pane = record;
+
+ memset(record, 0, sizeof(Pane));
+ if (Tk_InitOptions(interp, record, optionTable, slaveWindow) != TCL_OK) {
+ ckfree(record);
+ return NULL;
+ }
+
+ pane->reqSize
+ = pw->paned.orient == TTK_ORIENT_HORIZONTAL
+ ? Tk_ReqWidth(slaveWindow) : Tk_ReqHeight(slaveWindow);
+
+ return pane;
+}
+
+/* DestroyPane --
+ * Free pane record.
+ */
+static void DestroyPane(Paned *pw, Pane *pane)
+{
+ void *record = pane;
+ Tk_FreeConfigOptions(record, pw->paned.paneOptionTable, pw->core.tkwin);
+ ckfree(record);
+}
+
+/* ConfigurePane --
+ * Set pane options.
+ */
+static int ConfigurePane(
+ Tcl_Interp *interp, Paned *pw, Pane *pane, Tk_Window slaveWindow,
+ int objc, Tcl_Obj *const objv[])
+{
+ Ttk_Manager *mgr = pw->paned.mgr;
+ Tk_SavedOptions savedOptions;
+ int mask = 0;
+
+ if (Tk_SetOptions(interp, (void*)pane, pw->paned.paneOptionTable,
+ objc, objv, slaveWindow, &savedOptions, &mask) != TCL_OK)
+ {
+ return TCL_ERROR;
+ }
+
+ /* Sanity-check:
+ */
+ if (pane->weight < 0) {
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "-weight must be nonnegative", -1));
+ Tcl_SetErrorCode(interp, "TTK", "PANE", "WEIGHT", NULL);
+ goto error;
+ }
+
+ /* Done.
+ */
+ Tk_FreeSavedOptions(&savedOptions);
+ Ttk_ManagerSizeChanged(mgr);
+ return TCL_OK;
+
+error:
+ Tk_RestoreSavedOptions(&savedOptions);
+ return TCL_ERROR;
+}
+
+
+/*------------------------------------------------------------------------
+ * +++ Sash adjustment.
+ */
+
+/* ShoveUp --
+ * Place sash i at specified position, recursively shoving
+ * previous sashes upwards as needed, until hitting the top
+ * of the window. If that happens, shove back down.
+ *
+ * Returns: final position of sash i.
+ */
+
+static int ShoveUp(Paned *pw, int i, int pos)
+{
+ Pane *pane = Ttk_SlaveData(pw->paned.mgr, i);
+ int sashThickness = pw->paned.sashThickness;
+
+ if (i == 0) {
+ if (pos < 0)
+ pos = 0;
+ } else {
+ Pane *prevPane = Ttk_SlaveData(pw->paned.mgr, i-1);
+ if (pos < prevPane->sashPos + sashThickness)
+ pos = ShoveUp(pw, i-1, pos - sashThickness) + sashThickness;
+ }
+ return pane->sashPos = pos;
+}
+
+/* ShoveDown --
+ * Same as ShoveUp, but going in the opposite direction
+ * and stopping at the sentinel sash.
+ */
+static int ShoveDown(Paned *pw, int i, int pos)
+{
+ Pane *pane = Ttk_SlaveData(pw->paned.mgr,i);
+ int sashThickness = pw->paned.sashThickness;
+
+ if (i == Ttk_NumberSlaves(pw->paned.mgr) - 1) {
+ pos = pane->sashPos; /* Sentinel value == master window size */
+ } else {
+ Pane *nextPane = Ttk_SlaveData(pw->paned.mgr,i+1);
+ if (pos + sashThickness > nextPane->sashPos)
+ pos = ShoveDown(pw, i+1, pos + sashThickness) - sashThickness;
+ }
+ return pane->sashPos = pos;
+}
+
+/* PanedSize --
+ * Compute the requested size of the paned widget
+ * from the individual pane request sizes.
+ *
+ * Used as the WidgetSpec sizeProc and the ManagerSpec sizeProc.
+ */
+static int PanedSize(void *recordPtr, int *widthPtr, int *heightPtr)
+{
+ Paned *pw = recordPtr;
+ int nPanes = Ttk_NumberSlaves(pw->paned.mgr);
+ int nSashes = nPanes - 1;
+ int sashThickness = pw->paned.sashThickness;
+ int width = 0, height = 0;
+ int index;
+
+ if (pw->paned.orient == TTK_ORIENT_HORIZONTAL) {
+ for (index = 0; index < nPanes; ++index) {
+ Pane *pane = Ttk_SlaveData(pw->paned.mgr, index);
+ Tk_Window slaveWindow = Ttk_SlaveWindow(pw->paned.mgr, index);
+
+ if (height < Tk_ReqHeight(slaveWindow))
+ height = Tk_ReqHeight(slaveWindow);
+ width += pane->reqSize;
+ }
+ width += nSashes * sashThickness;
+ } else {
+ for (index = 0; index < nPanes; ++index) {
+ Pane *pane = Ttk_SlaveData(pw->paned.mgr, index);
+ Tk_Window slaveWindow = Ttk_SlaveWindow(pw->paned.mgr, index);
+
+ if (width < Tk_ReqWidth(slaveWindow))
+ width = Tk_ReqWidth(slaveWindow);
+ height += pane->reqSize;
+ }
+ height += nSashes * sashThickness;
+ }
+
+ *widthPtr = pw->paned.width > 0 ? pw->paned.width : width;
+ *heightPtr = pw->paned.height > 0 ? pw->paned.height : height;
+ return 1;
+}
+
+/* AdjustPanes --
+ * Set pane request sizes from sash positions.
+ *
+ * NOTE:
+ * AdjustPanes followed by PlaceSashes (called during relayout)
+ * will leave the sashes in the same place, as long as available size
+ * remains contant.
+ */
+static void AdjustPanes(Paned *pw)
+{
+ int sashThickness = pw->paned.sashThickness;
+ int pos = 0;
+ int index;
+
+ for (index = 0; index < Ttk_NumberSlaves(pw->paned.mgr); ++index) {
+ Pane *pane = Ttk_SlaveData(pw->paned.mgr, index);
+ int size = pane->sashPos - pos;
+ pane->reqSize = size >= 0 ? size : 0;
+ pos = pane->sashPos + sashThickness;
+ }
+}
+
+/* PlaceSashes --
+ * Set sash positions from pane request sizes and available space.
+ * The sentinel sash position is set to the available space.
+ *
+ * Allocate pane->reqSize pixels to each pane, and distribute
+ * the difference = available size - requested size according
+ * to pane->weight.
+ *
+ * If there's still some left over, squeeze panes from the bottom up
+ * (This can happen if all weights are zero, or if one or more panes
+ * are too small to absorb the required shrinkage).
+ *
+ * Notes:
+ * This doesn't distribute the remainder pixels as evenly as it could
+ * when more than one pane has weight > 1.
+ */
+static void PlaceSashes(Paned *pw, int width, int height)
+{
+ Ttk_Manager *mgr = pw->paned.mgr;
+ int nPanes = Ttk_NumberSlaves(mgr);
+ int sashThickness = pw->paned.sashThickness;
+ int available = pw->paned.orient == TTK_ORIENT_HORIZONTAL ? width : height;
+ int reqSize = 0, totalWeight = 0;
+ int difference, delta, remainder, pos, i;
+
+ if (nPanes == 0)
+ return;
+
+ /* Compute total required size and total available weight:
+ */
+ for (i = 0; i < nPanes; ++i) {
+ Pane *pane = Ttk_SlaveData(mgr, i);
+ reqSize += pane->reqSize;
+ totalWeight += pane->weight * (pane->reqSize != 0);
+ }
+
+ /* Compute difference to be redistributed:
+ */
+ difference = available - reqSize - sashThickness*(nPanes-1);
+ if (totalWeight != 0) {
+ delta = difference / totalWeight;
+ remainder = difference % totalWeight;
+ if (remainder < 0) {
+ --delta;
+ remainder += totalWeight;
+ }
+ } else {
+ delta = remainder = 0;
+ }
+ /* ASSERT: 0 <= remainder < totalWeight */
+
+ /* Place sashes:
+ */
+ pos = 0;
+ for (i = 0; i < nPanes; ++i) {
+ Pane *pane = Ttk_SlaveData(mgr, i);
+ int weight = pane->weight * (pane->reqSize != 0);
+ int size = pane->reqSize + delta * weight;
+
+ if (weight > remainder)
+ weight = remainder;
+ remainder -= weight;
+ size += weight;
+
+ if (size < 0)
+ size = 0;
+
+ pane->sashPos = (pos += size);
+ pos += sashThickness;
+ }
+
+ /* Handle emergency shrink/emergency stretch:
+ * Set sentinel sash position to end of widget,
+ * shove preceding sashes up.
+ */
+ ShoveUp(pw, nPanes - 1, available);
+}
+
+/* PlacePanes --
+ * Places slave panes based on sash positions.
+ */
+static void PlacePanes(Paned *pw)
+{
+ int horizontal = pw->paned.orient == TTK_ORIENT_HORIZONTAL;
+ int width = Tk_Width(pw->core.tkwin), height = Tk_Height(pw->core.tkwin);
+ int sashThickness = pw->paned.sashThickness;
+ int pos = 0;
+ int index;
+
+ for (index = 0; index < Ttk_NumberSlaves(pw->paned.mgr); ++index) {
+ Pane *pane = Ttk_SlaveData(pw->paned.mgr, index);
+ int size = pane->sashPos - pos;
+
+ if (size > 0) {
+ if (horizontal) {
+ Ttk_PlaceSlave(pw->paned.mgr, index, pos, 0, size, height);
+ } else {
+ Ttk_PlaceSlave(pw->paned.mgr, index, 0, pos, width, size);
+ }
+ } else {
+ Ttk_UnmapSlave(pw->paned.mgr, index);
+ }
+
+ pos = pane->sashPos + sashThickness;
+ }
+}
+
+/*------------------------------------------------------------------------
+ * +++ Manager specification.
+ */
+
+static void PanedPlaceSlaves(void *managerData)
+{
+ Paned *pw = managerData;
+ PlaceSashes(pw, Tk_Width(pw->core.tkwin), Tk_Height(pw->core.tkwin));
+ PlacePanes(pw);
+}
+
+static void PaneRemoved(void *managerData, int index)
+{
+ Paned *pw = managerData;
+ Pane *pane = Ttk_SlaveData(pw->paned.mgr, index);
+ DestroyPane(pw, pane);
+}
+
+static int AddPane(
+ Tcl_Interp *interp, Paned *pw,
+ int destIndex, Tk_Window slaveWindow,
+ int objc, Tcl_Obj *const objv[])
+{
+ Pane *pane;
+ if (!Ttk_Maintainable(interp, slaveWindow, pw->core.tkwin)) {
+ return TCL_ERROR;
+ }
+ if (Ttk_SlaveIndex(pw->paned.mgr, slaveWindow) >= 0) {
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "%s already added", Tk_PathName(slaveWindow)));
+ Tcl_SetErrorCode(interp, "TTK", "PANE", "PRESENT", NULL);
+ return TCL_ERROR;
+ }
+
+ pane = CreatePane(interp, pw, slaveWindow);
+ if (!pane) {
+ return TCL_ERROR;
+ }
+ if (ConfigurePane(interp, pw, pane, slaveWindow, objc, objv) != TCL_OK) {
+ DestroyPane(pw, pane);
+ return TCL_ERROR;
+ }
+
+ Ttk_InsertSlave(pw->paned.mgr, destIndex, slaveWindow, pane);
+ return TCL_OK;
+}
+
+/* PaneRequest --
+ * Only update pane request size if slave is currently unmapped.
+ * Geometry requests from mapped slaves are not directly honored
+ * in order to avoid unexpected pane resizes (esp. while the
+ * user is dragging a sash [#1325286]).
+ */
+static int PaneRequest(void *managerData, int index, int width, int height)
+{
+ Paned *pw = managerData;
+ Pane *pane = Ttk_SlaveData(pw->paned.mgr, index);
+ Tk_Window slaveWindow = Ttk_SlaveWindow(pw->paned.mgr, index);
+ int horizontal = pw->paned.orient == TTK_ORIENT_HORIZONTAL;
+
+ if (!Tk_IsMapped(slaveWindow)) {
+ pane->reqSize = horizontal ? width : height;
+ }
+ return 1;
+}
+
+static Ttk_ManagerSpec PanedManagerSpec = {
+ { "panedwindow", Ttk_GeometryRequestProc, Ttk_LostSlaveProc },
+ PanedSize,
+ PanedPlaceSlaves,
+ PaneRequest,
+ PaneRemoved
+};
+
+/*------------------------------------------------------------------------
+ * +++ Event handler.
+ *
+ * <<NOTE-PW-LEAVE-NOTIFYINFERIOR>>
+ * Tk does not execute binding scripts for <Leave> events when
+ * the pointer crosses from a parent to a child. This widget
+ * needs to know when that happens, though, so it can reset
+ * the cursor.
+ *
+ * This event handler generates an <<EnteredChild>> virtual event
+ * on LeaveNotify/NotifyInferior.
+ */
+
+static const unsigned PanedEventMask = LeaveWindowMask;
+static void PanedEventProc(ClientData clientData, XEvent *eventPtr)
+{
+ WidgetCore *corePtr = clientData;
+ if ( eventPtr->type == LeaveNotify
+ && eventPtr->xcrossing.detail == NotifyInferior)
+ {
+ TtkSendVirtualEvent(corePtr->tkwin, "EnteredChild");
+ }
+}
+
+/*------------------------------------------------------------------------
+ * +++ Initialization and cleanup hooks.
+ */
+
+static void PanedInitialize(Tcl_Interp *interp, void *recordPtr)
+{
+ Paned *pw = recordPtr;
+
+ Tk_CreateEventHandler(pw->core.tkwin,
+ PanedEventMask, PanedEventProc, recordPtr);
+ pw->paned.mgr = Ttk_CreateManager(&PanedManagerSpec, pw, pw->core.tkwin);
+ pw->paned.paneOptionTable = Tk_CreateOptionTable(interp,PaneOptionSpecs);
+ pw->paned.sashLayout = 0;
+ pw->paned.sashThickness = 1;
+}
+
+static void PanedCleanup(void *recordPtr)
+{
+ Paned *pw = recordPtr;
+
+ if (pw->paned.sashLayout)
+ Ttk_FreeLayout(pw->paned.sashLayout);
+ Tk_DeleteEventHandler(pw->core.tkwin,
+ PanedEventMask, PanedEventProc, recordPtr);
+ Ttk_DeleteManager(pw->paned.mgr);
+}
+
+/* Post-configuration hook.
+ */
+static int PanedPostConfigure(Tcl_Interp *interp, void *clientData, int mask)
+{
+ Paned *pw = clientData;
+
+ if (mask & GEOMETRY_CHANGED) {
+ /* User has changed -width or -height.
+ * Recalculate sash positions based on requested size.
+ */
+ Tk_Window tkwin = pw->core.tkwin;
+ PlaceSashes(pw,
+ pw->paned.width > 0 ? pw->paned.width : Tk_Width(tkwin),
+ pw->paned.height > 0 ? pw->paned.height : Tk_Height(tkwin));
+ }
+
+ return TCL_OK;
+}
+
+/*------------------------------------------------------------------------
+ * +++ Layout management hooks.
+ */
+static Ttk_Layout PanedGetLayout(
+ Tcl_Interp *interp, Ttk_Theme themePtr, void *recordPtr)
+{
+ Paned *pw = recordPtr;
+ Ttk_Layout panedLayout = TtkWidgetGetLayout(interp, themePtr, recordPtr);
+
+ if (panedLayout) {
+ int horizontal = pw->paned.orient == TTK_ORIENT_HORIZONTAL;
+ const char *layoutName =
+ horizontal ? ".Vertical.Sash" : ".Horizontal.Sash";
+ Ttk_Layout sashLayout = Ttk_CreateSublayout(
+ interp, themePtr, panedLayout, layoutName, pw->core.optionTable);
+
+ if (sashLayout) {
+ int sashWidth, sashHeight;
+
+ Ttk_LayoutSize(sashLayout, 0, &sashWidth, &sashHeight);
+ pw->paned.sashThickness = horizontal ? sashWidth : sashHeight;
+
+ if (pw->paned.sashLayout)
+ Ttk_FreeLayout(pw->paned.sashLayout);
+ pw->paned.sashLayout = sashLayout;
+ } else {
+ Ttk_FreeLayout(panedLayout);
+ return 0;
+ }
+ }
+
+ return panedLayout;
+}
+
+/*------------------------------------------------------------------------
+ * +++ Drawing routines.
+ */
+
+/* SashLayout --
+ * Place the sash sublayout after the specified pane,
+ * in preparation for drawing.
+ */
+static Ttk_Layout SashLayout(Paned *pw, int index)
+{
+ Pane *pane = Ttk_SlaveData(pw->paned.mgr, index);
+ int thickness = pw->paned.sashThickness,
+ height = Tk_Height(pw->core.tkwin),
+ width = Tk_Width(pw->core.tkwin),
+ sashPos = pane->sashPos;
+
+ Ttk_PlaceLayout(
+ pw->paned.sashLayout, pw->core.state,
+ pw->paned.orient == TTK_ORIENT_HORIZONTAL
+ ? Ttk_MakeBox(sashPos, 0, thickness, height)
+ : Ttk_MakeBox(0, sashPos, width, thickness));
+
+ return pw->paned.sashLayout;
+}
+
+static void DrawSash(Paned *pw, int index, Drawable d)
+{
+ Ttk_DrawLayout(SashLayout(pw, index), pw->core.state, d);
+}
+
+static void PanedDisplay(void *recordPtr, Drawable d)
+{
+ Paned *pw = recordPtr;
+ int i, nSashes = Ttk_NumberSlaves(pw->paned.mgr) - 1;
+
+ TtkWidgetDisplay(recordPtr, d);
+ for (i = 0; i < nSashes; ++i) {
+ DrawSash(pw, i, d);
+ }
+}
+
+/*------------------------------------------------------------------------
+ * +++ Widget commands.
+ */
+
+/* $pw add window [ options ... ]
+ */
+static int PanedAddCommand(
+ void *recordPtr, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[])
+{
+ Paned *pw = recordPtr;
+ Tk_Window slaveWindow;
+
+ if (objc < 3) {
+ Tcl_WrongNumArgs(interp, 2, objv, "window");
+ return TCL_ERROR;
+ }
+
+ slaveWindow = Tk_NameToWindow(
+ interp, Tcl_GetString(objv[2]), pw->core.tkwin);
+
+ if (!slaveWindow) {
+ return TCL_ERROR;
+ }
+
+ return AddPane(interp, pw, Ttk_NumberSlaves(pw->paned.mgr), slaveWindow,
+ objc - 3, objv + 3);
+}
+
+/* $pw insert $index $slave ?-option value ...?
+ * Insert new slave, or move existing one.
+ */
+static int PanedInsertCommand(
+ void *recordPtr, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[])
+{
+ Paned *pw = recordPtr;
+ int nSlaves = Ttk_NumberSlaves(pw->paned.mgr);
+ int srcIndex, destIndex;
+ Tk_Window slaveWindow;
+
+ if (objc < 4) {
+ Tcl_WrongNumArgs(interp, 2,objv, "index slave ?-option value ...?");
+ return TCL_ERROR;
+ }
+
+ slaveWindow = Tk_NameToWindow(
+ interp, Tcl_GetString(objv[3]), pw->core.tkwin);
+ if (!slaveWindow) {
+ return TCL_ERROR;
+ }
+
+ if (!strcmp(Tcl_GetString(objv[2]), "end")) {
+ destIndex = Ttk_NumberSlaves(pw->paned.mgr);
+ } else if (TCL_OK != Ttk_GetSlaveIndexFromObj(
+ interp,pw->paned.mgr,objv[2],&destIndex))
+ {
+ return TCL_ERROR;
+ }
+
+ srcIndex = Ttk_SlaveIndex(pw->paned.mgr, slaveWindow);
+ if (srcIndex < 0) { /* New slave: */
+ return AddPane(interp, pw, destIndex, slaveWindow, objc-4, objv+4);
+ } /* else -- move existing slave: */
+
+ if (destIndex >= nSlaves)
+ destIndex = nSlaves - 1;
+ Ttk_ReorderSlave(pw->paned.mgr, srcIndex, destIndex);
+
+ return objc == 4 ? TCL_OK :
+ ConfigurePane(interp, pw,
+ Ttk_SlaveData(pw->paned.mgr, destIndex),
+ Ttk_SlaveWindow(pw->paned.mgr, destIndex),
+ objc-4,objv+4);
+}
+
+/* $pw forget $pane
+ */
+static int PanedForgetCommand(
+ void *recordPtr, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[])
+{
+ Paned *pw = recordPtr;
+ int paneIndex;
+
+ if (objc != 3) {
+ Tcl_WrongNumArgs(interp, 2,objv, "pane");
+ return TCL_ERROR;
+ }
+
+ if (TCL_OK != Ttk_GetSlaveIndexFromObj(
+ interp, pw->paned.mgr, objv[2], &paneIndex))
+ {
+ return TCL_ERROR;
+ }
+ Ttk_ForgetSlave(pw->paned.mgr, paneIndex);
+
+ return TCL_OK;
+}
+
+/* $pw identify ?what? $x $y --
+ * Return index of sash at $x,$y
+ */
+static int PanedIdentifyCommand(
+ void *recordPtr, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[])
+{
+ static const char *whatTable[] = { "element", "sash", NULL };
+ enum { IDENTIFY_ELEMENT, IDENTIFY_SASH };
+ int what = IDENTIFY_SASH;
+ Paned *pw = recordPtr;
+ int sashThickness = pw->paned.sashThickness;
+ int nSashes = Ttk_NumberSlaves(pw->paned.mgr) - 1;
+ int x, y, pos;
+ int index;
+
+ if (objc < 4 || objc > 5) {
+ Tcl_WrongNumArgs(interp, 2,objv, "?what? x y");
+ return TCL_ERROR;
+ }
+
+ if ( Tcl_GetIntFromObj(interp, objv[objc-2], &x) != TCL_OK
+ || Tcl_GetIntFromObj(interp, objv[objc-1], &y) != TCL_OK
+ || (objc == 5 && Tcl_GetIndexFromObjStruct(interp, objv[2], whatTable,
+ sizeof(char *), "option", 0, &what) != TCL_OK)
+ ) {
+ return TCL_ERROR;
+ }
+
+ pos = pw->paned.orient == TTK_ORIENT_HORIZONTAL ? x : y;
+ for (index = 0; index < nSashes; ++index) {
+ Pane *pane = Ttk_SlaveData(pw->paned.mgr, index);
+ if (pane->sashPos <= pos && pos <= pane->sashPos + sashThickness) {
+ /* Found it. */
+ switch (what) {
+ case IDENTIFY_SASH:
+ Tcl_SetObjResult(interp, Tcl_NewIntObj(index));
+ return TCL_OK;
+ case IDENTIFY_ELEMENT:
+ {
+ Ttk_Element element =
+ Ttk_IdentifyElement(SashLayout(pw, index), x, y);
+ if (element) {
+ Tcl_SetObjResult(interp,
+ Tcl_NewStringObj(Ttk_ElementName(element), -1));
+ }
+ return TCL_OK;
+ }
+ }
+ }
+ }
+
+ return TCL_OK; /* nothing found - return empty string */
+}
+
+/* $pw pane $pane ?-option ?value -option value ...??
+ * Query/modify pane options.
+ */
+static int PanedPaneCommand(
+ void *recordPtr, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[])
+{
+ Paned *pw = recordPtr;
+ int paneIndex;
+ Tk_Window slaveWindow;
+ Pane *pane;
+
+ if (objc < 3) {
+ Tcl_WrongNumArgs(interp, 2,objv, "pane ?-option value ...?");
+ return TCL_ERROR;
+ }
+
+ if (TCL_OK != Ttk_GetSlaveIndexFromObj(
+ interp,pw->paned.mgr,objv[2],&paneIndex))
+ {
+ return TCL_ERROR;
+ }
+
+ pane = Ttk_SlaveData(pw->paned.mgr, paneIndex);
+ slaveWindow = Ttk_SlaveWindow(pw->paned.mgr, paneIndex);
+
+ switch (objc) {
+ case 3:
+ return TtkEnumerateOptions(interp, pane, PaneOptionSpecs,
+ pw->paned.paneOptionTable, slaveWindow);
+ case 4:
+ return TtkGetOptionValue(interp, pane, objv[3],
+ pw->paned.paneOptionTable, slaveWindow);
+ default:
+ return ConfigurePane(interp, pw, pane, slaveWindow, objc-3,objv+3);
+ }
+}
+
+/* $pw panes --
+ * Return list of managed panes.
+ */
+static int PanedPanesCommand(
+ void *recordPtr, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[])
+{
+ Paned *pw = recordPtr;
+ Ttk_Manager *mgr = pw->paned.mgr;
+ Tcl_Obj *panes;
+ int i;
+
+ if (objc != 2) {
+ Tcl_WrongNumArgs(interp, 2, objv, "");
+ return TCL_ERROR;
+ }
+
+ panes = Tcl_NewListObj(0, NULL);
+ for (i = 0; i < Ttk_NumberSlaves(mgr); ++i) {
+ const char *pathName = Tk_PathName(Ttk_SlaveWindow(mgr,i));
+ Tcl_ListObjAppendElement(interp, panes, Tcl_NewStringObj(pathName,-1));
+ }
+ Tcl_SetObjResult(interp, panes);
+
+ return TCL_OK;
+}
+
+
+/* $pw sashpos $index ?$newpos?
+ * Query or modify sash position.
+ */
+static int PanedSashposCommand(
+ void *recordPtr, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[])
+{
+ Paned *pw = recordPtr;
+ int sashIndex, position = -1;
+ Pane *pane;
+
+ if (objc < 3 || objc > 4) {
+ Tcl_WrongNumArgs(interp, 2,objv, "index ?newpos?");
+ return TCL_ERROR;
+ }
+ if (Tcl_GetIntFromObj(interp, objv[2], &sashIndex) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (sashIndex < 0 || sashIndex >= Ttk_NumberSlaves(pw->paned.mgr) - 1) {
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "sash index %d out of range", sashIndex));
+ Tcl_SetErrorCode(interp, "TTK", "PANE", "SASH_INDEX", NULL);
+ return TCL_ERROR;
+ }
+
+ pane = Ttk_SlaveData(pw->paned.mgr, sashIndex);
+
+ if (objc == 3) {
+ Tcl_SetObjResult(interp, Tcl_NewIntObj(pane->sashPos));
+ return TCL_OK;
+ }
+ /* else -- set new sash position */
+
+ if (Tcl_GetIntFromObj(interp, objv[3], &position) != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ if (position < pane->sashPos) {
+ ShoveUp(pw, sashIndex, position);
+ } else {
+ ShoveDown(pw, sashIndex, position);
+ }
+
+ AdjustPanes(pw);
+ Ttk_ManagerLayoutChanged(pw->paned.mgr);
+
+ Tcl_SetObjResult(interp, Tcl_NewIntObj(pane->sashPos));
+ return TCL_OK;
+}
+
+static const Ttk_Ensemble PanedCommands[] = {
+ { "add", PanedAddCommand,0 },
+ { "configure", TtkWidgetConfigureCommand,0 },
+ { "cget", TtkWidgetCgetCommand,0 },
+ { "forget", PanedForgetCommand,0 },
+ { "identify", PanedIdentifyCommand,0 },
+ { "insert", PanedInsertCommand,0 },
+ { "instate", TtkWidgetInstateCommand,0 },
+ { "pane", PanedPaneCommand,0 },
+ { "panes", PanedPanesCommand,0 },
+ { "sashpos", PanedSashposCommand,0 },
+ { "state", TtkWidgetStateCommand,0 },
+ { 0,0,0 }
+};
+
+/*------------------------------------------------------------------------
+ * +++ Widget specification.
+ */
+
+static WidgetSpec PanedWidgetSpec =
+{
+ "TPanedwindow", /* className */
+ sizeof(Paned), /* recordSize */
+ PanedOptionSpecs, /* optionSpecs */
+ PanedCommands, /* subcommands */
+ PanedInitialize, /* initializeProc */
+ PanedCleanup, /* cleanupProc */
+ TtkCoreConfigure, /* configureProc */
+ PanedPostConfigure, /* postConfigureProc */
+ PanedGetLayout, /* getLayoutProc */
+ PanedSize, /* sizeProc */
+ TtkWidgetDoLayout, /* layoutProc */
+ PanedDisplay /* displayProc */
+};
+
+/*------------------------------------------------------------------------
+ * +++ Elements and layouts.
+ */
+
+static const int DEFAULT_SASH_THICKNESS = 5;
+
+typedef struct {
+ Tcl_Obj *thicknessObj;
+} SashElement;
+
+static Ttk_ElementOptionSpec SashElementOptions[] = {
+ { "-sashthickness", TK_OPTION_INT,
+ Tk_Offset(SashElement,thicknessObj), "5" },
+ { NULL, 0, 0, NULL }
+};
+
+static void SashElementSize(
+ void *clientData, void *elementRecord, Tk_Window tkwin,
+ int *widthPtr, int *heightPtr, Ttk_Padding *paddingPtr)
+{
+ SashElement *sash = elementRecord;
+ int thickness = DEFAULT_SASH_THICKNESS;
+ Tcl_GetIntFromObj(NULL, sash->thicknessObj, &thickness);
+ *widthPtr = *heightPtr = thickness;
+}
+
+static Ttk_ElementSpec SashElementSpec = {
+ TK_STYLE_VERSION_2,
+ sizeof(SashElement),
+ SashElementOptions,
+ SashElementSize,
+ TtkNullElementDraw
+};
+
+TTK_BEGIN_LAYOUT(PanedLayout)
+ TTK_NODE("Panedwindow.background", 0)/* @@@ BUG: empty layouts don't work */
+TTK_END_LAYOUT
+
+TTK_BEGIN_LAYOUT(HorizontalSashLayout)
+ TTK_NODE("Sash.hsash", TTK_FILL_X)
+TTK_END_LAYOUT
+
+TTK_BEGIN_LAYOUT(VerticalSashLayout)
+ TTK_NODE("Sash.vsash", TTK_FILL_Y)
+TTK_END_LAYOUT
+
+/*------------------------------------------------------------------------
+ * +++ Registration routine.
+ */
+MODULE_SCOPE
+void TtkPanedwindow_Init(Tcl_Interp *interp)
+{
+ Ttk_Theme themePtr = Ttk_GetDefaultTheme(interp);
+ RegisterWidget(interp, "ttk::panedwindow", &PanedWidgetSpec);
+
+ Ttk_RegisterElement(interp, themePtr, "hsash", &SashElementSpec, 0);
+ Ttk_RegisterElement(interp, themePtr, "vsash", &SashElementSpec, 0);
+
+ Ttk_RegisterLayout(themePtr, "TPanedwindow", PanedLayout);
+ Ttk_RegisterLayout(themePtr, "Horizontal.Sash", HorizontalSashLayout);
+ Ttk_RegisterLayout(themePtr, "Vertical.Sash", VerticalSashLayout);
+}
+
diff --git a/tk8.6/generic/ttk/ttkProgress.c b/tk8.6/generic/ttk/ttkProgress.c
new file mode 100644
index 0000000..4dc50a2
--- /dev/null
+++ b/tk8.6/generic/ttk/ttkProgress.c
@@ -0,0 +1,545 @@
+/*
+ * Copyright (c) Joe English, Pat Thoyts, Michael Kirkham
+ *
+ * ttk::progressbar widget.
+ */
+
+#include <math.h>
+#include <tk.h>
+
+#include "ttkTheme.h"
+#include "ttkWidget.h"
+
+/*------------------------------------------------------------------------
+ * +++ Widget record:
+ */
+
+#define DEF_PROGRESSBAR_LENGTH "100"
+enum {
+ TTK_PROGRESSBAR_DETERMINATE, TTK_PROGRESSBAR_INDETERMINATE
+};
+static const char *const ProgressbarModeStrings[] = {
+ "determinate", "indeterminate", NULL
+};
+
+typedef struct {
+ Tcl_Obj *orientObj;
+ Tcl_Obj *lengthObj;
+ Tcl_Obj *modeObj;
+ Tcl_Obj *variableObj;
+ Tcl_Obj *maximumObj;
+ Tcl_Obj *valueObj;
+ Tcl_Obj *phaseObj;
+
+ int mode;
+ Ttk_TraceHandle *variableTrace; /* Trace handle for -variable option */
+ int period; /* Animation period */
+ int maxPhase; /* Max animation phase */
+ Tcl_TimerToken timer; /* Animation timer */
+
+} ProgressbarPart;
+
+typedef struct {
+ WidgetCore core;
+ ProgressbarPart progress;
+} Progressbar;
+
+static Tk_OptionSpec ProgressbarOptionSpecs[] =
+{
+ {TK_OPTION_STRING_TABLE, "-orient", "orient", "Orient",
+ "horizontal", Tk_Offset(Progressbar,progress.orientObj), -1,
+ 0, (ClientData)ttkOrientStrings, STYLE_CHANGED },
+ {TK_OPTION_PIXELS, "-length", "length", "Length",
+ DEF_PROGRESSBAR_LENGTH, Tk_Offset(Progressbar,progress.lengthObj), -1,
+ 0, 0, GEOMETRY_CHANGED },
+ {TK_OPTION_STRING_TABLE, "-mode", "mode", "ProgressMode", "determinate",
+ Tk_Offset(Progressbar,progress.modeObj),
+ Tk_Offset(Progressbar,progress.mode),
+ 0, (ClientData)ProgressbarModeStrings, 0 },
+ {TK_OPTION_DOUBLE, "-maximum", "maximum", "Maximum",
+ "100", Tk_Offset(Progressbar,progress.maximumObj), -1,
+ 0, 0, 0 },
+ {TK_OPTION_STRING, "-variable", "variable", "Variable",
+ NULL, Tk_Offset(Progressbar,progress.variableObj), -1,
+ TK_OPTION_NULL_OK, 0, 0 },
+ {TK_OPTION_DOUBLE, "-value", "value", "Value",
+ "0.0", Tk_Offset(Progressbar,progress.valueObj), -1,
+ 0, 0, 0 },
+ {TK_OPTION_INT, "-phase", "phase", "Phase",
+ "0", Tk_Offset(Progressbar,progress.phaseObj), -1,
+ 0, 0, 0 },
+
+ WIDGET_TAKEFOCUS_FALSE,
+ WIDGET_INHERIT_OPTIONS(ttkCoreOptionSpecs)
+};
+
+/*------------------------------------------------------------------------
+ * +++ Animation procedures:
+ */
+
+/* AnimationEnabled --
+ * Returns 1 if animation should be active, 0 otherwise.
+ */
+static int AnimationEnabled(Progressbar *pb)
+{
+ double maximum = 100, value = 0;
+
+ Tcl_GetDoubleFromObj(NULL, pb->progress.maximumObj, &maximum);
+ Tcl_GetDoubleFromObj(NULL, pb->progress.valueObj, &value);
+
+ return pb->progress.period > 0
+ && value > 0.0
+ && ( value < maximum
+ || pb->progress.mode == TTK_PROGRESSBAR_INDETERMINATE);
+}
+
+/* AnimateProgressProc --
+ * Timer callback for progress bar animation.
+ * Increments the -phase option, redisplays the widget,
+ * and reschedules itself if animation still enabled.
+ */
+static void AnimateProgressProc(ClientData clientData)
+{
+ Progressbar *pb = clientData;
+
+ pb->progress.timer = 0;
+
+ if (AnimationEnabled(pb)) {
+ int phase = 0;
+ Tcl_GetIntFromObj(NULL, pb->progress.phaseObj, &phase);
+
+ /*
+ * Update -phase:
+ */
+ ++phase;
+ if (pb->progress.maxPhase)
+ phase %= pb->progress.maxPhase;
+ Tcl_DecrRefCount(pb->progress.phaseObj);
+ pb->progress.phaseObj = Tcl_NewIntObj(phase);
+ Tcl_IncrRefCount(pb->progress.phaseObj);
+
+ /*
+ * Reschedule:
+ */
+ pb->progress.timer = Tcl_CreateTimerHandler(
+ pb->progress.period, AnimateProgressProc, clientData);
+
+ TtkRedisplayWidget(&pb->core);
+ }
+}
+
+/* CheckAnimation --
+ * If animation is enabled and not scheduled, schedule it.
+ * If animation is disabled but scheduled, cancel it.
+ */
+static void CheckAnimation(Progressbar *pb)
+{
+ if (AnimationEnabled(pb)) {
+ if (pb->progress.timer == 0) {
+ pb->progress.timer = Tcl_CreateTimerHandler(
+ pb->progress.period, AnimateProgressProc, (ClientData)pb);
+ }
+ } else {
+ if (pb->progress.timer != 0) {
+ Tcl_DeleteTimerHandler(pb->progress.timer);
+ pb->progress.timer = 0;
+ }
+ }
+}
+
+/*------------------------------------------------------------------------
+ * +++ Trace hook for progressbar -variable option:
+ */
+
+static void VariableChanged(void *recordPtr, const char *value)
+{
+ Progressbar *pb = recordPtr;
+ Tcl_Obj *newValue;
+ double scratch;
+
+ if (WidgetDestroyed(&pb->core)) {
+ return;
+ }
+
+ if (!value) {
+ /* Linked variable is unset -- disable widget */
+ TtkWidgetChangeState(&pb->core, TTK_STATE_DISABLED, 0);
+ return;
+ }
+ TtkWidgetChangeState(&pb->core, 0, TTK_STATE_DISABLED);
+
+ newValue = Tcl_NewStringObj(value, -1);
+ Tcl_IncrRefCount(newValue);
+ if (Tcl_GetDoubleFromObj(NULL, newValue, &scratch) != TCL_OK) {
+ TtkWidgetChangeState(&pb->core, TTK_STATE_INVALID, 0);
+ return;
+ }
+ TtkWidgetChangeState(&pb->core, 0, TTK_STATE_INVALID);
+ Tcl_DecrRefCount(pb->progress.valueObj);
+ pb->progress.valueObj = newValue;
+
+ CheckAnimation(pb);
+ TtkRedisplayWidget(&pb->core);
+}
+
+/*------------------------------------------------------------------------
+ * +++ Widget class methods:
+ */
+
+static void ProgressbarInitialize(Tcl_Interp *interp, void *recordPtr)
+{
+ Progressbar *pb = recordPtr;
+ pb->progress.variableTrace = 0;
+ pb->progress.timer = 0;
+}
+
+static void ProgressbarCleanup(void *recordPtr)
+{
+ Progressbar *pb = recordPtr;
+ if (pb->progress.variableTrace)
+ Ttk_UntraceVariable(pb->progress.variableTrace);
+ if (pb->progress.timer)
+ Tcl_DeleteTimerHandler(pb->progress.timer);
+}
+
+/*
+ * Configure hook:
+ *
+ * @@@ TODO: deal with [$pb configure -value ... -variable ...]
+ */
+static int ProgressbarConfigure(Tcl_Interp *interp, void *recordPtr, int mask)
+{
+ Progressbar *pb = recordPtr;
+ Tcl_Obj *varName = pb->progress.variableObj;
+ Ttk_TraceHandle *vt = 0;
+
+ if (varName != NULL && *Tcl_GetString(varName) != '\0') {
+ vt = Ttk_TraceVariable(interp, varName, VariableChanged, recordPtr);
+ if (!vt) return TCL_ERROR;
+ }
+
+ if (TtkCoreConfigure(interp, recordPtr, mask) != TCL_OK) {
+ if (vt) Ttk_UntraceVariable(vt);
+ return TCL_ERROR;
+ }
+
+ if (pb->progress.variableTrace) {
+ Ttk_UntraceVariable(pb->progress.variableTrace);
+ }
+ pb->progress.variableTrace = vt;
+
+ return TCL_OK;
+}
+
+/*
+ * Post-configuration hook:
+ */
+static int ProgressbarPostConfigure(
+ Tcl_Interp *interp, void *recordPtr, int mask)
+{
+ Progressbar *pb = recordPtr;
+ int status = TCL_OK;
+
+ if (pb->progress.variableTrace) {
+ status = Ttk_FireTrace(pb->progress.variableTrace);
+ if (WidgetDestroyed(&pb->core)) {
+ return TCL_ERROR;
+ }
+ if (status != TCL_OK) {
+ /* Unset -variable: */
+ Ttk_UntraceVariable(pb->progress.variableTrace);
+ Tcl_DecrRefCount(pb->progress.variableObj);
+ pb->progress.variableTrace = 0;
+ pb->progress.variableObj = NULL;
+ return TCL_ERROR;
+ }
+ }
+
+ CheckAnimation(pb);
+
+ return status;
+}
+
+/*
+ * Size hook:
+ * Compute base layout size, overrid
+ */
+static int ProgressbarSize(void *recordPtr, int *widthPtr, int *heightPtr)
+{
+ Progressbar *pb = recordPtr;
+ int length = 100, orient = TTK_ORIENT_HORIZONTAL;
+
+ TtkWidgetSize(recordPtr, widthPtr, heightPtr);
+
+ /* Override requested width (height) based on -length and -orient
+ */
+ Tk_GetPixelsFromObj(NULL, pb->core.tkwin, pb->progress.lengthObj, &length);
+ Ttk_GetOrientFromObj(NULL, pb->progress.orientObj, &orient);
+
+ if (orient == TTK_ORIENT_HORIZONTAL) {
+ *widthPtr = length;
+ } else {
+ *heightPtr = length;
+ }
+
+ return 1;
+}
+
+/*
+ * Layout hook:
+ * Adjust size and position of pbar element, if present.
+ */
+
+static void ProgressbarDeterminateLayout(
+ Progressbar *pb,
+ Ttk_Element pbar,
+ Ttk_Box parcel,
+ double fraction,
+ Ttk_Orient orient)
+{
+ if (fraction < 0.0) fraction = 0.0;
+ if (fraction > 1.0) fraction = 1.0;
+
+ if (orient == TTK_ORIENT_HORIZONTAL) {
+ parcel.width = (int)(parcel.width * fraction);
+ } else {
+ int newHeight = (int)(parcel.height * fraction);
+ parcel.y += (parcel.height - newHeight);
+ parcel.height = newHeight;
+ }
+ Ttk_PlaceElement(pb->core.layout, pbar, parcel);
+}
+
+static void ProgressbarIndeterminateLayout(
+ Progressbar *pb,
+ Ttk_Element pbar,
+ Ttk_Box parcel,
+ double fraction,
+ Ttk_Orient orient)
+{
+ Ttk_Box pbarBox = Ttk_ElementParcel(pbar);
+
+ fraction = fmod(fabs(fraction), 2.0);
+ if (fraction > 1.0) {
+ fraction = 2.0 - fraction;
+ }
+
+ if (orient == TTK_ORIENT_HORIZONTAL) {
+ pbarBox.x = parcel.x + (int)(fraction * (parcel.width-pbarBox.width));
+ } else {
+ pbarBox.y = parcel.y + (int)(fraction * (parcel.height-pbarBox.height));
+ }
+ Ttk_PlaceElement(pb->core.layout, pbar, pbarBox);
+}
+
+static void ProgressbarDoLayout(void *recordPtr)
+{
+ Progressbar *pb = recordPtr;
+ WidgetCore *corePtr = &pb->core;
+ Ttk_Element pbar = Ttk_FindElement(corePtr->layout, "pbar");
+ double value = 0.0, maximum = 100.0;
+ int orient = TTK_ORIENT_HORIZONTAL;
+
+ Ttk_PlaceLayout(corePtr->layout,corePtr->state,Ttk_WinBox(corePtr->tkwin));
+
+ /* Adjust the bar size:
+ */
+
+ Tcl_GetDoubleFromObj(NULL, pb->progress.valueObj, &value);
+ Tcl_GetDoubleFromObj(NULL, pb->progress.maximumObj, &maximum);
+ Ttk_GetOrientFromObj(NULL, pb->progress.orientObj, &orient);
+
+ if (pbar) {
+ double fraction = value / maximum;
+ Ttk_Box parcel = Ttk_ClientRegion(corePtr->layout, "trough");
+
+ if (pb->progress.mode == TTK_PROGRESSBAR_DETERMINATE) {
+ ProgressbarDeterminateLayout(
+ pb, pbar, parcel, fraction, orient);
+ } else {
+ ProgressbarIndeterminateLayout(
+ pb, pbar, parcel, fraction, orient);
+ }
+ }
+}
+
+static Ttk_Layout ProgressbarGetLayout(
+ Tcl_Interp *interp, Ttk_Theme theme, void *recordPtr)
+{
+ Progressbar *pb = recordPtr;
+ Ttk_Layout layout = TtkWidgetGetOrientedLayout(
+ interp, theme, recordPtr, pb->progress.orientObj);
+
+ /*
+ * Check if the style supports animation:
+ */
+ pb->progress.period = 0;
+ pb->progress.maxPhase = 0;
+ if (layout) {
+ Tcl_Obj *periodObj = Ttk_QueryOption(layout,"-period", 0);
+ Tcl_Obj *maxPhaseObj = Ttk_QueryOption(layout,"-maxphase", 0);
+ if (periodObj)
+ Tcl_GetIntFromObj(NULL, periodObj, &pb->progress.period);
+ if (maxPhaseObj)
+ Tcl_GetIntFromObj(NULL, maxPhaseObj, &pb->progress.maxPhase);
+ }
+
+ return layout;
+}
+
+/*------------------------------------------------------------------------
+ * +++ Widget commands:
+ */
+
+/* $sb step ?amount?
+ */
+static int ProgressbarStepCommand(
+ void *recordPtr, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[])
+{
+ Progressbar *pb = recordPtr;
+ double value = 0.0, stepAmount = 1.0;
+ Tcl_Obj *newValueObj;
+
+ if (objc == 3) {
+ if (Tcl_GetDoubleFromObj(interp, objv[2], &stepAmount) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ } else if (objc != 2) {
+ Tcl_WrongNumArgs(interp, 2,objv, "?stepAmount?");
+ return TCL_ERROR;
+ }
+
+ (void)Tcl_GetDoubleFromObj(NULL, pb->progress.valueObj, &value);
+ value += stepAmount;
+
+ /* In determinate mode, wrap around if value exceeds maximum:
+ */
+ if (pb->progress.mode == TTK_PROGRESSBAR_DETERMINATE) {
+ double maximum = 100.0;
+ (void)Tcl_GetDoubleFromObj(NULL, pb->progress.maximumObj, &maximum);
+ value = fmod(value, maximum);
+ }
+
+ newValueObj = Tcl_NewDoubleObj(value);
+
+ TtkRedisplayWidget(&pb->core);
+
+ /* Update value by setting the linked -variable, if there is one:
+ */
+ if (pb->progress.variableTrace) {
+ return Tcl_ObjSetVar2(
+ interp, pb->progress.variableObj, 0, newValueObj,
+ TCL_GLOBAL_ONLY | TCL_LEAVE_ERR_MSG)
+ ? TCL_OK : TCL_ERROR;
+ }
+
+ /* Otherwise, change the -value directly:
+ */
+ Tcl_IncrRefCount(newValueObj);
+ Tcl_DecrRefCount(pb->progress.valueObj);
+ pb->progress.valueObj = newValueObj;
+ CheckAnimation(pb);
+
+ return TCL_OK;
+}
+
+/* $sb start|stop ?args? --
+ * Change [$sb $cmd ...] to [ttk::progressbar::$cmd ...]
+ * and pass to interpreter.
+ */
+static int ProgressbarStartStopCommand(
+ Tcl_Interp *interp, const char *cmdName, int objc, Tcl_Obj *const objv[])
+{
+ Tcl_Obj *cmd = Tcl_NewListObj(objc, objv);
+ Tcl_Obj *prefix[2];
+ int status;
+
+ /* ASSERT: objc >= 2 */
+
+ prefix[0] = Tcl_NewStringObj(cmdName, -1);
+ prefix[1] = objv[0];
+ Tcl_ListObjReplace(interp, cmd, 0,2, 2,prefix);
+
+ Tcl_IncrRefCount(cmd);
+ status = Tcl_EvalObjEx(interp, cmd, 0);
+ Tcl_DecrRefCount(cmd);
+
+ return status;
+}
+
+static int ProgressbarStartCommand(
+ void *recordPtr, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[])
+{
+ return ProgressbarStartStopCommand(
+ interp, "::ttk::progressbar::start", objc, objv);
+}
+
+static int ProgressbarStopCommand(
+ void *recordPtr, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[])
+{
+ return ProgressbarStartStopCommand(
+ interp, "::ttk::progressbar::stop", objc, objv);
+}
+
+static const Ttk_Ensemble ProgressbarCommands[] = {
+ { "configure", TtkWidgetConfigureCommand,0 },
+ { "cget", TtkWidgetCgetCommand,0 },
+ { "identify", TtkWidgetIdentifyCommand,0 },
+ { "instate", TtkWidgetInstateCommand,0 },
+ { "start", ProgressbarStartCommand,0 },
+ { "state", TtkWidgetStateCommand,0 },
+ { "step", ProgressbarStepCommand,0 },
+ { "stop", ProgressbarStopCommand,0 },
+ { 0,0,0 }
+};
+
+/*
+ * Widget specification:
+ */
+static WidgetSpec ProgressbarWidgetSpec =
+{
+ "TProgressbar", /* className */
+ sizeof(Progressbar), /* recordSize */
+ ProgressbarOptionSpecs, /* optionSpecs */
+ ProgressbarCommands, /* subcommands */
+ ProgressbarInitialize, /* initializeProc */
+ ProgressbarCleanup, /* cleanupProc */
+ ProgressbarConfigure, /* configureProc */
+ ProgressbarPostConfigure, /* postConfigureProc */
+ ProgressbarGetLayout, /* getLayoutProc */
+ ProgressbarSize, /* sizeProc */
+ ProgressbarDoLayout, /* layoutProc */
+ TtkWidgetDisplay /* displayProc */
+};
+
+/*
+ * Layouts:
+ */
+TTK_BEGIN_LAYOUT(VerticalProgressbarLayout)
+ TTK_GROUP("Vertical.Progressbar.trough", TTK_FILL_BOTH,
+ TTK_NODE("Vertical.Progressbar.pbar", TTK_PACK_BOTTOM|TTK_FILL_X))
+TTK_END_LAYOUT
+
+TTK_BEGIN_LAYOUT(HorizontalProgressbarLayout)
+ TTK_GROUP("Horizontal.Progressbar.trough", TTK_FILL_BOTH,
+ TTK_NODE("Horizontal.Progressbar.pbar", TTK_PACK_LEFT|TTK_FILL_Y))
+TTK_END_LAYOUT
+
+/*
+ * Initialization:
+ */
+
+MODULE_SCOPE
+void TtkProgressbar_Init(Tcl_Interp *interp)
+{
+ Ttk_Theme themePtr = Ttk_GetDefaultTheme(interp);
+
+ Ttk_RegisterLayout(themePtr,
+ "Vertical.TProgressbar", VerticalProgressbarLayout);
+ Ttk_RegisterLayout(themePtr,
+ "Horizontal.TProgressbar", HorizontalProgressbarLayout);
+
+ RegisterWidget(interp, "ttk::progressbar", &ProgressbarWidgetSpec);
+}
+
+/*EOF*/
diff --git a/tk8.6/generic/ttk/ttkScale.c b/tk8.6/generic/ttk/ttkScale.c
new file mode 100644
index 0000000..69753d1
--- /dev/null
+++ b/tk8.6/generic/ttk/ttkScale.c
@@ -0,0 +1,515 @@
+/*
+ * Copyright (C) 2004 Pat Thoyts <patthoyts@users.sourceforge.net>
+ *
+ * ttk::scale widget.
+ */
+
+#include <tk.h>
+#include <string.h>
+#include <stdio.h>
+#include "ttkTheme.h"
+#include "ttkWidget.h"
+
+#define DEF_SCALE_LENGTH "100"
+
+#define MAX(a,b) ((a) > (b) ? (a) : (b))
+#define MIN(a,b) ((a) < (b) ? (a) : (b))
+
+/*
+ * Scale widget record
+ */
+typedef struct
+{
+ /* slider element options */
+ Tcl_Obj *fromObj; /* minimum value */
+ Tcl_Obj *toObj; /* maximum value */
+ Tcl_Obj *valueObj; /* current value */
+ Tcl_Obj *lengthObj; /* length of the long axis of the scale */
+ Tcl_Obj *orientObj; /* widget orientation */
+ int orient;
+
+ /* widget options */
+ Tcl_Obj *commandObj;
+ Tcl_Obj *variableObj;
+
+ /* internal state */
+ Ttk_TraceHandle *variableTrace;
+
+} ScalePart;
+
+typedef struct
+{
+ WidgetCore core;
+ ScalePart scale;
+} Scale;
+
+static Tk_OptionSpec ScaleOptionSpecs[] =
+{
+ {TK_OPTION_STRING, "-command", "command", "Command", "",
+ Tk_Offset(Scale,scale.commandObj), -1,
+ TK_OPTION_NULL_OK,0,0},
+ {TK_OPTION_STRING, "-variable", "variable", "Variable", "",
+ Tk_Offset(Scale,scale.variableObj), -1,
+ 0,0,0},
+ {TK_OPTION_STRING_TABLE, "-orient", "orient", "Orient", "horizontal",
+ Tk_Offset(Scale,scale.orientObj),
+ Tk_Offset(Scale,scale.orient), 0,
+ (ClientData)ttkOrientStrings, STYLE_CHANGED },
+
+ {TK_OPTION_DOUBLE, "-from", "from", "From", "0",
+ Tk_Offset(Scale,scale.fromObj), -1, 0, 0, 0},
+ {TK_OPTION_DOUBLE, "-to", "to", "To", "1.0",
+ Tk_Offset(Scale,scale.toObj), -1, 0, 0, 0},
+ {TK_OPTION_DOUBLE, "-value", "value", "Value", "0",
+ Tk_Offset(Scale,scale.valueObj), -1, 0, 0, 0},
+ {TK_OPTION_PIXELS, "-length", "length", "Length",
+ DEF_SCALE_LENGTH, Tk_Offset(Scale,scale.lengthObj), -1, 0, 0,
+ GEOMETRY_CHANGED},
+
+ WIDGET_TAKEFOCUS_TRUE,
+ WIDGET_INHERIT_OPTIONS(ttkCoreOptionSpecs)
+};
+
+static XPoint ValueToPoint(Scale *scalePtr, double value);
+static double PointToValue(Scale *scalePtr, int x, int y);
+
+/* ScaleVariableChanged --
+ * Variable trace procedure for scale -variable;
+ * Updates the scale's value.
+ * If the linked variable is not a valid double,
+ * sets the 'invalid' state.
+ */
+static void ScaleVariableChanged(void *recordPtr, const char *value)
+{
+ Scale *scale = recordPtr;
+ double v;
+
+ if (value == NULL || Tcl_GetDouble(0, value, &v) != TCL_OK) {
+ TtkWidgetChangeState(&scale->core, TTK_STATE_INVALID, 0);
+ } else {
+ Tcl_Obj *valueObj = Tcl_NewDoubleObj(v);
+ Tcl_IncrRefCount(valueObj);
+ Tcl_DecrRefCount(scale->scale.valueObj);
+ scale->scale.valueObj = valueObj;
+ TtkWidgetChangeState(&scale->core, 0, TTK_STATE_INVALID);
+ }
+ TtkRedisplayWidget(&scale->core);
+}
+
+/* ScaleInitialize --
+ * Scale widget initialization hook.
+ */
+static void ScaleInitialize(Tcl_Interp *interp, void *recordPtr)
+{
+ Scale *scalePtr = recordPtr;
+ TtkTrackElementState(&scalePtr->core);
+}
+
+static void ScaleCleanup(void *recordPtr)
+{
+ Scale *scale = recordPtr;
+
+ if (scale->scale.variableTrace) {
+ Ttk_UntraceVariable(scale->scale.variableTrace);
+ scale->scale.variableTrace = 0;
+ }
+}
+
+/* ScaleConfigure --
+ * Configuration hook.
+ */
+static int ScaleConfigure(Tcl_Interp *interp, void *recordPtr, int mask)
+{
+ Scale *scale = recordPtr;
+ Tcl_Obj *varName = scale->scale.variableObj;
+ Ttk_TraceHandle *vt = 0;
+
+ if (varName != NULL && *Tcl_GetString(varName) != '\0') {
+ vt = Ttk_TraceVariable(interp,varName, ScaleVariableChanged,recordPtr);
+ if (!vt) return TCL_ERROR;
+ }
+
+ if (TtkCoreConfigure(interp, recordPtr, mask) != TCL_OK) {
+ if (vt) Ttk_UntraceVariable(vt);
+ return TCL_ERROR;
+ }
+
+ if (scale->scale.variableTrace) {
+ Ttk_UntraceVariable(scale->scale.variableTrace);
+ }
+ scale->scale.variableTrace = vt;
+
+ return TCL_OK;
+}
+
+/* ScalePostConfigure --
+ * Post-configuration hook.
+ */
+static int ScalePostConfigure(
+ Tcl_Interp *interp, void *recordPtr, int mask)
+{
+ Scale *scale = recordPtr;
+ int status = TCL_OK;
+
+ if (scale->scale.variableTrace) {
+ status = Ttk_FireTrace(scale->scale.variableTrace);
+ if (WidgetDestroyed(&scale->core)) {
+ return TCL_ERROR;
+ }
+ if (status != TCL_OK) {
+ /* Unset -variable: */
+ Ttk_UntraceVariable(scale->scale.variableTrace);
+ Tcl_DecrRefCount(scale->scale.variableObj);
+ scale->scale.variableTrace = 0;
+ scale->scale.variableObj = NULL;
+ status = TCL_ERROR;
+ }
+ }
+
+ return status;
+}
+
+/* ScaleGetLayout --
+ * getLayout hook.
+ */
+static Ttk_Layout
+ScaleGetLayout(Tcl_Interp *interp, Ttk_Theme theme, void *recordPtr)
+{
+ Scale *scalePtr = recordPtr;
+ return TtkWidgetGetOrientedLayout(
+ interp, theme, recordPtr, scalePtr->scale.orientObj);
+}
+
+/*
+ * TroughBox --
+ * Returns the inner area of the trough element.
+ */
+static Ttk_Box TroughBox(Scale *scalePtr)
+{
+ return Ttk_ClientRegion(scalePtr->core.layout, "trough");
+}
+
+/*
+ * TroughRange --
+ * Return the value area of the trough element, adjusted
+ * for slider size.
+ */
+static Ttk_Box TroughRange(Scale *scalePtr)
+{
+ Ttk_Box troughBox = TroughBox(scalePtr);
+ Ttk_Element slider = Ttk_FindElement(scalePtr->core.layout,"slider");
+
+ /*
+ * If this is a scale widget, adjust range for slider:
+ */
+ if (slider) {
+ Ttk_Box sliderBox = Ttk_ElementParcel(slider);
+ if (scalePtr->scale.orient == TTK_ORIENT_HORIZONTAL) {
+ troughBox.x += sliderBox.width / 2;
+ troughBox.width -= sliderBox.width;
+ } else {
+ troughBox.y += sliderBox.height / 2;
+ troughBox.height -= sliderBox.height;
+ }
+ }
+
+ return troughBox;
+}
+
+/*
+ * ScaleFraction --
+ */
+static double ScaleFraction(Scale *scalePtr, double value)
+{
+ double from = 0, to = 1, fraction;
+
+ Tcl_GetDoubleFromObj(NULL, scalePtr->scale.fromObj, &from);
+ Tcl_GetDoubleFromObj(NULL, scalePtr->scale.toObj, &to);
+
+ if (from == to) {
+ return 1.0;
+ }
+
+ fraction = (value - from) / (to - from);
+
+ return fraction < 0 ? 0 : fraction > 1 ? 1 : fraction;
+}
+
+/* $scale get ?x y? --
+ * Returns the current value of the scale widget, or if $x and
+ * $y are specified, the value represented by point @x,y.
+ */
+static int
+ScaleGetCommand(
+ void *recordPtr, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[])
+{
+ Scale *scalePtr = recordPtr;
+ int x, y, r = TCL_OK;
+ double value = 0;
+
+ if ((objc != 2) && (objc != 4)) {
+ Tcl_WrongNumArgs(interp, 1, objv, "get ?x y?");
+ return TCL_ERROR;
+ }
+ if (objc == 2) {
+ Tcl_SetObjResult(interp, scalePtr->scale.valueObj);
+ } else {
+ r = Tcl_GetIntFromObj(interp, objv[2], &x);
+ if (r == TCL_OK)
+ r = Tcl_GetIntFromObj(interp, objv[3], &y);
+ if (r == TCL_OK) {
+ value = PointToValue(scalePtr, x, y);
+ Tcl_SetObjResult(interp, Tcl_NewDoubleObj(value));
+ }
+ }
+ return r;
+}
+
+/* $scale set $newValue
+ */
+static int
+ScaleSetCommand(
+ void *recordPtr, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[])
+{
+ Scale *scalePtr = recordPtr;
+ double from = 0.0, to = 1.0, value;
+ int result = TCL_OK;
+
+ if (objc != 3) {
+ Tcl_WrongNumArgs(interp, 1, objv, "set value");
+ return TCL_ERROR;
+ }
+
+ if (Tcl_GetDoubleFromObj(interp, objv[2], &value) != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ if (scalePtr->core.state & TTK_STATE_DISABLED) {
+ return TCL_OK;
+ }
+
+ /* ASSERT: fromObj and toObj are valid doubles.
+ */
+ Tcl_GetDoubleFromObj(interp, scalePtr->scale.fromObj, &from);
+ Tcl_GetDoubleFromObj(interp, scalePtr->scale.toObj, &to);
+
+ /* Limit new value to between 'from' and 'to':
+ */
+ if (from < to) {
+ value = value < from ? from : value > to ? to : value;
+ } else {
+ value = value < to ? to : value > from ? from : value;
+ }
+
+ /*
+ * Set value:
+ */
+ Tcl_DecrRefCount(scalePtr->scale.valueObj);
+ scalePtr->scale.valueObj = Tcl_NewDoubleObj(value);
+ Tcl_IncrRefCount(scalePtr->scale.valueObj);
+ TtkRedisplayWidget(&scalePtr->core);
+
+ /*
+ * Set attached variable, if any:
+ */
+ if (scalePtr->scale.variableObj != NULL) {
+ Tcl_ObjSetVar2(interp, scalePtr->scale.variableObj, NULL,
+ scalePtr->scale.valueObj, TCL_GLOBAL_ONLY);
+ }
+ if (WidgetDestroyed(&scalePtr->core)) {
+ return TCL_ERROR;
+ }
+
+ /*
+ * Invoke -command, if any:
+ */
+ if (scalePtr->scale.commandObj != NULL) {
+ Tcl_Obj *cmdObj = Tcl_DuplicateObj(scalePtr->scale.commandObj);
+ Tcl_IncrRefCount(cmdObj);
+ Tcl_AppendToObj(cmdObj, " ", 1);
+ Tcl_AppendObjToObj(cmdObj, scalePtr->scale.valueObj);
+ result = Tcl_EvalObjEx(interp, cmdObj, TCL_EVAL_GLOBAL);
+ Tcl_DecrRefCount(cmdObj);
+ }
+
+ return result;
+}
+
+static int
+ScaleCoordsCommand(
+ void *recordPtr, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[])
+{
+ Scale *scalePtr = recordPtr;
+ double value;
+ int r = TCL_OK;
+
+ if (objc < 2 || objc > 3) {
+ Tcl_WrongNumArgs(interp, 1, objv, "coords ?value?");
+ return TCL_ERROR;
+ }
+
+ if (objc == 3) {
+ r = Tcl_GetDoubleFromObj(interp, objv[2], &value);
+ } else {
+ r = Tcl_GetDoubleFromObj(interp, scalePtr->scale.valueObj, &value);
+ }
+
+ if (r == TCL_OK) {
+ Tcl_Obj *point[2];
+ XPoint pt = ValueToPoint(scalePtr, value);
+ point[0] = Tcl_NewIntObj(pt.x);
+ point[1] = Tcl_NewIntObj(pt.y);
+ Tcl_SetObjResult(interp, Tcl_NewListObj(2, point));
+ }
+ return r;
+}
+
+static void ScaleDoLayout(void *clientData)
+{
+ WidgetCore *corePtr = clientData;
+ Ttk_Element slider = Ttk_FindElement(corePtr->layout, "slider");
+
+ Ttk_PlaceLayout(corePtr->layout,corePtr->state,Ttk_WinBox(corePtr->tkwin));
+
+ /* Adjust the slider position:
+ */
+ if (slider) {
+ Scale *scalePtr = clientData;
+ Ttk_Box troughBox = TroughBox(scalePtr);
+ Ttk_Box sliderBox = Ttk_ElementParcel(slider);
+ double value = 0.0;
+ double fraction;
+ int range;
+
+ Tcl_GetDoubleFromObj(NULL, scalePtr->scale.valueObj, &value);
+ fraction = ScaleFraction(scalePtr, value);
+
+ if (scalePtr->scale.orient == TTK_ORIENT_HORIZONTAL) {
+ range = troughBox.width - sliderBox.width;
+ sliderBox.x += (int)(fraction * range);
+ } else {
+ range = troughBox.height - sliderBox.height;
+ sliderBox.y += (int)(fraction * range);
+ }
+ Ttk_PlaceElement(corePtr->layout, slider, sliderBox);
+ }
+}
+
+/*
+ * ScaleSize --
+ * Compute requested size of scale.
+ */
+static int ScaleSize(void *clientData, int *widthPtr, int *heightPtr)
+{
+ WidgetCore *corePtr = clientData;
+ Scale *scalePtr = clientData;
+ int length;
+
+ Ttk_LayoutSize(corePtr->layout, corePtr->state, widthPtr, heightPtr);
+
+ /* Assert the -length configuration option */
+ Tk_GetPixelsFromObj(NULL, corePtr->tkwin,
+ scalePtr->scale.lengthObj, &length);
+ if (scalePtr->scale.orient == TTK_ORIENT_VERTICAL) {
+ *heightPtr = MAX(*heightPtr, length);
+ } else {
+ *widthPtr = MAX(*widthPtr, length);
+ }
+
+ return 1;
+}
+
+static double
+PointToValue(Scale *scalePtr, int x, int y)
+{
+ Ttk_Box troughBox = TroughRange(scalePtr);
+ double from = 0, to = 1, fraction;
+
+ Tcl_GetDoubleFromObj(NULL, scalePtr->scale.fromObj, &from);
+ Tcl_GetDoubleFromObj(NULL, scalePtr->scale.toObj, &to);
+
+ if (scalePtr->scale.orient == TTK_ORIENT_HORIZONTAL) {
+ fraction = (double)(x - troughBox.x) / (double)troughBox.width;
+ } else {
+ fraction = (double)(y - troughBox.y) / (double)troughBox.height;
+ }
+
+ fraction = fraction < 0 ? 0 : fraction > 1 ? 1 : fraction;
+
+ return from + fraction * (to-from);
+}
+
+/*
+ * Return the center point in the widget corresponding to the given
+ * value. This point can be used to center the slider.
+ */
+
+static XPoint
+ValueToPoint(Scale *scalePtr, double value)
+{
+ Ttk_Box troughBox = TroughRange(scalePtr);
+ double fraction = ScaleFraction(scalePtr, value);
+ XPoint pt = {0, 0};
+
+ if (scalePtr->scale.orient == TTK_ORIENT_HORIZONTAL) {
+ pt.x = troughBox.x + (int)(fraction * troughBox.width);
+ pt.y = troughBox.y + troughBox.height / 2;
+ } else {
+ pt.x = troughBox.x + troughBox.width / 2;
+ pt.y = troughBox.y + (int)(fraction * troughBox.height);
+ }
+ return pt;
+}
+
+static const Ttk_Ensemble ScaleCommands[] = {
+ { "configure", TtkWidgetConfigureCommand,0 },
+ { "cget", TtkWidgetCgetCommand,0 },
+ { "state", TtkWidgetStateCommand,0 },
+ { "instate", TtkWidgetInstateCommand,0 },
+ { "identify", TtkWidgetIdentifyCommand,0 },
+ { "set", ScaleSetCommand,0 },
+ { "get", ScaleGetCommand,0 },
+ { "coords", ScaleCoordsCommand,0 },
+ { 0,0,0 }
+};
+
+static WidgetSpec ScaleWidgetSpec =
+{
+ "TScale", /* Class name */
+ sizeof(Scale), /* record size */
+ ScaleOptionSpecs, /* option specs */
+ ScaleCommands, /* widget commands */
+ ScaleInitialize, /* initialization proc */
+ ScaleCleanup, /* cleanup proc */
+ ScaleConfigure, /* configure proc */
+ ScalePostConfigure, /* postConfigure */
+ ScaleGetLayout, /* getLayoutProc */
+ ScaleSize, /* sizeProc */
+ ScaleDoLayout, /* layoutProc */
+ TtkWidgetDisplay /* displayProc */
+};
+
+TTK_BEGIN_LAYOUT(VerticalScaleLayout)
+ TTK_GROUP("Vertical.Scale.trough", TTK_FILL_BOTH,
+ TTK_NODE("Vertical.Scale.slider", TTK_PACK_TOP) )
+TTK_END_LAYOUT
+
+TTK_BEGIN_LAYOUT(HorizontalScaleLayout)
+ TTK_GROUP("Horizontal.Scale.trough", TTK_FILL_BOTH,
+ TTK_NODE("Horizontal.Scale.slider", TTK_PACK_LEFT) )
+TTK_END_LAYOUT
+
+/*
+ * Initialization.
+ */
+MODULE_SCOPE
+void TtkScale_Init(Tcl_Interp *interp)
+{
+ Ttk_Theme theme = Ttk_GetDefaultTheme(interp);
+
+ Ttk_RegisterLayout(theme, "Vertical.TScale", VerticalScaleLayout);
+ Ttk_RegisterLayout(theme, "Horizontal.TScale", HorizontalScaleLayout);
+
+ RegisterWidget(interp, "ttk::scale", &ScaleWidgetSpec);
+}
+
diff --git a/tk8.6/generic/ttk/ttkScroll.c b/tk8.6/generic/ttk/ttkScroll.c
new file mode 100644
index 0000000..2bd3ddb
--- /dev/null
+++ b/tk8.6/generic/ttk/ttkScroll.c
@@ -0,0 +1,258 @@
+/*
+ * Copyright 2004, Joe English
+ *
+ * Support routines for scrollable widgets.
+ *
+ * (This is sort of half-baked; needs some work)
+ *
+ * Scrollable interface:
+ *
+ * + 'first' is controlled by [xy]view widget command
+ * and other scrolling commands like 'see';
+ * + 'total' depends on widget contents;
+ * + 'last' depends on first, total, and widget size.
+ *
+ * Choreography (typical usage):
+ *
+ * 1. User adjusts scrollbar, scrollbar widget calls its -command
+ * 2. Scrollbar -command invokes the scrollee [xy]view widget method
+ * 3. TtkScrollviewCommand calls TtkScrollTo(), which updates
+ * 'first' and schedules a redisplay.
+ * 4. Once the scrollee knows 'total' and 'last' (typically in
+ * the LayoutProc), call TtkScrolled(h,first,last,total) to
+ * synchronize the scrollbar.
+ * 5. The scrollee -[xy]scrollcommand is called (in an idle callback)
+ * 6. Which calls the scrollbar 'set' method and redisplays the scrollbar.
+ *
+ * If the scrollee has internal scrolling (e.g., a 'see' method),
+ * it should TtkScrollTo() directly (step 2).
+ *
+ * If the widget value changes, it should call TtkScrolled() (step 4).
+ * (This usually happens automatically when the widget is redisplayed).
+ *
+ * If the scrollee's -[xy]scrollcommand changes, it should call
+ * TtkScrollbarUpdateRequired, which will invoke step (5) (@@@ Fix this)
+ */
+
+#include <tkInt.h>
+#include "ttkTheme.h"
+#include "ttkWidget.h"
+
+/* Private data:
+ */
+#define SCROLL_UPDATE_PENDING (0x1)
+#define SCROLL_UPDATE_REQUIRED (0x2)
+
+struct ScrollHandleRec
+{
+ unsigned flags;
+ WidgetCore *corePtr;
+ Scrollable *scrollPtr;
+};
+
+/* TtkCreateScrollHandle --
+ * Initialize scroll handle.
+ */
+ScrollHandle TtkCreateScrollHandle(WidgetCore *corePtr, Scrollable *scrollPtr)
+{
+ ScrollHandle h = ckalloc(sizeof(*h));
+
+ h->flags = 0;
+ h->corePtr = corePtr;
+ h->scrollPtr = scrollPtr;
+
+ scrollPtr->first = 0;
+ scrollPtr->last = 1;
+ scrollPtr->total = 1;
+ return h;
+}
+
+/* UpdateScrollbar --
+ * Call the -scrollcommand callback to sync the scrollbar.
+ * Returns: Whatever the -scrollcommand does.
+ */
+static int UpdateScrollbar(Tcl_Interp *interp, ScrollHandle h)
+{
+ Scrollable *s = h->scrollPtr;
+ WidgetCore *corePtr = h->corePtr;
+ char arg1[TCL_DOUBLE_SPACE + 2];
+ char arg2[TCL_DOUBLE_SPACE + 2];
+ int code;
+ Tcl_DString buf;
+
+ h->flags &= ~SCROLL_UPDATE_REQUIRED;
+
+ if (s->scrollCmd == NULL) {
+ return TCL_OK;
+ }
+
+ arg1[0] = arg2[0] = ' ';
+ Tcl_PrintDouble(interp, (double)s->first / s->total, arg1+1);
+ Tcl_PrintDouble(interp, (double)s->last / s->total, arg2+1);
+ Tcl_DStringInit(&buf);
+ Tcl_DStringAppend(&buf, s->scrollCmd, -1);
+ Tcl_DStringAppend(&buf, arg1, -1);
+ Tcl_DStringAppend(&buf, arg2, -1);
+
+ Tcl_Preserve(corePtr);
+ code = Tcl_EvalEx(interp, Tcl_DStringValue(&buf), -1, TCL_EVAL_GLOBAL);
+ Tcl_DStringFree(&buf);
+ if (WidgetDestroyed(corePtr)) {
+ Tcl_Release(corePtr);
+ return TCL_ERROR;
+ }
+ Tcl_Release(corePtr);
+
+ if (code != TCL_OK && !Tcl_InterpDeleted(interp)) {
+ /* Disable the -scrollcommand, add to stack trace:
+ */
+ ckfree(s->scrollCmd);
+ s->scrollCmd = 0;
+
+ Tcl_AddErrorInfo(interp, /* @@@ "horizontal" / "vertical" */
+ "\n (scrolling command executed by ");
+ Tcl_AddErrorInfo(interp, Tk_PathName(h->corePtr->tkwin));
+ Tcl_AddErrorInfo(interp, ")");
+ }
+ return code;
+}
+
+/* UpdateScrollbarBG --
+ * Idle handler to update the scrollbar.
+ */
+static void UpdateScrollbarBG(ClientData clientData)
+{
+ ScrollHandle h = (ScrollHandle)clientData;
+ Tcl_Interp *interp = h->corePtr->interp;
+ int code;
+
+ h->flags &= ~SCROLL_UPDATE_PENDING;
+ Tcl_Preserve((ClientData) interp);
+ code = UpdateScrollbar(interp, h);
+ if (code == TCL_ERROR && !Tcl_InterpDeleted(interp)) {
+ Tcl_BackgroundException(interp, code);
+ }
+ Tcl_Release((ClientData) interp);
+}
+
+/* TtkScrolled --
+ * Update scroll info, schedule scrollbar update.
+ */
+void TtkScrolled(ScrollHandle h, int first, int last, int total)
+{
+ Scrollable *s = h->scrollPtr;
+
+ /* Sanity-check inputs:
+ */
+ if (total <= 0) {
+ first = 0;
+ last = 1;
+ total = 1;
+ }
+
+ if (last > total) {
+ first -= (last - total);
+ if (first < 0) first = 0;
+ last = total;
+ }
+
+ if (s->first != first || s->last != last || s->total != total
+ || (h->flags & SCROLL_UPDATE_REQUIRED))
+ {
+ s->first = first;
+ s->last = last;
+ s->total = total;
+
+ if (!(h->flags & SCROLL_UPDATE_PENDING)) {
+ Tcl_DoWhenIdle(UpdateScrollbarBG, (ClientData)h);
+ h->flags |= SCROLL_UPDATE_PENDING;
+ }
+ }
+}
+
+/* TtkScrollbarUpdateRequired --
+ * Force a scrollbar update at the next call to TtkScrolled(),
+ * even if scroll parameters haven't changed (e.g., if
+ * -yscrollcommand has changed).
+ */
+
+void TtkScrollbarUpdateRequired(ScrollHandle h)
+{
+ h->flags |= SCROLL_UPDATE_REQUIRED;
+}
+
+/* TtkScrollviewCommand --
+ * Widget [xy]view command implementation.
+ *
+ * $w [xy]view -- return current view region
+ * $w [xy]view $index -- set topmost item
+ * $w [xy]view moveto $fraction
+ * $w [xy]view scroll $number $what -- scrollbar interface
+ */
+int TtkScrollviewCommand(
+ Tcl_Interp *interp, int objc, Tcl_Obj *const objv[], ScrollHandle h)
+{
+ Scrollable *s = h->scrollPtr;
+ int newFirst = s->first;
+
+ if (objc == 2) {
+ Tcl_Obj *result[2];
+ result[0] = Tcl_NewDoubleObj((double)s->first / s->total);
+ result[1] = Tcl_NewDoubleObj((double)s->last / s->total);
+ Tcl_SetObjResult(interp, Tcl_NewListObj(2, result));
+ return TCL_OK;
+ } else if (objc == 3) {
+ if (Tcl_GetIntFromObj(interp, objv[2], &newFirst) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ } else {
+ double fraction;
+ int count;
+
+ switch (Tk_GetScrollInfoObj(interp, objc, objv, &fraction, &count)) {
+ case TK_SCROLL_ERROR:
+ return TCL_ERROR;
+ case TK_SCROLL_MOVETO:
+ newFirst = (int) ((fraction * s->total) + 0.5);
+ break;
+ case TK_SCROLL_UNITS:
+ newFirst = s->first + count;
+ break;
+ case TK_SCROLL_PAGES: {
+ int perPage = s->last - s->first; /* @@@ */
+ newFirst = s->first + count * perPage;
+ break;
+ }
+ }
+ }
+
+ TtkScrollTo(h, newFirst);
+
+ return TCL_OK;
+}
+
+void TtkScrollTo(ScrollHandle h, int newFirst)
+{
+ Scrollable *s = h->scrollPtr;
+
+ if (newFirst >= s->total)
+ newFirst = s->total - 1;
+ if (newFirst > s->first && s->last >= s->total) /* don't scroll past end */
+ newFirst = s->first;
+ if (newFirst < 0)
+ newFirst = 0;
+
+ if (newFirst != s->first) {
+ s->first = newFirst;
+ TtkRedisplayWidget(h->corePtr);
+ }
+}
+
+void TtkFreeScrollHandle(ScrollHandle h)
+{
+ if (h->flags & SCROLL_UPDATE_PENDING) {
+ Tcl_CancelIdleCall(UpdateScrollbarBG, (ClientData)h);
+ }
+ ckfree(h);
+}
+
diff --git a/tk8.6/generic/ttk/ttkScrollbar.c b/tk8.6/generic/ttk/ttkScrollbar.c
new file mode 100644
index 0000000..5b0c212
--- /dev/null
+++ b/tk8.6/generic/ttk/ttkScrollbar.c
@@ -0,0 +1,345 @@
+/*
+ * Copyright (c) 2003, Joe English
+ *
+ * ttk::scrollbar widget.
+ */
+
+#include <tk.h>
+
+#include "ttkTheme.h"
+#include "ttkWidget.h"
+
+/*------------------------------------------------------------------------
+ * +++ Scrollbar widget record.
+ */
+typedef struct
+{
+ Tcl_Obj *commandObj;
+
+ int orient;
+ Tcl_Obj *orientObj;
+
+ double first; /* top fraction */
+ double last; /* bottom fraction */
+
+ Ttk_Box troughBox; /* trough parcel */
+ int minSize; /* minimum size of thumb */
+} ScrollbarPart;
+
+typedef struct
+{
+ WidgetCore core;
+ ScrollbarPart scrollbar;
+} Scrollbar;
+
+static Tk_OptionSpec ScrollbarOptionSpecs[] =
+{
+ {TK_OPTION_STRING, "-command", "command", "Command", "",
+ Tk_Offset(Scrollbar,scrollbar.commandObj), -1, 0,0,0},
+
+ {TK_OPTION_STRING_TABLE, "-orient", "orient", "Orient", "vertical",
+ Tk_Offset(Scrollbar,scrollbar.orientObj),
+ Tk_Offset(Scrollbar,scrollbar.orient),
+ 0,(ClientData)ttkOrientStrings,STYLE_CHANGED },
+
+ WIDGET_TAKEFOCUS_FALSE,
+ WIDGET_INHERIT_OPTIONS(ttkCoreOptionSpecs)
+};
+
+/*------------------------------------------------------------------------
+ * +++ Widget hooks.
+ */
+
+static void
+ScrollbarInitialize(Tcl_Interp *interp, void *recordPtr)
+{
+ Scrollbar *sb = recordPtr;
+ sb->scrollbar.first = 0.0;
+ sb->scrollbar.last = 1.0;
+
+ TtkTrackElementState(&sb->core);
+}
+
+static Ttk_Layout ScrollbarGetLayout(
+ Tcl_Interp *interp, Ttk_Theme theme, void *recordPtr)
+{
+ Scrollbar *sb = recordPtr;
+ return TtkWidgetGetOrientedLayout(
+ interp, theme, recordPtr, sb->scrollbar.orientObj);
+}
+
+/*
+ * ScrollbarDoLayout --
+ * Layout hook. Adjusts the position of the scrollbar thumb.
+ *
+ * Side effects:
+ * Sets sb->troughBox and sb->minSize.
+ */
+static void ScrollbarDoLayout(void *recordPtr)
+{
+ Scrollbar *sb = recordPtr;
+ WidgetCore *corePtr = &sb->core;
+ Ttk_Element thumb;
+ Ttk_Box thumbBox;
+ int thumbWidth, thumbHeight;
+ double first, last, size;
+ int minSize;
+
+ /*
+ * Use generic layout manager to compute initial layout:
+ */
+ Ttk_PlaceLayout(corePtr->layout,corePtr->state,Ttk_WinBox(corePtr->tkwin));
+
+ /*
+ * Locate thumb element, extract parcel and requested minimum size:
+ */
+ thumb = Ttk_FindElement(corePtr->layout, "thumb");
+ if (!thumb) /* Something has gone wrong -- bail */
+ return;
+
+ sb->scrollbar.troughBox = thumbBox = Ttk_ElementParcel(thumb);
+ Ttk_LayoutNodeReqSize(
+ corePtr->layout, thumb, &thumbWidth,&thumbHeight);
+
+ /*
+ * Adjust thumb element parcel:
+ */
+ first = sb->scrollbar.first;
+ last = sb->scrollbar.last;
+
+ if (sb->scrollbar.orient == TTK_ORIENT_VERTICAL) {
+ minSize = thumbHeight;
+ size = thumbBox.height - minSize;
+ thumbBox.y += (int)(size * first);
+ thumbBox.height = (int)(size * last) + minSize - (int)(size * first);
+ } else {
+ minSize = thumbWidth;
+ size = thumbBox.width - minSize;
+ thumbBox.x += (int)(size * first);
+ thumbBox.width = (int)(size * last) + minSize - (int)(size * first);
+ }
+ sb->scrollbar.minSize = minSize;
+ Ttk_PlaceElement(corePtr->layout, thumb, thumbBox);
+}
+
+/*------------------------------------------------------------------------
+ * +++ Widget commands.
+ */
+
+/* $sb set $first $last --
+ * Set the position of the scrollbar.
+ */
+static int
+ScrollbarSetCommand(
+ void *recordPtr, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[])
+{
+ Scrollbar *scrollbar = recordPtr;
+ Tcl_Obj *firstObj, *lastObj;
+ double first, last;
+
+ if (objc != 4) {
+ Tcl_WrongNumArgs(interp, 2, objv, "first last");
+ return TCL_ERROR;
+ }
+
+ firstObj = objv[2];
+ lastObj = objv[3];
+ if (Tcl_GetDoubleFromObj(interp, firstObj, &first) != TCL_OK
+ || Tcl_GetDoubleFromObj(interp, lastObj, &last) != TCL_OK)
+ return TCL_ERROR;
+
+ /* Range-checks:
+ */
+ if (first < 0.0) {
+ first = 0.0;
+ } else if (first > 1.0) {
+ first = 1.0;
+ }
+
+ if (last < first) {
+ last = first;
+ } else if (last > 1.0) {
+ last = 1.0;
+ }
+
+ /* ASSERT: 0.0 <= first <= last <= 1.0 */
+
+ scrollbar->scrollbar.first = first;
+ scrollbar->scrollbar.last = last;
+ if (first <= 0.0 && last >= 1.0) {
+ scrollbar->core.state |= TTK_STATE_DISABLED;
+ } else {
+ scrollbar->core.state &= ~TTK_STATE_DISABLED;
+ }
+
+ TtkRedisplayWidget(&scrollbar->core);
+
+ return TCL_OK;
+}
+
+/* $sb get --
+ * Returns the last thing passed to 'set'.
+ */
+static int
+ScrollbarGetCommand(
+ void *recordPtr, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[])
+{
+ Scrollbar *scrollbar = recordPtr;
+ Tcl_Obj *result[2];
+
+ if (objc != 2) {
+ Tcl_WrongNumArgs(interp, 2, objv, "");
+ return TCL_ERROR;
+ }
+
+ result[0] = Tcl_NewDoubleObj(scrollbar->scrollbar.first);
+ result[1] = Tcl_NewDoubleObj(scrollbar->scrollbar.last);
+ Tcl_SetObjResult(interp, Tcl_NewListObj(2, result));
+
+ return TCL_OK;
+}
+
+/* $sb delta $dx $dy --
+ * Returns the percentage change corresponding to a mouse movement
+ * of $dx, $dy.
+ */
+static int
+ScrollbarDeltaCommand(
+ void *recordPtr, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[])
+{
+ Scrollbar *sb = recordPtr;
+ double dx, dy;
+ double delta = 0.0;
+
+ if (objc != 4) {
+ Tcl_WrongNumArgs(interp, 2, objv, "dx dy");
+ return TCL_ERROR;
+ }
+
+ if (Tcl_GetDoubleFromObj(interp, objv[2], &dx) != TCL_OK
+ || Tcl_GetDoubleFromObj(interp, objv[3], &dy) != TCL_OK)
+ {
+ return TCL_ERROR;
+ }
+
+ delta = 0.0;
+ if (sb->scrollbar.orient == TTK_ORIENT_VERTICAL) {
+ int size = sb->scrollbar.troughBox.height - sb->scrollbar.minSize;
+ if (size > 0) {
+ delta = (double)dy / (double)size;
+ }
+ } else {
+ int size = sb->scrollbar.troughBox.width - sb->scrollbar.minSize;
+ if (size > 0) {
+ delta = (double)dx / (double)size;
+ }
+ }
+
+ Tcl_SetObjResult(interp, Tcl_NewDoubleObj(delta));
+ return TCL_OK;
+}
+
+/* $sb fraction $x $y --
+ * Returns a real number between 0 and 1 indicating where the
+ * point given by x and y lies in the trough area of the scrollbar.
+ */
+static int
+ScrollbarFractionCommand(
+ void *recordPtr, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[])
+{
+ Scrollbar *sb = recordPtr;
+ Ttk_Box b = sb->scrollbar.troughBox;
+ int minSize = sb->scrollbar.minSize;
+ double x, y;
+ double fraction = 0.0;
+
+ if (objc != 4) {
+ Tcl_WrongNumArgs(interp, 2, objv, "x y");
+ return TCL_ERROR;
+ }
+
+ if (Tcl_GetDoubleFromObj(interp, objv[2], &x) != TCL_OK
+ || Tcl_GetDoubleFromObj(interp, objv[3], &y) != TCL_OK)
+ {
+ return TCL_ERROR;
+ }
+
+ fraction = 0.0;
+ if (sb->scrollbar.orient == TTK_ORIENT_VERTICAL) {
+ if (b.height > minSize) {
+ fraction = (double)(y - b.y) / (double)(b.height - minSize);
+ }
+ } else {
+ if (b.width > minSize) {
+ fraction = (double)(x - b.x) / (double)(b.width - minSize);
+ }
+ }
+
+ Tcl_SetObjResult(interp, Tcl_NewDoubleObj(fraction));
+ return TCL_OK;
+}
+
+static const Ttk_Ensemble ScrollbarCommands[] = {
+ { "configure", TtkWidgetConfigureCommand,0 },
+ { "cget", TtkWidgetCgetCommand,0 },
+ { "delta", ScrollbarDeltaCommand,0 },
+ { "fraction", ScrollbarFractionCommand,0 },
+ { "get", ScrollbarGetCommand,0 },
+ { "identify", TtkWidgetIdentifyCommand,0 },
+ { "instate", TtkWidgetInstateCommand,0 },
+ { "set", ScrollbarSetCommand,0 },
+ { "state", TtkWidgetStateCommand,0 },
+ { 0,0,0 }
+};
+
+/*------------------------------------------------------------------------
+ * +++ Widget specification.
+ */
+static WidgetSpec ScrollbarWidgetSpec =
+{
+ "TScrollbar", /* className */
+ sizeof(Scrollbar), /* recordSize */
+ ScrollbarOptionSpecs, /* optionSpecs */
+ ScrollbarCommands, /* subcommands */
+ ScrollbarInitialize, /* initializeProc */
+ TtkNullCleanup, /* cleanupProc */
+ TtkCoreConfigure, /* configureProc */
+ TtkNullPostConfigure, /* postConfigureProc */
+ ScrollbarGetLayout, /* getLayoutProc */
+ TtkWidgetSize, /* sizeProc */
+ ScrollbarDoLayout, /* layoutProc */
+ TtkWidgetDisplay /* displayProc */
+};
+
+TTK_BEGIN_LAYOUT(VerticalScrollbarLayout)
+ TTK_GROUP("Vertical.Scrollbar.trough", TTK_FILL_Y,
+ TTK_NODE("Vertical.Scrollbar.uparrow", TTK_PACK_TOP)
+ TTK_NODE("Vertical.Scrollbar.downarrow", TTK_PACK_BOTTOM)
+ TTK_NODE(
+ "Vertical.Scrollbar.thumb", TTK_PACK_TOP|TTK_EXPAND|TTK_FILL_BOTH))
+TTK_END_LAYOUT
+
+TTK_BEGIN_LAYOUT(HorizontalScrollbarLayout)
+ TTK_GROUP("Horizontal.Scrollbar.trough", TTK_FILL_X,
+ TTK_NODE("Horizontal.Scrollbar.leftarrow", TTK_PACK_LEFT)
+ TTK_NODE("Horizontal.Scrollbar.rightarrow", TTK_PACK_RIGHT)
+ TTK_NODE(
+ "Horizontal.Scrollbar.thumb", TTK_PACK_LEFT|TTK_EXPAND|TTK_FILL_BOTH))
+TTK_END_LAYOUT
+
+/*------------------------------------------------------------------------
+ * +++ Initialization.
+ */
+
+MODULE_SCOPE
+void TtkScrollbar_Init(Tcl_Interp *interp)
+{
+ Ttk_Theme theme = Ttk_GetDefaultTheme(interp);
+
+ Ttk_RegisterLayout(theme,"Vertical.TScrollbar",VerticalScrollbarLayout);
+ Ttk_RegisterLayout(theme,"Horizontal.TScrollbar",HorizontalScrollbarLayout);
+
+ RegisterWidget(interp, "ttk::scrollbar", &ScrollbarWidgetSpec);
+}
+
+/*EOF*/
diff --git a/tk8.6/generic/ttk/ttkSeparator.c b/tk8.6/generic/ttk/ttkSeparator.c
new file mode 100644
index 0000000..b52e6f4
--- /dev/null
+++ b/tk8.6/generic/ttk/ttkSeparator.c
@@ -0,0 +1,136 @@
+/*
+ * Copyright (c) 2004, Joe English
+ *
+ * ttk::separator and ttk::sizegrip widgets.
+ */
+
+#include <tk.h>
+
+#include "ttkTheme.h"
+#include "ttkWidget.h"
+
+/* +++ Separator widget record:
+ */
+typedef struct
+{
+ Tcl_Obj *orientObj;
+ int orient;
+} SeparatorPart;
+
+typedef struct
+{
+ WidgetCore core;
+ SeparatorPart separator;
+} Separator;
+
+static Tk_OptionSpec SeparatorOptionSpecs[] = {
+ {TK_OPTION_STRING_TABLE, "-orient", "orient", "Orient", "horizontal",
+ Tk_Offset(Separator,separator.orientObj),
+ Tk_Offset(Separator,separator.orient),
+ 0,(ClientData)ttkOrientStrings,STYLE_CHANGED },
+
+ WIDGET_TAKEFOCUS_FALSE,
+ WIDGET_INHERIT_OPTIONS(ttkCoreOptionSpecs)
+};
+
+/*
+ * GetLayout hook --
+ * Choose layout based on -orient option.
+ */
+static Ttk_Layout SeparatorGetLayout(
+ Tcl_Interp *interp, Ttk_Theme theme, void *recordPtr)
+{
+ Separator *sep = recordPtr;
+ return TtkWidgetGetOrientedLayout(
+ interp, theme, recordPtr, sep->separator.orientObj);
+}
+
+/*
+ * Widget commands:
+ */
+static const Ttk_Ensemble SeparatorCommands[] = {
+ { "configure", TtkWidgetConfigureCommand,0 },
+ { "cget", TtkWidgetCgetCommand,0 },
+ { "identify", TtkWidgetIdentifyCommand,0 },
+ { "instate", TtkWidgetInstateCommand,0 },
+ { "state", TtkWidgetStateCommand,0 },
+ { 0,0,0 }
+};
+
+/*
+ * Widget specification:
+ */
+static WidgetSpec SeparatorWidgetSpec =
+{
+ "TSeparator", /* className */
+ sizeof(Separator), /* recordSize */
+ SeparatorOptionSpecs, /* optionSpecs */
+ SeparatorCommands, /* subcommands */
+ TtkNullInitialize, /* initializeProc */
+ TtkNullCleanup, /* cleanupProc */
+ TtkCoreConfigure, /* configureProc */
+ TtkNullPostConfigure, /* postConfigureProc */
+ SeparatorGetLayout, /* getLayoutProc */
+ TtkWidgetSize, /* sizeProc */
+ TtkWidgetDoLayout, /* layoutProc */
+ TtkWidgetDisplay /* displayProc */
+};
+
+TTK_BEGIN_LAYOUT(SeparatorLayout)
+ TTK_NODE("Separator.separator", TTK_FILL_BOTH)
+TTK_END_LAYOUT
+
+/* +++ Sizegrip widget:
+ * Has no options or methods other than the standard ones.
+ */
+
+static Tk_OptionSpec SizegripOptionSpecs[] = {
+ WIDGET_TAKEFOCUS_FALSE,
+ WIDGET_INHERIT_OPTIONS(ttkCoreOptionSpecs)
+};
+
+static const Ttk_Ensemble SizegripCommands[] = {
+ { "configure", TtkWidgetConfigureCommand,0 },
+ { "cget", TtkWidgetCgetCommand,0 },
+ { "identify", TtkWidgetIdentifyCommand,0 },
+ { "instate", TtkWidgetInstateCommand,0 },
+ { "state", TtkWidgetStateCommand,0 },
+ { 0,0,0 }
+};
+
+static WidgetSpec SizegripWidgetSpec =
+{
+ "TSizegrip", /* className */
+ sizeof(WidgetCore), /* recordSize */
+ SizegripOptionSpecs, /* optionSpecs */
+ SizegripCommands, /* subcommands */
+ TtkNullInitialize, /* initializeProc */
+ TtkNullCleanup, /* cleanupProc */
+ TtkCoreConfigure, /* configureProc */
+ TtkNullPostConfigure, /* postConfigureProc */
+ TtkWidgetGetLayout, /* getLayoutProc */
+ TtkWidgetSize, /* sizeProc */
+ TtkWidgetDoLayout, /* layoutProc */
+ TtkWidgetDisplay /* displayProc */
+};
+
+TTK_BEGIN_LAYOUT(SizegripLayout)
+ TTK_NODE("Sizegrip.sizegrip", TTK_PACK_BOTTOM|TTK_STICK_S|TTK_STICK_E)
+TTK_END_LAYOUT
+
+/* +++ Initialization:
+ */
+
+MODULE_SCOPE
+void TtkSeparator_Init(Tcl_Interp *interp)
+{
+ Ttk_Theme theme = Ttk_GetDefaultTheme(interp);
+
+ Ttk_RegisterLayout(theme, "TSeparator", SeparatorLayout);
+ Ttk_RegisterLayout(theme, "TSizegrip", SizegripLayout);
+
+ RegisterWidget(interp, "ttk::separator", &SeparatorWidgetSpec);
+ RegisterWidget(interp, "ttk::sizegrip", &SizegripWidgetSpec);
+}
+
+/*EOF*/
diff --git a/tk8.6/generic/ttk/ttkSquare.c b/tk8.6/generic/ttk/ttkSquare.c
new file mode 100644
index 0000000..d002f2f
--- /dev/null
+++ b/tk8.6/generic/ttk/ttkSquare.c
@@ -0,0 +1,301 @@
+/* square.c - Copyright (C) 2004 Pat Thoyts <patthoyts@users.sourceforge.net>
+ *
+ * Minimal sample ttk widget.
+ */
+
+#include <tk.h>
+#include "ttkTheme.h"
+#include "ttkWidget.h"
+
+#if defined(TTK_SQUARE_WIDGET) || 1
+
+#ifndef DEFAULT_BORDERWIDTH
+#define DEFAULT_BORDERWIDTH "2"
+#endif
+
+/*
+ * First, we setup the widget record. The Ttk package provides a structure
+ * that contains standard widget data so it is only necessary to define
+ * a structure that holds the data required for our widget. We do this by
+ * defining a widget part and then specifying the widget record as the
+ * concatenation of the two structures.
+ */
+
+typedef struct
+{
+ Tcl_Obj *widthObj;
+ Tcl_Obj *heightObj;
+ Tcl_Obj *reliefObj;
+ Tcl_Obj *borderWidthObj;
+ Tcl_Obj *foregroundObj;
+ Tcl_Obj *paddingObj;
+ Tcl_Obj *anchorObj;
+} SquarePart;
+
+typedef struct
+{
+ WidgetCore core;
+ SquarePart square;
+} Square;
+
+/*
+ * Widget options.
+ *
+ * This structure is the same as the option specification structure used
+ * for Tk widgets. For each option we provide the type, name and options
+ * database name and class name and the position in the structure and
+ * default values. At the bottom we bring in the standard widget option
+ * defined for all widgets.
+ */
+
+static Tk_OptionSpec SquareOptionSpecs[] =
+{
+ {TK_OPTION_PIXELS, "-borderwidth", "borderWidth", "BorderWidth",
+ DEFAULT_BORDERWIDTH, Tk_Offset(Square,square.borderWidthObj), -1,
+ 0,0,GEOMETRY_CHANGED },
+ {TK_OPTION_BORDER, "-foreground", "foreground", "Foreground",
+ DEFAULT_BACKGROUND, Tk_Offset(Square,square.foregroundObj),
+ -1, 0, 0, 0},
+
+ {TK_OPTION_PIXELS, "-width", "width", "Width",
+ "50", Tk_Offset(Square,square.widthObj), -1, 0, 0,
+ GEOMETRY_CHANGED},
+ {TK_OPTION_PIXELS, "-height", "height", "Height",
+ "50", Tk_Offset(Square,square.heightObj), -1, 0, 0,
+ GEOMETRY_CHANGED},
+
+ {TK_OPTION_STRING, "-padding", "padding", "Pad", NULL,
+ Tk_Offset(Square,square.paddingObj), -1,
+ TK_OPTION_NULL_OK,0,GEOMETRY_CHANGED },
+
+ {TK_OPTION_RELIEF, "-relief", "relief", "Relief",
+ NULL, Tk_Offset(Square,square.reliefObj), -1, TK_OPTION_NULL_OK, 0, 0},
+
+ {TK_OPTION_ANCHOR, "-anchor", "anchor", "Anchor",
+ NULL, Tk_Offset(Square,square.anchorObj), -1, TK_OPTION_NULL_OK, 0, 0},
+
+ WIDGET_TAKEFOCUS_TRUE,
+ WIDGET_INHERIT_OPTIONS(ttkCoreOptionSpecs)
+};
+
+/*
+ * Almost all of the widget functionality is handled by the default Ttk
+ * widget code and the contained element. The one thing that we must handle
+ * is the -anchor option which positions the square element within the parcel
+ * of space available for the widget.
+ * To do this we must find out the layout preferences for the square
+ * element and adjust its position within our region.
+ *
+ * Note that if we do not have a "square" elememt then just the default
+ * layout will be done. So if someone places a label element into the
+ * widget layout it will still be handled but the -anchor option will be
+ * passed onto the label element instead of handled here.
+ */
+
+static void
+SquareDoLayout(void *clientData)
+{
+ WidgetCore *corePtr = (WidgetCore *)clientData;
+ Ttk_Box winBox;
+ Ttk_Element squareNode;
+
+ squareNode = Ttk_FindElement(corePtr->layout, "square");
+ winBox = Ttk_WinBox(corePtr->tkwin);
+ Ttk_PlaceLayout(corePtr->layout, corePtr->state, winBox);
+
+ /*
+ * Adjust the position of the square element within the widget according
+ * to the -anchor option.
+ */
+
+ if (squareNode) {
+ Square *squarePtr = clientData;
+ Tk_Anchor anchor = TK_ANCHOR_CENTER;
+ Ttk_Box b;
+
+ b = Ttk_ElementParcel(squareNode);
+ if (squarePtr->square.anchorObj != NULL)
+ Tk_GetAnchorFromObj(NULL, squarePtr->square.anchorObj, &anchor);
+ b = Ttk_AnchorBox(winBox, b.width, b.height, anchor);
+
+ Ttk_PlaceElement(corePtr->layout, squareNode, b);
+ }
+}
+
+/*
+ * Widget commands. A widget is impelemented as an ensemble and the
+ * subcommands are listed here. Ttk provides default implementations
+ * that are sufficient for our needs.
+ */
+
+static const Ttk_Ensemble SquareCommands[] = {
+ { "configure", TtkWidgetConfigureCommand,0 },
+ { "cget", TtkWidgetCgetCommand,0 },
+ { "identify", TtkWidgetIdentifyCommand,0 },
+ { "instate", TtkWidgetInstateCommand,0 },
+ { "state", TtkWidgetStateCommand,0 },
+ { 0,0,0 }
+};
+
+/*
+ * The Widget specification structure holds all the implementation
+ * information about this widget and this is what must be registered
+ * with Tk in the package initialization code (see bottom).
+ */
+
+static WidgetSpec SquareWidgetSpec =
+{
+ "TSquare", /* className */
+ sizeof(Square), /* recordSize */
+ SquareOptionSpecs, /* optionSpecs */
+ SquareCommands, /* subcommands */
+ TtkNullInitialize, /* initializeProc */
+ TtkNullCleanup, /* cleanupProc */
+ TtkCoreConfigure, /* configureProc */
+ TtkNullPostConfigure, /* postConfigureProc */
+ TtkWidgetGetLayout, /* getLayoutProc */
+ TtkWidgetSize, /* sizeProc */
+ SquareDoLayout, /* layoutProc */
+ TtkWidgetDisplay /* displayProc */
+};
+
+/* ----------------------------------------------------------------------
+ * Square element
+ *
+ * In this section we demonstrate what is required to create a new themed
+ * element.
+ */
+
+typedef struct
+{
+ Tcl_Obj *borderObj;
+ Tcl_Obj *foregroundObj;
+ Tcl_Obj *borderWidthObj;
+ Tcl_Obj *reliefObj;
+ Tcl_Obj *widthObj;
+ Tcl_Obj *heightObj;
+} SquareElement;
+
+static Ttk_ElementOptionSpec SquareElementOptions[] =
+{
+ { "-background", TK_OPTION_BORDER, Tk_Offset(SquareElement,borderObj),
+ DEFAULT_BACKGROUND },
+ { "-foreground", TK_OPTION_BORDER, Tk_Offset(SquareElement,foregroundObj),
+ DEFAULT_BACKGROUND },
+ { "-borderwidth", TK_OPTION_PIXELS, Tk_Offset(SquareElement,borderWidthObj),
+ DEFAULT_BORDERWIDTH },
+ { "-relief", TK_OPTION_RELIEF, Tk_Offset(SquareElement,reliefObj),
+ "raised" },
+ { "-width", TK_OPTION_PIXELS, Tk_Offset(SquareElement,widthObj), "20"},
+ { "-height", TK_OPTION_PIXELS, Tk_Offset(SquareElement,heightObj), "20"},
+ { NULL, 0, 0, NULL }
+};
+
+/*
+ * The element geometry function is called when the layout code wishes to
+ * find out how big this element wants to be. We must return our preferred
+ * size and padding information
+ */
+
+static void SquareElementSize(
+ void *clientData, void *elementRecord, Tk_Window tkwin,
+ int *widthPtr, int *heightPtr, Ttk_Padding *paddingPtr)
+{
+ SquareElement *square = elementRecord;
+ int borderWidth = 0;
+
+ Tcl_GetIntFromObj(NULL, square->borderWidthObj, &borderWidth);
+ *paddingPtr = Ttk_UniformPadding((short)borderWidth);
+ Tk_GetPixelsFromObj(NULL, tkwin, square->widthObj, widthPtr);
+ Tk_GetPixelsFromObj(NULL, tkwin, square->heightObj, heightPtr);
+}
+
+/*
+ * Draw the element in the box provided.
+ */
+
+static void SquareElementDraw(
+ void *clientData, void *elementRecord, Tk_Window tkwin,
+ Drawable d, Ttk_Box b, unsigned int state)
+{
+ SquareElement *square = elementRecord;
+ Tk_3DBorder foreground = NULL;
+ int borderWidth = 1, relief = TK_RELIEF_FLAT;
+
+ foreground = Tk_Get3DBorderFromObj(tkwin, square->foregroundObj);
+ Tcl_GetIntFromObj(NULL, square->borderWidthObj, &borderWidth);
+ Tk_GetReliefFromObj(NULL, square->reliefObj, &relief);
+
+ Tk_Fill3DRectangle(tkwin, d, foreground,
+ b.x, b.y, b.width, b.height, borderWidth, relief);
+}
+
+static Ttk_ElementSpec SquareElementSpec =
+{
+ TK_STYLE_VERSION_2,
+ sizeof(SquareElement),
+ SquareElementOptions,
+ SquareElementSize,
+ SquareElementDraw
+};
+
+/* ----------------------------------------------------------------------
+ *
+ * Layout section.
+ *
+ * Every widget class needs a layout style that specifies which elements
+ * are part of the widget and how they should be placed. The element layout
+ * engine is similar to the Tk pack geometry manager. Read the documentation
+ * for the details. In this example we just need to have the square element
+ * that has been defined for this widget placed on a background. We will
+ * also need some padding to keep it away from the edges.
+ */
+
+TTK_BEGIN_LAYOUT(SquareLayout)
+ TTK_NODE("Square.background", TTK_FILL_BOTH)
+ TTK_GROUP("Square.padding", TTK_FILL_BOTH,
+ TTK_NODE("Square.square", 0))
+TTK_END_LAYOUT
+
+/* ----------------------------------------------------------------------
+ *
+ * Widget initialization.
+ *
+ * This file defines a new element and a new widget. We need to register
+ * the element with the themes that will need it. In this case we will
+ * register with the default theme that is the root of the theme inheritance
+ * tree. This means all themes will find this element.
+ * We then need to register the widget class style. This is the layout
+ * specification. If a different theme requires an alternative layout, we
+ * could register that here. For instance, in some themes the scrollbars have
+ * one uparrow, in other themes there are two uparrow elements.
+ * Finally we register the widget itself. This step creates a tcl command so
+ * that we can actually create an instance of this class. The widget is
+ * linked to a particular style by the widget class name. This is important
+ * to realise as the programmer may change the classname when creating a
+ * new instance. If this is done, a new layout will need to be created (which
+ * can be done at script level). Some widgets may require particular elements
+ * to be present but we try to avoid this where possible. In this widget's C
+ * code, no reference is made to any particular elements. The programmer is
+ * free to specify a new style using completely different elements.
+ */
+
+/* public */ MODULE_SCOPE int
+TtkSquareWidget_Init(Tcl_Interp *interp)
+{
+ Ttk_Theme theme = Ttk_GetDefaultTheme(interp);
+
+ /* register the new elements for this theme engine */
+ Ttk_RegisterElement(interp, theme, "square", &SquareElementSpec, NULL);
+
+ /* register the layout for this theme */
+ Ttk_RegisterLayout(theme, "TSquare", SquareLayout);
+
+ /* register the widget */
+ RegisterWidget(interp, "ttk::square", &SquareWidgetSpec);
+
+ return TCL_OK;
+}
+
+#endif /* TTK_SQUARE_WIDGET */
+
diff --git a/tk8.6/generic/ttk/ttkState.c b/tk8.6/generic/ttk/ttkState.c
new file mode 100644
index 0000000..c34b900
--- /dev/null
+++ b/tk8.6/generic/ttk/ttkState.c
@@ -0,0 +1,275 @@
+/*
+ * Tk widget state utilities.
+ *
+ * Copyright (c) 2003 Joe English. Freely redistributable.
+ *
+ */
+
+#include <string.h>
+
+#include <tk.h>
+#include "ttkTheme.h"
+
+/*
+ * Table of state names. Must be kept in sync with TTK_STATE_*
+ * #defines in ttkTheme.h.
+ */
+static const char *const stateNames[] =
+{
+ "active", /* Mouse cursor is over widget or element */
+ "disabled", /* Widget is disabled */
+ "focus", /* Widget has keyboard focus */
+ "pressed", /* Pressed or "armed" */
+ "selected", /* "on", "true", "current", etc. */
+ "background", /* Top-level window lost focus (Mac,Win "inactive") */
+ "alternate", /* Widget-specific alternate display style */
+ "invalid", /* Bad value */
+ "readonly", /* Editing/modification disabled */
+ "hover", /* Mouse cursor is over widget */
+ "reserved1", /* Reserved for future extension */
+ "reserved2", /* Reserved for future extension */
+ "reserved3", /* Reserved for future extension */
+ "user3", /* User-definable state */
+ "user2", /* User-definable state */
+ "user1", /* User-definable state */
+ NULL
+};
+
+/*------------------------------------------------------------------------
+ * +++ StateSpec object type:
+ *
+ * The string representation consists of a list of state names,
+ * each optionally prefixed by an exclamation point (!).
+ *
+ * The internal representation uses the upper half of the longValue
+ * to store the on bits and the lower half to store the off bits.
+ * If we ever get more than 16 states, this will need to be reconsidered...
+ */
+
+static int StateSpecSetFromAny(Tcl_Interp *interp, Tcl_Obj *obj);
+/* static void StateSpecFreeIntRep(Tcl_Obj *); */
+#define StateSpecFreeIntRep 0 /* not needed */
+static void StateSpecDupIntRep(Tcl_Obj *, Tcl_Obj *);
+static void StateSpecUpdateString(Tcl_Obj *);
+
+static
+struct Tcl_ObjType StateSpecObjType =
+{
+ "StateSpec",
+ StateSpecFreeIntRep,
+ StateSpecDupIntRep,
+ StateSpecUpdateString,
+ StateSpecSetFromAny
+};
+
+static void StateSpecDupIntRep(Tcl_Obj *srcPtr, Tcl_Obj *copyPtr)
+{
+ copyPtr->internalRep.longValue = srcPtr->internalRep.longValue;
+ copyPtr->typePtr = &StateSpecObjType;
+}
+
+static int StateSpecSetFromAny(Tcl_Interp *interp, Tcl_Obj *objPtr)
+{
+ int status;
+ int objc;
+ Tcl_Obj **objv;
+ int i;
+ unsigned int onbits = 0, offbits = 0;
+
+ status = Tcl_ListObjGetElements(interp, objPtr, &objc, &objv);
+ if (status != TCL_OK)
+ return status;
+
+ for (i = 0; i < objc; ++i) {
+ const char *stateName = Tcl_GetString(objv[i]);
+ int on, j;
+
+ if (*stateName == '!') {
+ ++stateName;
+ on = 0;
+ } else {
+ on = 1;
+ }
+
+ for (j = 0; stateNames[j] != 0; ++j) {
+ if (strcmp(stateName, stateNames[j]) == 0)
+ break;
+ }
+
+ if (stateNames[j] == 0) {
+ if (interp) {
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "Invalid state name %s", stateName));
+ Tcl_SetErrorCode(interp, "TTK", "VALUE", "STATE", NULL);
+ }
+ return TCL_ERROR;
+ }
+
+ if (on) {
+ onbits |= (1<<j);
+ } else {
+ offbits |= (1<<j);
+ }
+ }
+
+ /* Invalidate old intrep:
+ */
+ if (objPtr->typePtr && objPtr->typePtr->freeIntRepProc) {
+ objPtr->typePtr->freeIntRepProc(objPtr);
+ }
+
+ objPtr->typePtr = &StateSpecObjType;
+ objPtr->internalRep.longValue = (onbits << 16) | offbits;
+
+ return TCL_OK;
+}
+
+static void StateSpecUpdateString(Tcl_Obj *objPtr)
+{
+ unsigned int onbits = (objPtr->internalRep.longValue & 0xFFFF0000) >> 16;
+ unsigned int offbits = objPtr->internalRep.longValue & 0x0000FFFF;
+ unsigned int mask = onbits | offbits;
+ Tcl_DString result;
+ int i, len;
+
+ Tcl_DStringInit(&result);
+
+ for (i=0; stateNames[i] != NULL; ++i) {
+ if (mask & (1<<i)) {
+ if (offbits & (1<<i))
+ Tcl_DStringAppend(&result, "!", 1);
+ Tcl_DStringAppend(&result, stateNames[i], -1);
+ Tcl_DStringAppend(&result, " ", 1);
+ }
+ }
+
+ len = Tcl_DStringLength(&result);
+ if (len) {
+ /* 'len' includes extra trailing ' ' */
+ objPtr->bytes = Tcl_Alloc((unsigned)len);
+ objPtr->length = len-1;
+ strncpy(objPtr->bytes, Tcl_DStringValue(&result), (size_t)len-1);
+ objPtr->bytes[len-1] = '\0';
+ } else {
+ /* empty string */
+ objPtr->length = 0;
+ objPtr->bytes = Tcl_Alloc(1);
+ *objPtr->bytes = '\0';
+ }
+
+ Tcl_DStringFree(&result);
+}
+
+Tcl_Obj *Ttk_NewStateSpecObj(unsigned int onbits, unsigned int offbits)
+{
+ Tcl_Obj *objPtr = Tcl_NewObj();
+
+ Tcl_InvalidateStringRep(objPtr);
+ objPtr->typePtr = &StateSpecObjType;
+ objPtr->internalRep.longValue = (onbits << 16) | offbits;
+
+ return objPtr;
+}
+
+int Ttk_GetStateSpecFromObj(
+ Tcl_Interp *interp,
+ Tcl_Obj *objPtr,
+ Ttk_StateSpec *spec)
+{
+ if (objPtr->typePtr != &StateSpecObjType) {
+ int status = StateSpecSetFromAny(interp, objPtr);
+ if (status != TCL_OK)
+ return status;
+ }
+
+ spec->onbits = (objPtr->internalRep.longValue & 0xFFFF0000) >> 16;
+ spec->offbits = objPtr->internalRep.longValue & 0x0000FFFF;
+ return TCL_OK;
+}
+
+
+/*
+ * Tk_StateMapLookup --
+ *
+ * A state map is a paired list of StateSpec / value pairs.
+ * Returns the value corresponding to the first matching state
+ * specification, or NULL if not found or an error occurs.
+ */
+Tcl_Obj *Ttk_StateMapLookup(
+ Tcl_Interp *interp, /* Where to leave error messages; may be NULL */
+ Ttk_StateMap map, /* State map */
+ Ttk_State state) /* State to look up */
+{
+ Tcl_Obj **specs;
+ int nSpecs;
+ int j, status;
+
+ status = Tcl_ListObjGetElements(interp, map, &nSpecs, &specs);
+ if (status != TCL_OK)
+ return NULL;
+
+ for (j = 0; j < nSpecs; j += 2) {
+ Ttk_StateSpec spec;
+ status = Ttk_GetStateSpecFromObj(interp, specs[j], &spec);
+ if (status != TCL_OK)
+ return NULL;
+ if (Ttk_StateMatches(state, &spec))
+ return specs[j+1];
+ }
+ if (interp) {
+ Tcl_SetObjResult(interp, Tcl_NewStringObj("No match in state map", -1));
+ Tcl_SetErrorCode(interp, "TTK", "STATE", "UNMATCHED", NULL);
+ }
+ return NULL;
+}
+
+/* Ttk_GetStateMapFromObj --
+ * Returns a Ttk_StateMap from a Tcl_Obj*.
+ * Since a Ttk_StateMap is just a specially-formatted Tcl_Obj,
+ * this basically just checks for errors.
+ */
+Ttk_StateMap Ttk_GetStateMapFromObj(
+ Tcl_Interp *interp, /* Where to leave error messages; may be NULL */
+ Tcl_Obj *mapObj) /* State map */
+{
+ Tcl_Obj **specs;
+ int nSpecs;
+ int j, status;
+
+ status = Tcl_ListObjGetElements(interp, mapObj, &nSpecs, &specs);
+ if (status != TCL_OK)
+ return NULL;
+
+ if (nSpecs % 2 != 0) {
+ if (interp) {
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "State map must have an even number of elements", -1));
+ Tcl_SetErrorCode(interp, "TTK", "VALUE", "STATEMAP", NULL);
+ }
+ return 0;
+ }
+
+ for (j = 0; j < nSpecs; j += 2) {
+ Ttk_StateSpec spec;
+ if (Ttk_GetStateSpecFromObj(interp, specs[j], &spec) != TCL_OK)
+ return NULL;
+ }
+
+ return mapObj;
+}
+
+/*
+ * Ttk_StateTableLooup --
+ * Look up an index from a statically allocated state table.
+ */
+int Ttk_StateTableLookup(Ttk_StateTable *map, unsigned int state)
+{
+ while ((state & map->onBits) != map->onBits
+ || (~state & map->offBits) != map->offBits)
+ {
+ ++map;
+ }
+ return map->index;
+}
+
+/*EOF*/
diff --git a/tk8.6/generic/ttk/ttkStubInit.c b/tk8.6/generic/ttk/ttkStubInit.c
new file mode 100644
index 0000000..87b33dc
--- /dev/null
+++ b/tk8.6/generic/ttk/ttkStubInit.c
@@ -0,0 +1,61 @@
+/*
+ * This file is (mostly) automatically generated from ttk.decls.
+ * It is compiled and linked in with the ttk package proper.
+ */
+
+#include "tk.h"
+#include "ttkTheme.h"
+
+MODULE_SCOPE const TtkStubs ttkStubs;
+
+/* !BEGIN!: Do not edit below this line. */
+
+const TtkStubs ttkStubs = {
+ TCL_STUB_MAGIC,
+ TTK_STUBS_EPOCH,
+ TTK_STUBS_REVISION,
+ 0,
+ Ttk_GetTheme, /* 0 */
+ Ttk_GetDefaultTheme, /* 1 */
+ Ttk_GetCurrentTheme, /* 2 */
+ Ttk_CreateTheme, /* 3 */
+ Ttk_RegisterCleanup, /* 4 */
+ Ttk_RegisterElementSpec, /* 5 */
+ Ttk_RegisterElement, /* 6 */
+ Ttk_RegisterElementFactory, /* 7 */
+ Ttk_RegisterLayout, /* 8 */
+ 0, /* 9 */
+ Ttk_GetStateSpecFromObj, /* 10 */
+ Ttk_NewStateSpecObj, /* 11 */
+ Ttk_GetStateMapFromObj, /* 12 */
+ Ttk_StateMapLookup, /* 13 */
+ Ttk_StateTableLookup, /* 14 */
+ 0, /* 15 */
+ 0, /* 16 */
+ 0, /* 17 */
+ 0, /* 18 */
+ 0, /* 19 */
+ Ttk_GetPaddingFromObj, /* 20 */
+ Ttk_GetBorderFromObj, /* 21 */
+ Ttk_GetStickyFromObj, /* 22 */
+ Ttk_MakePadding, /* 23 */
+ Ttk_UniformPadding, /* 24 */
+ Ttk_AddPadding, /* 25 */
+ Ttk_RelievePadding, /* 26 */
+ Ttk_MakeBox, /* 27 */
+ Ttk_BoxContains, /* 28 */
+ Ttk_PackBox, /* 29 */
+ Ttk_StickBox, /* 30 */
+ Ttk_AnchorBox, /* 31 */
+ Ttk_PadBox, /* 32 */
+ Ttk_ExpandBox, /* 33 */
+ Ttk_PlaceBox, /* 34 */
+ Ttk_NewBoxObj, /* 35 */
+ 0, /* 36 */
+ 0, /* 37 */
+ 0, /* 38 */
+ 0, /* 39 */
+ Ttk_GetOrientFromObj, /* 40 */
+};
+
+/* !END!: Do not edit above this line. */
diff --git a/tk8.6/generic/ttk/ttkStubLib.c b/tk8.6/generic/ttk/ttkStubLib.c
new file mode 100644
index 0000000..2c07b9d
--- /dev/null
+++ b/tk8.6/generic/ttk/ttkStubLib.c
@@ -0,0 +1,74 @@
+/*
+ * We need to ensure that we use the tcl stub macros so that this file
+ * contains no references to any of the tcl stub functions.
+ */
+
+#undef USE_TCL_STUBS
+#define USE_TCL_STUBS
+
+#include "tk.h"
+
+#define USE_TTK_STUBS 1
+#include "ttkTheme.h"
+
+MODULE_SCOPE const TtkStubs *ttkStubsPtr;
+const TtkStubs *ttkStubsPtr = NULL;
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TtkInitializeStubs --
+ * Load the Ttk package, initialize stub table pointer.
+ * Do not call this function directly, use Ttk_InitStubs() macro instead.
+ *
+ * Results:
+ * The actual version of the package that satisfies the request, or
+ * NULL to indicate that an error occurred.
+ *
+ * Side effects:
+ * Sets the stub table pointer.
+ *
+ */
+MODULE_SCOPE const char *
+TtkInitializeStubs(
+ Tcl_Interp *interp, const char *version, int epoch, int revision)
+{
+ int exact = 0;
+ const char *packageName = "Ttk";
+ const char *errMsg = NULL;
+ ClientData pkgClientData = NULL;
+ const char *actualVersion = Tcl_PkgRequireEx(
+ interp, packageName, version, exact, &pkgClientData);
+ const TtkStubs *stubsPtr = pkgClientData;
+
+ if (!actualVersion) {
+ return NULL;
+ }
+
+ if (!stubsPtr) {
+ errMsg = "missing stub table pointer";
+ goto error;
+ }
+ if (stubsPtr->epoch != epoch) {
+ errMsg = "epoch number mismatch";
+ goto error;
+ }
+ if (stubsPtr->revision < revision) {
+ errMsg = "require later revision";
+ goto error;
+ }
+
+ ttkStubsPtr = stubsPtr;
+ return actualVersion;
+
+error:
+ Tcl_ResetResult(interp);
+ Tcl_AppendResult(interp,
+ "Error loading ", packageName, " package",
+ " (requested version '", version,
+ "', loaded version '", actualVersion, "'): ",
+ errMsg,
+ NULL);
+ return NULL;
+}
+
diff --git a/tk8.6/generic/ttk/ttkTagSet.c b/tk8.6/generic/ttk/ttkTagSet.c
new file mode 100644
index 0000000..f2108b9
--- /dev/null
+++ b/tk8.6/generic/ttk/ttkTagSet.c
@@ -0,0 +1,306 @@
+/*
+ * Tag tables. 3/4-baked, work in progress.
+ *
+ * Copyright (C) 2005, Joe English. Freely redistributable.
+ */
+
+#include <string.h> /* for memset() */
+#include <tcl.h>
+#include <tk.h>
+
+#include "ttkTheme.h"
+#include "ttkWidget.h"
+
+/*------------------------------------------------------------------------
+ * +++ Internal data structures.
+ */
+struct TtkTag {
+ int priority; /* 1=>highest */
+ const char *tagName; /* Back-pointer to hash table entry */
+ void *tagRecord; /* User data */
+};
+
+struct TtkTagTable {
+ Tk_Window tkwin; /* owner window */
+ Tk_OptionSpec *optionSpecs; /* ... */
+ Tk_OptionTable optionTable; /* ... */
+ int recordSize; /* size of tag record */
+ int nTags; /* #tags defined so far */
+ Tcl_HashTable tags; /* defined tags */
+};
+
+/*------------------------------------------------------------------------
+ * +++ Tags.
+ */
+static Ttk_Tag NewTag(Ttk_TagTable tagTable, const char *tagName)
+{
+ Ttk_Tag tag = ckalloc(sizeof(*tag));
+ tag->tagRecord = ckalloc(tagTable->recordSize);
+ memset(tag->tagRecord, 0, tagTable->recordSize);
+ /* Don't need Tk_InitOptions() here, all defaults should be NULL. */
+ tag->priority = ++tagTable->nTags;
+ tag->tagName = tagName;
+ return tag;
+}
+
+static void DeleteTag(Ttk_TagTable tagTable, Ttk_Tag tag)
+{
+ Tk_FreeConfigOptions(tag->tagRecord,tagTable->optionTable,tagTable->tkwin);
+ ckfree(tag->tagRecord);
+ ckfree(tag);
+}
+
+/*------------------------------------------------------------------------
+ * +++ Tag tables.
+ */
+
+Ttk_TagTable Ttk_CreateTagTable(
+ Tcl_Interp *interp, Tk_Window tkwin,
+ Tk_OptionSpec optionSpecs[], int recordSize)
+{
+ Ttk_TagTable tagTable = ckalloc(sizeof(*tagTable));
+ tagTable->tkwin = tkwin;
+ tagTable->optionSpecs = optionSpecs;
+ tagTable->optionTable = Tk_CreateOptionTable(interp, optionSpecs);
+ tagTable->recordSize = recordSize;
+ tagTable->nTags = 0;
+ Tcl_InitHashTable(&tagTable->tags, TCL_STRING_KEYS);
+ return tagTable;
+}
+
+void Ttk_DeleteTagTable(Ttk_TagTable tagTable)
+{
+ Tcl_HashSearch search;
+ Tcl_HashEntry *entryPtr;
+
+ entryPtr = Tcl_FirstHashEntry(&tagTable->tags, &search);
+ while (entryPtr != NULL) {
+ DeleteTag(tagTable, Tcl_GetHashValue(entryPtr));
+ entryPtr = Tcl_NextHashEntry(&search);
+ }
+
+ Tcl_DeleteHashTable(&tagTable->tags);
+ ckfree(tagTable);
+}
+
+Ttk_Tag Ttk_GetTag(Ttk_TagTable tagTable, const char *tagName)
+{
+ int isNew = 0;
+ Tcl_HashEntry *entryPtr = Tcl_CreateHashEntry(
+ &tagTable->tags, tagName, &isNew);
+
+ if (isNew) {
+ tagName = Tcl_GetHashKey(&tagTable->tags, entryPtr);
+ Tcl_SetHashValue(entryPtr, NewTag(tagTable,tagName));
+ }
+ return Tcl_GetHashValue(entryPtr);
+}
+
+Ttk_Tag Ttk_GetTagFromObj(Ttk_TagTable tagTable, Tcl_Obj *objPtr)
+{
+ return Ttk_GetTag(tagTable, Tcl_GetString(objPtr));
+}
+
+/*------------------------------------------------------------------------
+ * +++ Tag sets.
+ */
+
+/* Ttk_GetTagSetFromObj --
+ * Extract an array of pointers to Ttk_Tags from a Tcl_Obj.
+ * objPtr may be NULL, in which case a new empty tag set is returned.
+ *
+ * Returns NULL and leaves an error message in interp->result on error.
+ *
+ * Non-NULL results must be passed to Ttk_FreeTagSet().
+ */
+Ttk_TagSet Ttk_GetTagSetFromObj(
+ Tcl_Interp *interp, Ttk_TagTable tagTable, Tcl_Obj *objPtr)
+{
+ Ttk_TagSet tagset = ckalloc(sizeof(*tagset));
+ Tcl_Obj **objv;
+ int i, objc;
+
+ if (objPtr == NULL) {
+ tagset->tags = NULL;
+ tagset->nTags = 0;
+ return tagset;
+ }
+
+ if (Tcl_ListObjGetElements(interp, objPtr, &objc, &objv) != TCL_OK) {
+ ckfree(tagset);
+ return NULL;
+ }
+
+ tagset->tags = ckalloc((objc+1) * sizeof(Ttk_Tag));
+ for (i=0; i<objc; ++i) {
+ tagset->tags[i] = Ttk_GetTagFromObj(tagTable, objv[i]);
+ }
+ tagset->tags[i] = NULL;
+ tagset->nTags = objc;
+
+ return tagset;
+}
+
+/* Ttk_NewTagSetObj --
+ * Construct a fresh Tcl_Obj * from a tag set.
+ */
+Tcl_Obj *Ttk_NewTagSetObj(Ttk_TagSet tagset)
+{
+ Tcl_Obj *result = Tcl_NewListObj(0,0);
+ int i;
+
+ for (i = 0; i < tagset->nTags; ++i) {
+ Tcl_ListObjAppendElement(
+ NULL, result, Tcl_NewStringObj(tagset->tags[i]->tagName, -1));
+ }
+ return result;
+}
+
+void Ttk_FreeTagSet(Ttk_TagSet tagset)
+{
+ ckfree(tagset->tags);
+ ckfree(tagset);
+}
+
+/* Ttk_TagSetContains -- test if tag set contains a tag.
+ */
+int Ttk_TagSetContains(Ttk_TagSet tagset, Ttk_Tag tag)
+{
+ int i;
+ for (i = 0; i < tagset->nTags; ++i) {
+ if (tagset->tags[i] == tag) {
+ return 1;
+ }
+ }
+ return 0;
+}
+
+/* Ttk_TagSetAdd -- add a tag to a tag set.
+ *
+ * Returns: 0 if tagset already contained tag,
+ * 1 if tagset was modified.
+ */
+int Ttk_TagSetAdd(Ttk_TagSet tagset, Ttk_Tag tag)
+{
+ int i;
+ for (i = 0; i < tagset->nTags; ++i) {
+ if (tagset->tags[i] == tag) {
+ return 0;
+ }
+ }
+ tagset->tags = ckrealloc(tagset->tags,
+ (tagset->nTags+1)*sizeof(tagset->tags[0]));
+ tagset->tags[tagset->nTags++] = tag;
+ return 1;
+}
+
+/* Ttk_TagSetRemove -- remove a tag from a tag set.
+ *
+ * Returns: 0 if tagset did not contain tag,
+ * 1 if tagset was modified.
+ */
+int Ttk_TagSetRemove(Ttk_TagSet tagset, Ttk_Tag tag)
+{
+ int i = 0, j = 0;
+ while (i < tagset->nTags) {
+ if ((tagset->tags[j] = tagset->tags[i]) != tag) {
+ ++j;
+ }
+ ++i;
+ }
+ tagset->nTags = j;
+ return j != i;
+}
+
+/*------------------------------------------------------------------------
+ * +++ Utilities for widget commands.
+ */
+
+/* Ttk_EnumerateTags -- implements [$w tag names]
+ */
+int Ttk_EnumerateTags(
+ Tcl_Interp *interp, Ttk_TagTable tagTable)
+{
+ return TtkEnumerateHashTable(interp, &tagTable->tags);
+}
+
+/* Ttk_EnumerateTagOptions -- implements [$w tag configure $tag]
+ */
+int Ttk_EnumerateTagOptions(
+ Tcl_Interp *interp, Ttk_TagTable tagTable, Ttk_Tag tag)
+{
+ return TtkEnumerateOptions(interp, tag->tagRecord,
+ tagTable->optionSpecs, tagTable->optionTable, tagTable->tkwin);
+}
+
+/* Ttk_TagOptionValue -- implements [$w tag configure $tag -option]
+ */
+Tcl_Obj *Ttk_TagOptionValue(
+ Tcl_Interp *interp,
+ Ttk_TagTable tagTable,
+ Ttk_Tag tag,
+ Tcl_Obj *optionName)
+{
+ return Tk_GetOptionValue(interp,
+ tag->tagRecord, tagTable->optionTable, optionName, tagTable->tkwin);
+}
+
+/* Ttk_ConfigureTag -- implements [$w tag configure $tag -option value...]
+ */
+int Ttk_ConfigureTag(
+ Tcl_Interp *interp,
+ Ttk_TagTable tagTable,
+ Ttk_Tag tag,
+ int objc, Tcl_Obj *const objv[])
+{
+ return Tk_SetOptions(
+ interp, tag->tagRecord, tagTable->optionTable,
+ objc, objv, tagTable->tkwin, NULL/*savedOptions*/, NULL/*mask*/);
+}
+
+/*------------------------------------------------------------------------
+ * +++ Tag values.
+ */
+
+#define OBJ_AT(record, offset) (*(Tcl_Obj**)(((char*)record)+offset))
+
+void Ttk_TagSetValues(Ttk_TagTable tagTable, Ttk_TagSet tagSet, void *record)
+{
+ const int LOWEST_PRIORITY = 0x7FFFFFFF;
+ int i, j;
+
+ memset(record, 0, tagTable->recordSize);
+
+ for (i = 0; tagTable->optionSpecs[i].type != TK_OPTION_END; ++i) {
+ Tk_OptionSpec *optionSpec = tagTable->optionSpecs + i;
+ int offset = optionSpec->objOffset;
+ int prio = LOWEST_PRIORITY;
+
+ for (j = 0; j < tagSet->nTags; ++j) {
+ Ttk_Tag tag = tagSet->tags[j];
+ if (OBJ_AT(tag->tagRecord, offset) != 0 && tag->priority < prio) {
+ OBJ_AT(record, offset) = OBJ_AT(tag->tagRecord, offset);
+ prio = tag->priority;
+ }
+ }
+ }
+}
+
+void Ttk_TagSetApplyStyle(
+ Ttk_TagTable tagTable, Ttk_Style style, Ttk_State state, void *record)
+{
+ Tk_OptionSpec *optionSpec = tagTable->optionSpecs;
+
+ while (optionSpec->type != TK_OPTION_END) {
+ int offset = optionSpec->objOffset;
+ const char *optionName = optionSpec->optionName;
+ Tcl_Obj *val = Ttk_StyleMap(style, optionName, state);
+ if (val) {
+ OBJ_AT(record, offset) = val;
+ } else if (OBJ_AT(record, offset) == 0) {
+ OBJ_AT(record, offset) = Ttk_StyleDefault(style, optionName);
+ }
+ ++optionSpec;
+ }
+}
+
diff --git a/tk8.6/generic/ttk/ttkTheme.c b/tk8.6/generic/ttk/ttkTheme.c
new file mode 100644
index 0000000..2f95962
--- /dev/null
+++ b/tk8.6/generic/ttk/ttkTheme.c
@@ -0,0 +1,1750 @@
+/*
+ * ttkTheme.c --
+ *
+ * This file implements the widget styles and themes support.
+ *
+ * Copyright (c) 2002 Frederic Bonnet
+ * Copyright (c) 2003 Joe English
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ */
+
+#include <stdlib.h>
+#include <string.h>
+#include <tk.h>
+#include <tkInt.h>
+#include "ttkThemeInt.h"
+
+#define PKG_ASSOC_KEY "Ttk"
+
+/*------------------------------------------------------------------------
+ * +++ Styles.
+ *
+ * Invariants:
+ * If styleName contains a dot, parentStyle->styleName is everything
+ * after the first dot; otherwise, parentStyle is the theme's root
+ * style ".". The root style's parentStyle is NULL.
+ *
+ */
+
+typedef struct Ttk_Style_
+{
+ const char *styleName; /* points to hash table key */
+ Tcl_HashTable settingsTable; /* KEY: string; VALUE: StateMap */
+ Tcl_HashTable defaultsTable; /* KEY: string; VALUE: resource */
+ Ttk_LayoutTemplate layoutTemplate; /* Layout template for style, or NULL */
+ Ttk_Style parentStyle; /* Previous style in chain */
+ Ttk_ResourceCache cache; /* Back-pointer to resource cache */
+} Style;
+
+static Style *NewStyle()
+{
+ Style *stylePtr = ckalloc(sizeof(Style));
+
+ stylePtr->styleName = NULL;
+ stylePtr->parentStyle = NULL;
+ stylePtr->layoutTemplate = NULL;
+ stylePtr->cache = NULL;
+ Tcl_InitHashTable(&stylePtr->settingsTable, TCL_STRING_KEYS);
+ Tcl_InitHashTable(&stylePtr->defaultsTable, TCL_STRING_KEYS);
+
+ return stylePtr;
+}
+
+static void FreeStyle(Style *stylePtr)
+{
+ Tcl_HashSearch search;
+ Tcl_HashEntry *entryPtr;
+
+ entryPtr = Tcl_FirstHashEntry(&stylePtr->settingsTable, &search);
+ while (entryPtr != NULL) {
+ Ttk_StateMap stateMap = Tcl_GetHashValue(entryPtr);
+ Tcl_DecrRefCount(stateMap);
+ entryPtr = Tcl_NextHashEntry(&search);
+ }
+ Tcl_DeleteHashTable(&stylePtr->settingsTable);
+
+ entryPtr = Tcl_FirstHashEntry(&stylePtr->defaultsTable, &search);
+ while (entryPtr != NULL) {
+ Tcl_Obj *defaultValue = Tcl_GetHashValue(entryPtr);
+ Tcl_DecrRefCount(defaultValue);
+ entryPtr = Tcl_NextHashEntry(&search);
+ }
+ Tcl_DeleteHashTable(&stylePtr->defaultsTable);
+
+ Ttk_FreeLayoutTemplate(stylePtr->layoutTemplate);
+
+ ckfree(stylePtr);
+}
+
+/*
+ * Ttk_StyleMap --
+ * Look up state-specific option value from specified style.
+ */
+Tcl_Obj *Ttk_StyleMap(Ttk_Style style, const char *optionName, Ttk_State state)
+{
+ while (style) {
+ Tcl_HashEntry *entryPtr =
+ Tcl_FindHashEntry(&style->settingsTable, optionName);
+ if (entryPtr) {
+ Ttk_StateMap stateMap = Tcl_GetHashValue(entryPtr);
+ return Ttk_StateMapLookup(NULL, stateMap, state);
+ }
+ style = style->parentStyle;
+ }
+ return 0;
+}
+
+/*
+ * Ttk_StyleDefault --
+ * Look up default resource setting the in the specified style.
+ */
+Tcl_Obj *Ttk_StyleDefault(Ttk_Style style, const char *optionName)
+{
+ while (style) {
+ Tcl_HashEntry *entryPtr =
+ Tcl_FindHashEntry(&style->defaultsTable, optionName);
+ if (entryPtr)
+ return Tcl_GetHashValue(entryPtr);
+ style= style->parentStyle;
+ }
+ return 0;
+}
+
+/*------------------------------------------------------------------------
+ * +++ Elements.
+ */
+typedef const Tk_OptionSpec **OptionMap;
+ /* array of Tk_OptionSpecs mapping widget options to element options */
+
+struct Ttk_ElementClass_ {
+ const char *name; /* Points to hash table key */
+ Ttk_ElementSpec *specPtr; /* Template provided during registration. */
+ void *clientData; /* Client data passed in at registration time */
+ void *elementRecord; /* Scratch buffer for element record storage */
+ int nResources; /* #Element options */
+ Tcl_Obj **defaultValues; /* Array of option default values */
+ Tcl_HashTable optMapCache; /* Map: Tk_OptionTable * -> OptionMap */
+};
+
+/* TTKGetOptionSpec --
+ * Look up a Tk_OptionSpec by name from a Tk_OptionTable,
+ * and verify that it's compatible with the specified Tk_OptionType,
+ * along with other constraints (see below).
+ */
+static const Tk_OptionSpec *TTKGetOptionSpec(
+ const char *optionName,
+ Tk_OptionTable optionTable,
+ Tk_OptionType optionType)
+{
+ const Tk_OptionSpec *optionSpec = TkGetOptionSpec(optionName, optionTable);
+
+ if (!optionSpec)
+ return 0;
+
+ /* Make sure widget option has a Tcl_Obj* entry:
+ */
+ if (optionSpec->objOffset < 0) {
+ return 0;
+ }
+
+ /* Grrr. Ignore accidental mismatches caused by prefix-matching:
+ */
+ if (strcmp(optionSpec->optionName, optionName)) {
+ return 0;
+ }
+
+ /* Ensure that the widget option type is compatible with
+ * the element option type.
+ *
+ * TK_OPTION_STRING element options are compatible with anything.
+ * As a workaround for the workaround for Bug #967209,
+ * TK_OPTION_STRING widget options are also compatible with anything
+ * (see <<NOTE-NULLOPTIONS>>).
+ */
+ if ( optionType != TK_OPTION_STRING
+ && optionSpec->type != TK_OPTION_STRING
+ && optionType != optionSpec->type)
+ {
+ return 0;
+ }
+
+ return optionSpec;
+}
+
+/* BuildOptionMap --
+ * Construct the mapping from element options to widget options.
+ */
+static OptionMap
+BuildOptionMap(Ttk_ElementClass *elementClass, Tk_OptionTable optionTable)
+{
+ OptionMap optionMap = ckalloc(
+ sizeof(const Tk_OptionSpec) * elementClass->nResources + 1);
+ int i;
+
+ for (i = 0; i < elementClass->nResources; ++i) {
+ Ttk_ElementOptionSpec *e = elementClass->specPtr->options+i;
+ optionMap[i] = TTKGetOptionSpec(e->optionName, optionTable, e->type);
+ }
+
+ return optionMap;
+}
+
+/* GetOptionMap --
+ * Return a cached OptionMap matching the specified optionTable
+ * for the specified element, creating it if necessary.
+ */
+static OptionMap
+GetOptionMap(Ttk_ElementClass *elementClass, Tk_OptionTable optionTable)
+{
+ OptionMap optionMap;
+ int isNew;
+ Tcl_HashEntry *entryPtr = Tcl_CreateHashEntry(
+ &elementClass->optMapCache, (void*)optionTable, &isNew);
+
+ if (isNew) {
+ optionMap = BuildOptionMap(elementClass, optionTable);
+ Tcl_SetHashValue(entryPtr, optionMap);
+ } else {
+ optionMap = Tcl_GetHashValue(entryPtr);
+ }
+
+ return optionMap;
+}
+
+/*
+ * NewElementClass --
+ * Allocate and initialize an element class record
+ * from the specified element specification.
+ */
+static Ttk_ElementClass *
+NewElementClass(const char *name, Ttk_ElementSpec *specPtr,void *clientData)
+{
+ Ttk_ElementClass *elementClass = ckalloc(sizeof(Ttk_ElementClass));
+ int i;
+
+ elementClass->name = name;
+ elementClass->specPtr = specPtr;
+ elementClass->clientData = clientData;
+ elementClass->elementRecord = ckalloc(specPtr->elementSize);
+
+ /* Count #element resources:
+ */
+ for (i = 0; specPtr->options[i].optionName != 0; ++i)
+ continue;
+ elementClass->nResources = i;
+
+ /* Initialize default values:
+ */
+ elementClass->defaultValues =
+ ckalloc(elementClass->nResources * sizeof(Tcl_Obj *) + 1);
+ for (i=0; i < elementClass->nResources; ++i) {
+ const char *defaultValue = specPtr->options[i].defaultValue;
+ if (defaultValue) {
+ elementClass->defaultValues[i] = Tcl_NewStringObj(defaultValue,-1);
+ Tcl_IncrRefCount(elementClass->defaultValues[i]);
+ } else {
+ elementClass->defaultValues[i] = 0;
+ }
+ }
+
+ /* Initialize option map cache:
+ */
+ Tcl_InitHashTable(&elementClass->optMapCache, TCL_ONE_WORD_KEYS);
+
+ return elementClass;
+}
+
+/*
+ * FreeElementClass --
+ * Release resources associated with an element class record.
+ */
+static void FreeElementClass(Ttk_ElementClass *elementClass)
+{
+ Tcl_HashSearch search;
+ Tcl_HashEntry *entryPtr;
+ int i;
+
+ /*
+ * Free default values:
+ */
+ for (i = 0; i < elementClass->nResources; ++i) {
+ if (elementClass->defaultValues[i]) {
+ Tcl_DecrRefCount(elementClass->defaultValues[i]);
+ }
+ }
+ ckfree(elementClass->defaultValues);
+
+ /*
+ * Free option map cache:
+ */
+ entryPtr = Tcl_FirstHashEntry(&elementClass->optMapCache, &search);
+ while (entryPtr != NULL) {
+ ckfree(Tcl_GetHashValue(entryPtr));
+ entryPtr = Tcl_NextHashEntry(&search);
+ }
+ Tcl_DeleteHashTable(&elementClass->optMapCache);
+
+ ckfree(elementClass->elementRecord);
+ ckfree(elementClass);
+}
+
+/*------------------------------------------------------------------------
+ * +++ Themes.
+ */
+
+static int ThemeEnabled(Ttk_Theme theme, void *clientData) { return 1; }
+ /* Default ThemeEnabledProc -- always return true */
+
+typedef struct Ttk_Theme_
+{
+ Ttk_Theme parentPtr; /* Parent theme. */
+ Tcl_HashTable elementTable; /* Map element names to class records */
+ Tcl_HashTable styleTable; /* Map style names to Styles */
+ Ttk_Style rootStyle; /* "." style, root of chain */
+ Ttk_ThemeEnabledProc *enabledProc; /* Function called by SetTheme */
+ void *enabledData; /* ClientData for enabledProc */
+ Ttk_ResourceCache cache; /* Back-pointer to resource cache */
+} Theme;
+
+static Theme *NewTheme(Ttk_ResourceCache cache, Ttk_Theme parent)
+{
+ Theme *themePtr = ckalloc(sizeof(Theme));
+ Tcl_HashEntry *entryPtr;
+ int unused;
+
+ themePtr->parentPtr = parent;
+ themePtr->enabledProc = ThemeEnabled;
+ themePtr->enabledData = NULL;
+ themePtr->cache = cache;
+ Tcl_InitHashTable(&themePtr->elementTable, TCL_STRING_KEYS);
+ Tcl_InitHashTable(&themePtr->styleTable, TCL_STRING_KEYS);
+
+ /*
+ * Create root style "."
+ */
+ entryPtr = Tcl_CreateHashEntry(&themePtr->styleTable, ".", &unused);
+ themePtr->rootStyle = NewStyle();
+ themePtr->rootStyle->styleName =
+ Tcl_GetHashKey(&themePtr->styleTable, entryPtr);
+ themePtr->rootStyle->cache = themePtr->cache;
+ Tcl_SetHashValue(entryPtr, themePtr->rootStyle);
+
+ return themePtr;
+}
+
+static void FreeTheme(Theme *themePtr)
+{
+ Tcl_HashSearch search;
+ Tcl_HashEntry *entryPtr;
+
+ /*
+ * Free element table:
+ */
+ entryPtr = Tcl_FirstHashEntry(&themePtr->elementTable, &search);
+ while (entryPtr != NULL) {
+ Ttk_ElementClass *elementClass = Tcl_GetHashValue(entryPtr);
+ FreeElementClass(elementClass);
+ entryPtr = Tcl_NextHashEntry(&search);
+ }
+ Tcl_DeleteHashTable(&themePtr->elementTable);
+
+ /*
+ * Free style table:
+ */
+ entryPtr = Tcl_FirstHashEntry(&themePtr->styleTable, &search);
+ while (entryPtr != NULL) {
+ Style *stylePtr = Tcl_GetHashValue(entryPtr);
+ FreeStyle(stylePtr);
+ entryPtr = Tcl_NextHashEntry(&search);
+ }
+ Tcl_DeleteHashTable(&themePtr->styleTable);
+
+ /*
+ * Free theme record:
+ */
+ ckfree(themePtr);
+
+ return;
+}
+
+/*
+ * Element constructors.
+ */
+typedef struct {
+ Ttk_ElementFactory factory;
+ void *clientData;
+} FactoryRec;
+
+/*
+ * Cleanup records:
+ */
+typedef struct CleanupStruct {
+ void *clientData;
+ Ttk_CleanupProc *cleanupProc;
+ struct CleanupStruct *next;
+} Cleanup;
+
+/*------------------------------------------------------------------------
+ * +++ Master style package data structure.
+ */
+typedef struct
+{
+ Tcl_Interp *interp; /* Owner interp */
+ Tcl_HashTable themeTable; /* KEY: name; VALUE: Theme pointer */
+ Tcl_HashTable factoryTable; /* KEY: name; VALUE: FactoryRec ptr */
+ Theme *defaultTheme; /* Default theme; global fallback*/
+ Theme *currentTheme; /* Currently-selected theme */
+ Cleanup *cleanupList; /* Cleanup records */
+ Ttk_ResourceCache cache; /* Resource cache */
+ int themeChangePending; /* scheduled ThemeChangedProc call? */
+} StylePackageData;
+
+static void ThemeChangedProc(ClientData); /* Forward */
+
+/* Ttk_StylePkgFree --
+ * Cleanup procedure for StylePackageData.
+ */
+static void Ttk_StylePkgFree(ClientData clientData, Tcl_Interp *interp)
+{
+ StylePackageData *pkgPtr = clientData;
+ Tcl_HashSearch search;
+ Tcl_HashEntry *entryPtr;
+ Cleanup *cleanup;
+
+ /*
+ * Cancel any pending ThemeChanged calls:
+ */
+ if (pkgPtr->themeChangePending) {
+ Tcl_CancelIdleCall(ThemeChangedProc, pkgPtr);
+ }
+
+ /*
+ * Free themes.
+ */
+ entryPtr = Tcl_FirstHashEntry(&pkgPtr->themeTable, &search);
+ while (entryPtr != NULL) {
+ Theme *themePtr = Tcl_GetHashValue(entryPtr);
+ FreeTheme(themePtr);
+ entryPtr = Tcl_NextHashEntry(&search);
+ }
+ Tcl_DeleteHashTable(&pkgPtr->themeTable);
+
+ /*
+ * Free element constructor table:
+ */
+ entryPtr = Tcl_FirstHashEntry(&pkgPtr->factoryTable, &search);
+ while (entryPtr != NULL) {
+ ckfree(Tcl_GetHashValue(entryPtr));
+ entryPtr = Tcl_NextHashEntry(&search);
+ }
+ Tcl_DeleteHashTable(&pkgPtr->factoryTable);
+
+ /*
+ * Release cache:
+ */
+ Ttk_FreeResourceCache(pkgPtr->cache);
+
+ /*
+ * Call all registered cleanup procedures:
+ */
+ cleanup = pkgPtr->cleanupList;
+ while (cleanup) {
+ Cleanup *next = cleanup->next;
+ cleanup->cleanupProc(cleanup->clientData);
+ ckfree(cleanup);
+ cleanup = next;
+ }
+
+ ckfree(pkgPtr);
+}
+
+/*
+ * GetStylePackageData --
+ * Look up the package data registered with the interp.
+ */
+
+static StylePackageData *GetStylePackageData(Tcl_Interp *interp)
+{
+ return Tcl_GetAssocData(interp, PKG_ASSOC_KEY, NULL);
+}
+
+/*
+ * Ttk_RegisterCleanup --
+ *
+ * Register a function to be called when a theme engine is deleted.
+ * (This only happens when the main interp is destroyed). The cleanup
+ * function is called with the current Tcl interpreter and the client
+ * data provided here.
+ *
+ */
+void Ttk_RegisterCleanup(
+ Tcl_Interp *interp, ClientData clientData, Ttk_CleanupProc *cleanupProc)
+{
+ StylePackageData *pkgPtr = GetStylePackageData(interp);
+ Cleanup *cleanup = ckalloc(sizeof(*cleanup));
+
+ cleanup->clientData = clientData;
+ cleanup->cleanupProc = cleanupProc;
+ cleanup->next = pkgPtr->cleanupList;
+ pkgPtr->cleanupList = cleanup;
+}
+
+/* ThemeChangedProc --
+ * Notify all widgets that the theme has been changed.
+ * Scheduled as an idle callback; clientData is a StylePackageData *.
+ *
+ * Sends a <<ThemeChanged>> event to every widget in the hierarchy.
+ * Widgets respond to this by calling the WorldChanged class proc,
+ * which in turn recreates the layout.
+ *
+ * The Tk C API doesn't doesn't provide an easy way to traverse
+ * the widget hierarchy, so this is done by evaluating a Tcl script.
+ */
+
+static void ThemeChangedProc(ClientData clientData)
+{
+ static char ThemeChangedScript[] = "ttk::ThemeChanged";
+ StylePackageData *pkgPtr = clientData;
+
+ int code = Tcl_EvalEx(pkgPtr->interp, ThemeChangedScript, -1, TCL_EVAL_GLOBAL);
+ if (code != TCL_OK) {
+ Tcl_BackgroundException(pkgPtr->interp, code);
+ }
+ pkgPtr->themeChangePending = 0;
+}
+
+/*
+ * ThemeChanged --
+ * Schedule a call to ThemeChanged if one is not already pending.
+ */
+static void ThemeChanged(StylePackageData *pkgPtr)
+{
+ if (!pkgPtr->themeChangePending) {
+ Tcl_DoWhenIdle(ThemeChangedProc, pkgPtr);
+ pkgPtr->themeChangePending = 1;
+ }
+}
+
+/*
+ * Ttk_CreateTheme --
+ * Create a new theme and register it in the global theme table.
+ *
+ * Returns:
+ * Pointer to new Theme structure; NULL if named theme already exists.
+ * Leaves an error message in interp's result on error.
+ */
+
+Ttk_Theme
+Ttk_CreateTheme(
+ Tcl_Interp *interp, /* Interpreter in which to create theme */
+ const char *name, /* Name of the theme to create. */
+ Ttk_Theme parent) /* Parent/fallback theme, NULL for default */
+{
+ StylePackageData *pkgPtr = GetStylePackageData(interp);
+ Tcl_HashEntry *entryPtr;
+ int newEntry;
+ Theme *themePtr;
+
+ entryPtr = Tcl_CreateHashEntry(&pkgPtr->themeTable, name, &newEntry);
+ if (!newEntry) {
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "Theme %s already exists", name));
+ Tcl_SetErrorCode(interp, "TTK", "THEME", "EXISTS", NULL);
+ return NULL;
+ }
+
+ /*
+ * Initialize new theme:
+ */
+ if (!parent) parent = pkgPtr->defaultTheme;
+
+ themePtr = NewTheme(pkgPtr->cache, parent);
+ Tcl_SetHashValue(entryPtr, themePtr);
+
+ return themePtr;
+}
+
+/*
+ * Ttk_SetThemeEnabledProc --
+ * Sets a procedure that is used to check that this theme is available.
+ */
+
+void Ttk_SetThemeEnabledProc(
+ Ttk_Theme theme, Ttk_ThemeEnabledProc enabledProc, void *enabledData)
+{
+ theme->enabledProc = enabledProc;
+ theme->enabledData = enabledData;
+}
+
+/*
+ * LookupTheme --
+ * Retrieve a registered theme by name. If not found,
+ * returns NULL and leaves an error message in interp's result.
+ */
+
+static Ttk_Theme LookupTheme(
+ Tcl_Interp *interp, /* where to leave error messages */
+ StylePackageData *pkgPtr, /* style package master record */
+ const char *name) /* theme name */
+{
+ Tcl_HashEntry *entryPtr;
+
+ entryPtr = Tcl_FindHashEntry(&pkgPtr->themeTable, name);
+ if (!entryPtr) {
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "theme \"%s\" doesn't exist", name));
+ Tcl_SetErrorCode(interp, "TTK", "LOOKUP", "THEME", name, NULL);
+ return NULL;
+ }
+
+ return Tcl_GetHashValue(entryPtr);
+}
+
+/*
+ * Ttk_GetTheme --
+ * Public interface to LookupTheme.
+ */
+Ttk_Theme Ttk_GetTheme(Tcl_Interp *interp, const char *themeName)
+{
+ StylePackageData *pkgPtr = GetStylePackageData(interp);
+
+ return LookupTheme(interp, pkgPtr, themeName);
+}
+
+Ttk_Theme Ttk_GetCurrentTheme(Tcl_Interp *interp)
+{
+ StylePackageData *pkgPtr = GetStylePackageData(interp);
+ return pkgPtr->currentTheme;
+}
+
+Ttk_Theme Ttk_GetDefaultTheme(Tcl_Interp *interp)
+{
+ StylePackageData *pkgPtr = GetStylePackageData(interp);
+ return pkgPtr->defaultTheme;
+}
+
+/*
+ * Ttk_UseTheme --
+ * Set the current theme, notify all widgets that the theme has changed.
+ */
+int Ttk_UseTheme(Tcl_Interp *interp, Ttk_Theme theme)
+{
+ StylePackageData *pkgPtr = GetStylePackageData(interp);
+
+ /*
+ * Check if selected theme is enabled:
+ */
+ while (theme && !theme->enabledProc(theme, theme->enabledData)) {
+ theme = theme->parentPtr;
+ }
+ if (!theme) {
+ /* This shouldn't happen -- default theme should always work */
+ Tcl_Panic("No themes available?");
+ return TCL_ERROR;
+ }
+
+ pkgPtr->currentTheme = theme;
+ ThemeChanged(pkgPtr);
+ return TCL_OK;
+}
+
+/*
+ * Ttk_GetResourceCache --
+ * Return the resource cache associated with 'interp'
+ */
+Ttk_ResourceCache
+Ttk_GetResourceCache(Tcl_Interp *interp)
+{
+ StylePackageData *pkgPtr = GetStylePackageData(interp);
+ return pkgPtr->cache;
+}
+
+/*
+ * Register a new layout specification with a style.
+ * @@@ TODO: Make sure layoutName is not ".", root style must not have a layout
+ */
+MODULE_SCOPE
+void Ttk_RegisterLayoutTemplate(
+ Ttk_Theme theme, /* Target theme */
+ const char *layoutName, /* Name of new layout */
+ Ttk_LayoutTemplate layoutTemplate) /* Template */
+{
+ Ttk_Style style = Ttk_GetStyle(theme, layoutName);
+ if (style->layoutTemplate) {
+ Ttk_FreeLayoutTemplate(style->layoutTemplate);
+ }
+ style->layoutTemplate = layoutTemplate;
+}
+
+void Ttk_RegisterLayout(
+ Ttk_Theme themePtr, /* Target theme */
+ const char *layoutName, /* Name of new layout */
+ Ttk_LayoutSpec specPtr) /* Static layout information */
+{
+ Ttk_LayoutTemplate layoutTemplate = Ttk_BuildLayoutTemplate(specPtr);
+ Ttk_RegisterLayoutTemplate(themePtr, layoutName, layoutTemplate);
+}
+
+/*
+ * Ttk_GetStyle --
+ * Look up a Style from a Theme, create new style if not found.
+ */
+Ttk_Style Ttk_GetStyle(Ttk_Theme themePtr, const char *styleName)
+{
+ Tcl_HashEntry *entryPtr;
+ int newStyle;
+
+ entryPtr = Tcl_CreateHashEntry(&themePtr->styleTable, styleName, &newStyle);
+ if (newStyle) {
+ Ttk_Style stylePtr = NewStyle();
+ const char *dot = strchr(styleName, '.');
+
+ if (dot) {
+ stylePtr->parentStyle = Ttk_GetStyle(themePtr, dot + 1);
+ } else {
+ stylePtr->parentStyle = themePtr->rootStyle;
+ }
+
+ stylePtr->styleName = Tcl_GetHashKey(&themePtr->styleTable, entryPtr);
+ stylePtr->cache = stylePtr->parentStyle->cache;
+ Tcl_SetHashValue(entryPtr, stylePtr);
+ return stylePtr;
+ }
+ return Tcl_GetHashValue(entryPtr);
+}
+
+/* FindLayoutTemplate --
+ * Locate a layout template in the layout table, checking
+ * generic names to specific names first, then looking for
+ * the full name in the parent theme.
+ */
+Ttk_LayoutTemplate
+Ttk_FindLayoutTemplate(Ttk_Theme themePtr, const char *layoutName)
+{
+ while (themePtr) {
+ Ttk_Style stylePtr = Ttk_GetStyle(themePtr, layoutName);
+ while (stylePtr) {
+ if (stylePtr->layoutTemplate) {
+ return stylePtr->layoutTemplate;
+ }
+ stylePtr = stylePtr->parentStyle;
+ }
+ themePtr = themePtr->parentPtr;
+ }
+ return NULL;
+}
+
+const char *Ttk_StyleName(Ttk_Style stylePtr)
+{
+ return stylePtr->styleName;
+}
+
+/*
+ * Ttk_GetElement --
+ * Look up an element class by name in a given theme.
+ * If not found, try generic element names in this theme, then
+ * repeat the lookups in the parent theme.
+ * If not found, return the null element.
+ */
+Ttk_ElementClass *Ttk_GetElement(Ttk_Theme themePtr, const char *elementName)
+{
+ Tcl_HashEntry *entryPtr;
+ const char *dot = elementName;
+
+ /*
+ * Check if element has already been registered:
+ */
+ entryPtr = Tcl_FindHashEntry(&themePtr->elementTable, elementName);
+ if (entryPtr) {
+ return Tcl_GetHashValue(entryPtr);
+ }
+
+ /*
+ * Check generic names:
+ */
+ while (!entryPtr && ((dot = strchr(dot, '.')) != NULL)) {
+ dot++;
+ entryPtr = Tcl_FindHashEntry(&themePtr->elementTable, dot);
+ }
+ if (entryPtr) {
+ return Tcl_GetHashValue(entryPtr);
+ }
+
+ /*
+ * Check parent theme:
+ */
+ if (themePtr->parentPtr) {
+ return Ttk_GetElement(themePtr->parentPtr, elementName);
+ }
+
+ /*
+ * Not found, and this is the root theme; return null element, "".
+ * (@@@ SHOULD: signal a background error)
+ */
+ entryPtr = Tcl_FindHashEntry(&themePtr->elementTable, "");
+ /* ASSERT: entryPtr != 0 */
+ return Tcl_GetHashValue(entryPtr);
+}
+
+const char *Ttk_ElementClassName(Ttk_ElementClass *elementClass)
+{
+ return elementClass->name;
+}
+
+/*
+ * Ttk_RegisterElementFactory --
+ * Register a new element factory.
+ */
+int Ttk_RegisterElementFactory(
+ Tcl_Interp *interp, const char *name,
+ Ttk_ElementFactory factory, void *clientData)
+{
+ StylePackageData *pkgPtr = GetStylePackageData(interp);
+ FactoryRec *recPtr = ckalloc(sizeof(*recPtr));
+ Tcl_HashEntry *entryPtr;
+ int newEntry;
+
+ recPtr->factory = factory;
+ recPtr->clientData = clientData;
+
+ entryPtr = Tcl_CreateHashEntry(&pkgPtr->factoryTable, name, &newEntry);
+ if (!newEntry) {
+ /* Free old factory: */
+ ckfree(Tcl_GetHashValue(entryPtr));
+ }
+ Tcl_SetHashValue(entryPtr, recPtr);
+
+ return TCL_OK;
+}
+
+/* Ttk_CloneElement -- element factory procedure.
+ * (style element create $name) "from" $theme ?$element?
+ */
+static int Ttk_CloneElement(
+ Tcl_Interp *interp, void *clientData,
+ Ttk_Theme theme, const char *elementName,
+ int objc, Tcl_Obj *const objv[])
+{
+ Ttk_Theme fromTheme;
+ Ttk_ElementClass *fromElement;
+
+ if (objc <= 0 || objc > 2) {
+ Tcl_WrongNumArgs(interp, 0, objv, "theme ?element?");
+ return TCL_ERROR;
+ }
+
+ fromTheme = Ttk_GetTheme(interp, Tcl_GetString(objv[0]));
+ if (!fromTheme) {
+ return TCL_ERROR;
+ }
+
+ if (objc == 2) {
+ fromElement = Ttk_GetElement(fromTheme, Tcl_GetString(objv[1]));
+ } else {
+ fromElement = Ttk_GetElement(fromTheme, elementName);
+ }
+ if (!fromElement) {
+ return TCL_ERROR;
+ }
+
+ if (Ttk_RegisterElement(interp, theme, elementName,
+ fromElement->specPtr, fromElement->clientData) == NULL)
+ {
+ return TCL_ERROR;
+ }
+ return TCL_OK;
+}
+
+/* Ttk_RegisterElement--
+ * Register an element in the given theme.
+ * Returns: Element handle if successful, NULL otherwise.
+ * On failure, leaves an error message in interp's result
+ * if interp is non-NULL.
+ */
+
+Ttk_ElementClass *Ttk_RegisterElement(
+ Tcl_Interp *interp, /* Where to leave error messages */
+ Ttk_Theme theme, /* Style engine providing the implementation. */
+ const char *name, /* Name of new element */
+ Ttk_ElementSpec *specPtr, /* Static template information */
+ void *clientData) /* application-specific data */
+{
+ Ttk_ElementClass *elementClass;
+ Tcl_HashEntry *entryPtr;
+ int newEntry;
+
+ if (specPtr->version != TK_STYLE_VERSION_2) {
+ /* Version mismatch */
+ if (interp) {
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "Internal error: Ttk_RegisterElement (%s): invalid version",
+ name));
+ Tcl_SetErrorCode(interp, "TTK", "REGISTER_ELEMENT", "VERSION",
+ NULL);
+ }
+ return 0;
+ }
+
+ entryPtr = Tcl_CreateHashEntry(&theme->elementTable, name, &newEntry);
+ if (!newEntry) {
+ if (interp) {
+ Tcl_ResetResult(interp);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "Duplicate element %s", name));
+ Tcl_SetErrorCode(interp, "TTK", "REGISTER_ELEMENT", "DUPE", NULL);
+ }
+ return 0;
+ }
+
+ name = Tcl_GetHashKey(&theme->elementTable, entryPtr);
+ elementClass = NewElementClass(name, specPtr, clientData);
+ Tcl_SetHashValue(entryPtr, elementClass);
+
+ return elementClass;
+}
+
+/* Ttk_RegisterElementSpec (deprecated) --
+ * Register a new element.
+ */
+int Ttk_RegisterElementSpec(Ttk_Theme theme,
+ const char *name, Ttk_ElementSpec *specPtr, void *clientData)
+{
+ return Ttk_RegisterElement(NULL, theme, name, specPtr, clientData)
+ ? TCL_OK : TCL_ERROR;
+}
+
+/*------------------------------------------------------------------------
+ * +++ Element record initialization.
+ */
+
+/*
+ * AllocateResource --
+ * Extra initialization for element options like TK_OPTION_COLOR, etc.
+ *
+ * Returns: 1 if OK, 0 on failure.
+ *
+ * Note: if resource allocation fails at this point (just prior
+ * to drawing an element), there's really no good place to
+ * report the error. Instead we just silently fail.
+ */
+
+static int AllocateResource(
+ Ttk_ResourceCache cache,
+ Tk_Window tkwin,
+ Tcl_Obj **destPtr,
+ int optionType)
+{
+ Tcl_Obj *resource = *destPtr;
+
+ switch (optionType)
+ {
+ case TK_OPTION_FONT:
+ return (*destPtr = Ttk_UseFont(cache, tkwin, resource)) != NULL;
+ case TK_OPTION_COLOR:
+ return (*destPtr = Ttk_UseColor(cache, tkwin, resource)) != NULL;
+ case TK_OPTION_BORDER:
+ return (*destPtr = Ttk_UseBorder(cache, tkwin, resource)) != NULL;
+ default:
+ /* no-op; always succeeds */
+ return 1;
+ }
+}
+
+/*
+ * InitializeElementRecord --
+ *
+ * Fill in the element record based on the element's option table.
+ * Resources are initialized from:
+ * the corresponding widget option if present and non-NULL,
+ * otherwise the dynamic state map if specified,
+ * otherwise from the corresponding widget resource if present,
+ * otherwise the default value specified at registration time.
+ *
+ * Returns:
+ * 1 if OK, 0 if an error is detected.
+ *
+ * NOTES:
+ * Tcl_Obj * reference counts are _NOT_ adjusted.
+ */
+
+static
+int InitializeElementRecord(
+ Ttk_ElementClass *eclass, /* Element instance to initialize */
+ Ttk_Style style, /* Style table */
+ char *widgetRecord, /* Source of widget option values */
+ Tk_OptionTable optionTable, /* Option table describing widget record */
+ Tk_Window tkwin, /* Corresponding window */
+ Ttk_State state) /* Widget or element state */
+{
+ char *elementRecord = eclass->elementRecord;
+ OptionMap optionMap = GetOptionMap(eclass,optionTable);
+ int nResources = eclass->nResources;
+ Ttk_ResourceCache cache = style->cache;
+ Ttk_ElementOptionSpec *elementOption = eclass->specPtr->options;
+
+ int i;
+ for (i=0; i<nResources; ++i, ++elementOption) {
+ Tcl_Obj **dest = (Tcl_Obj **)
+ (elementRecord + elementOption->offset);
+ const char *optionName = elementOption->optionName;
+ Tcl_Obj *dynamicSetting = Ttk_StyleMap(style, optionName, state);
+ Tcl_Obj *widgetValue = 0;
+ Tcl_Obj *elementDefault = eclass->defaultValues[i];
+
+ if (optionMap[i]) {
+ widgetValue = *(Tcl_Obj **)
+ (widgetRecord + optionMap[i]->objOffset);
+ }
+
+ if (widgetValue) {
+ *dest = widgetValue;
+ } else if (dynamicSetting) {
+ *dest = dynamicSetting;
+ } else {
+ Tcl_Obj *styleDefault = Ttk_StyleDefault(style, optionName);
+ *dest = styleDefault ? styleDefault : elementDefault;
+ }
+
+ if (!AllocateResource(cache, tkwin, dest, elementOption->type)) {
+ return 0;
+ }
+ }
+
+ return 1;
+}
+
+/*------------------------------------------------------------------------
+ * +++ Public API.
+ */
+
+/*
+ * Ttk_QueryStyle --
+ * Look up a style option based on the current state.
+ */
+Tcl_Obj *Ttk_QueryStyle(
+ Ttk_Style style, /* Style to query */
+ void *recordPtr, /* Widget record */
+ Tk_OptionTable optionTable, /* Option table describing widget record */
+ const char *optionName, /* Option name */
+ Ttk_State state) /* Current state */
+{
+ const Tk_OptionSpec *optionSpec;
+ Tcl_Obj *result;
+
+ /*
+ * Check widget record:
+ */
+ optionSpec = TTKGetOptionSpec(optionName, optionTable, TK_OPTION_ANY);
+ if (optionSpec) {
+ result = *(Tcl_Obj**)(((char*)recordPtr) + optionSpec->objOffset);
+ if (result) {
+ return result;
+ }
+ }
+
+ /*
+ * Check dynamic settings:
+ */
+ result = Ttk_StyleMap(style, optionName, state);
+ if (result) {
+ return result;
+ }
+
+ /*
+ * Use style default:
+ */
+ return Ttk_StyleDefault(style, optionName);
+}
+
+/*
+ * Ttk_ElementSize --
+ * Compute the requested size of the given element.
+ */
+
+void
+Ttk_ElementSize(
+ Ttk_ElementClass *eclass, /* Element to query */
+ Ttk_Style style, /* Style settings */
+ char *recordPtr, /* The widget record. */
+ Tk_OptionTable optionTable, /* Description of widget record */
+ Tk_Window tkwin, /* The widget window. */
+ Ttk_State state, /* Current widget state */
+ int *widthPtr, /* Requested width */
+ int *heightPtr, /* Reqested height */
+ Ttk_Padding *paddingPtr) /* Requested inner border */
+{
+ paddingPtr->left = paddingPtr->right = paddingPtr->top = paddingPtr->bottom
+ = *widthPtr = *heightPtr = 0;
+
+ if (!InitializeElementRecord(
+ eclass, style, recordPtr, optionTable, tkwin, state))
+ {
+ return;
+ }
+ eclass->specPtr->size(
+ eclass->clientData, eclass->elementRecord,
+ tkwin, widthPtr, heightPtr, paddingPtr);
+}
+
+/*
+ * Ttk_DrawElement --
+ * Draw the given widget element in a given drawable area.
+ */
+
+void
+Ttk_DrawElement(
+ Ttk_ElementClass *eclass, /* Element instance */
+ Ttk_Style style, /* Style settings */
+ char *recordPtr, /* The widget record. */
+ Tk_OptionTable optionTable, /* Description of option table */
+ Tk_Window tkwin, /* The widget window. */
+ Drawable d, /* Where to draw element. */
+ Ttk_Box b, /* Element area */
+ Ttk_State state) /* Widget or element state flags. */
+{
+ if (b.width <= 0 || b.height <= 0)
+ return;
+ if (!InitializeElementRecord(
+ eclass, style, recordPtr, optionTable, tkwin, state))
+ {
+ return;
+ }
+ eclass->specPtr->draw(
+ eclass->clientData, eclass->elementRecord,
+ tkwin, d, b, state);
+}
+
+/*------------------------------------------------------------------------
+ * +++ 'style' command ensemble procedures.
+ */
+
+/*
+ * TtkEnumerateHashTable --
+ * Helper routine. Sets interp's result to the list of all keys
+ * in the hash table.
+ *
+ * Returns: TCL_OK.
+ * Side effects: Sets interp's result.
+ */
+
+MODULE_SCOPE
+int TtkEnumerateHashTable(Tcl_Interp *interp, Tcl_HashTable *ht)
+{
+ Tcl_HashSearch search;
+ Tcl_Obj *result = Tcl_NewListObj(0, NULL);
+ Tcl_HashEntry *entryPtr = Tcl_FirstHashEntry(ht, &search);
+
+ while (entryPtr != NULL) {
+ Tcl_Obj *nameObj = Tcl_NewStringObj(Tcl_GetHashKey(ht, entryPtr),-1);
+ Tcl_ListObjAppendElement(interp, result, nameObj);
+ entryPtr = Tcl_NextHashEntry(&search);
+ }
+
+ Tcl_SetObjResult(interp, result);
+ return TCL_OK;
+}
+
+/* HashTableToDict --
+ * Helper routine. Converts a TCL_STRING_KEYS Tcl_HashTable
+ * with Tcl_Obj * entries into a dictionary.
+ */
+static Tcl_Obj* HashTableToDict(Tcl_HashTable *ht)
+{
+ Tcl_HashSearch search;
+ Tcl_Obj *result = Tcl_NewListObj(0, NULL);
+ Tcl_HashEntry *entryPtr = Tcl_FirstHashEntry(ht, &search);
+
+ while (entryPtr != NULL) {
+ Tcl_Obj *nameObj = Tcl_NewStringObj(Tcl_GetHashKey(ht, entryPtr),-1);
+ Tcl_Obj *valueObj = Tcl_GetHashValue(entryPtr);
+ Tcl_ListObjAppendElement(NULL, result, nameObj);
+ Tcl_ListObjAppendElement(NULL, result, valueObj);
+ entryPtr = Tcl_NextHashEntry(&search);
+ }
+
+ return result;
+}
+
+/* + style map $style ? -resource statemap ... ?
+ *
+ * Note that resource names are unconstrained; the Style
+ * doesn't know what resources individual elements may use.
+ */
+static int
+StyleMapCmd(
+ ClientData clientData, /* Master StylePackageData pointer */
+ Tcl_Interp *interp, /* Current interpreter */
+ int objc, /* Number of arguments */
+ Tcl_Obj *const objv[]) /* Argument objects */
+{
+ StylePackageData *pkgPtr = clientData;
+ Ttk_Theme theme = pkgPtr->currentTheme;
+ const char *styleName;
+ Style *stylePtr;
+ int i;
+
+ if (objc < 3) {
+usage:
+ Tcl_WrongNumArgs(interp,2,objv,"style ?-option ?value...??");
+ return TCL_ERROR;
+ }
+
+ styleName = Tcl_GetString(objv[2]);
+ stylePtr = Ttk_GetStyle(theme, styleName);
+
+ /* NOTE: StateMaps are actually Tcl_Obj *s, so HashTableToDict works
+ * for settingsTable.
+ */
+ if (objc == 3) { /* style map $styleName */
+ Tcl_SetObjResult(interp, HashTableToDict(&stylePtr->settingsTable));
+ return TCL_OK;
+ } else if (objc == 4) { /* style map $styleName -option */
+ const char *optionName = Tcl_GetString(objv[3]);
+ Tcl_HashEntry *entryPtr =
+ Tcl_FindHashEntry(&stylePtr->settingsTable, optionName);
+ if (entryPtr) {
+ Tcl_SetObjResult(interp, (Tcl_Obj*)Tcl_GetHashValue(entryPtr));
+ }
+ return TCL_OK;
+ } else if (objc % 2 != 1) {
+ goto usage;
+ }
+
+ for (i = 3; i < objc; i += 2) {
+ const char *optionName = Tcl_GetString(objv[i]);
+ Tcl_Obj *stateMap = objv[i+1];
+ Tcl_HashEntry *entryPtr;
+ int newEntry;
+
+ /* Make sure 'stateMap' is legal:
+ * (@@@ SHOULD: check for valid resource values as well,
+ * but we don't know what types they should be at this level.)
+ */
+ if (!Ttk_GetStateMapFromObj(interp, stateMap))
+ return TCL_ERROR;
+
+ entryPtr = Tcl_CreateHashEntry(
+ &stylePtr->settingsTable,optionName,&newEntry);
+
+ Tcl_IncrRefCount(stateMap);
+ if (!newEntry) {
+ Tcl_DecrRefCount((Tcl_Obj*)Tcl_GetHashValue(entryPtr));
+ }
+ Tcl_SetHashValue(entryPtr, stateMap);
+ }
+ ThemeChanged(pkgPtr);
+ return TCL_OK;
+}
+
+/* + style configure $style -option ?value...
+ */
+static int StyleConfigureCmd(
+ ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[])
+{
+ StylePackageData *pkgPtr = clientData;
+ Ttk_Theme theme = pkgPtr->currentTheme;
+ const char *styleName;
+ Style *stylePtr;
+ int i;
+
+ if (objc < 3) {
+usage:
+ Tcl_WrongNumArgs(interp,2,objv,"style ?-option ?value...??");
+ return TCL_ERROR;
+ }
+
+ styleName = Tcl_GetString(objv[2]);
+ stylePtr = Ttk_GetStyle(theme, styleName);
+
+ if (objc == 3) { /* style default $styleName */
+ Tcl_SetObjResult(interp, HashTableToDict(&stylePtr->defaultsTable));
+ return TCL_OK;
+ } else if (objc == 4) { /* style default $styleName -option */
+ const char *optionName = Tcl_GetString(objv[3]);
+ Tcl_HashEntry *entryPtr =
+ Tcl_FindHashEntry(&stylePtr->defaultsTable, optionName);
+ if (entryPtr) {
+ Tcl_SetObjResult(interp, (Tcl_Obj*)Tcl_GetHashValue(entryPtr));
+ }
+ return TCL_OK;
+ } else if (objc % 2 != 1) {
+ goto usage;
+ }
+
+ for (i = 3; i < objc; i += 2) {
+ const char *optionName = Tcl_GetString(objv[i]);
+ Tcl_Obj *value = objv[i+1];
+ Tcl_HashEntry *entryPtr;
+ int newEntry;
+
+ entryPtr = Tcl_CreateHashEntry(
+ &stylePtr->defaultsTable,optionName,&newEntry);
+
+ Tcl_IncrRefCount(value);
+ if (!newEntry) {
+ Tcl_DecrRefCount((Tcl_Obj*)Tcl_GetHashValue(entryPtr));
+ }
+ Tcl_SetHashValue(entryPtr, value);
+ }
+
+ ThemeChanged(pkgPtr);
+ return TCL_OK;
+}
+
+/* + style lookup $style -option ?statespec? ?defaultValue?
+ */
+static int StyleLookupCmd(
+ ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[])
+{
+ StylePackageData *pkgPtr = clientData;
+ Ttk_Theme theme = pkgPtr->currentTheme;
+ Ttk_Style style = NULL;
+ const char *optionName;
+ Ttk_State state = 0ul;
+ Tcl_Obj *result;
+
+ if (objc < 4 || objc > 6) {
+ Tcl_WrongNumArgs(interp, 2, objv, "style -option ?state? ?default?");
+ return TCL_ERROR;
+ }
+
+ style = Ttk_GetStyle(theme, Tcl_GetString(objv[2]));
+ if (!style) {
+ return TCL_ERROR;
+ }
+ optionName = Tcl_GetString(objv[3]);
+
+ if (objc >= 5) {
+ Ttk_StateSpec stateSpec;
+ /* @@@ SB: Ttk_GetStateFromObj(); 'offbits' spec is ignored */
+ if (Ttk_GetStateSpecFromObj(interp, objv[4], &stateSpec) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ state = stateSpec.onbits;
+ }
+
+ result = Ttk_QueryStyle(style, NULL,NULL, optionName, state);
+ if (result == NULL && objc >= 6) { /* Use caller-supplied fallback */
+ result = objv[5];
+ }
+
+ if (result) {
+ Tcl_SetObjResult(interp, result);
+ }
+
+ return TCL_OK;
+}
+
+static int StyleThemeCurrentCmd(
+ ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj * const objv[])
+{
+ StylePackageData *pkgPtr = clientData;
+ Tcl_HashSearch search;
+ Tcl_HashEntry *entryPtr = NULL;
+ const char *name = NULL;
+
+ if (objc != 3) {
+ Tcl_WrongNumArgs(interp, 3, objv, "");
+ return TCL_ERROR;
+ }
+
+ entryPtr = Tcl_FirstHashEntry(&pkgPtr->themeTable, &search);
+ while (entryPtr != NULL) {
+ Theme *ptr = Tcl_GetHashValue(entryPtr);
+ if (ptr == pkgPtr->currentTheme) {
+ name = Tcl_GetHashKey(&pkgPtr->themeTable, entryPtr);
+ break;
+ }
+ entryPtr = Tcl_NextHashEntry(&search);
+ }
+
+ if (name == NULL) {
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "error: failed to get theme name", -1));
+ Tcl_SetErrorCode(interp, "TTK", "THEME", "NAMELESS", NULL);
+ return TCL_ERROR;
+ }
+
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(name, -1));
+ return TCL_OK;
+}
+
+/* + style theme create name ?-parent $theme? ?-settings { script }?
+ */
+static int StyleThemeCreateCmd(
+ ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[])
+{
+ StylePackageData *pkgPtr = clientData;
+ static const char *optStrings[] =
+ { "-parent", "-settings", NULL };
+ enum { OP_PARENT, OP_SETTINGS };
+ Ttk_Theme parentTheme = pkgPtr->defaultTheme, newTheme;
+ Tcl_Obj *settingsScript = NULL;
+ const char *themeName;
+ int i;
+
+ if (objc < 4 || objc % 2 != 0) {
+ Tcl_WrongNumArgs(interp, 3, objv, "name ?-option value ...?");
+ return TCL_ERROR;
+ }
+
+ themeName = Tcl_GetString(objv[3]);
+
+ for (i=4; i < objc; i +=2) {
+ int option;
+ if (Tcl_GetIndexFromObjStruct(interp, objv[i], optStrings,
+ sizeof(char *), "option", 0, &option) != TCL_OK)
+ {
+ return TCL_ERROR;
+ }
+
+ switch (option) {
+ case OP_PARENT:
+ parentTheme = LookupTheme(
+ interp, pkgPtr, Tcl_GetString(objv[i+1]));
+ if (!parentTheme)
+ return TCL_ERROR;
+ break;
+ case OP_SETTINGS:
+ settingsScript = objv[i+1];
+ break;
+ }
+ }
+
+ newTheme = Ttk_CreateTheme(interp, themeName, parentTheme);
+ if (!newTheme) {
+ return TCL_ERROR;
+ }
+
+ /*
+ * Evaluate the -settings script, if supplied:
+ */
+ if (settingsScript) {
+ Ttk_Theme oldTheme = pkgPtr->currentTheme;
+ int status;
+
+ pkgPtr->currentTheme = newTheme;
+ status = Tcl_EvalObjEx(interp, settingsScript, 0);
+ pkgPtr->currentTheme = oldTheme;
+ return status;
+ } else {
+ return TCL_OK;
+ }
+}
+
+/* + style theme names --
+ * Return list of registered themes.
+ */
+static int StyleThemeNamesCmd(
+ ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[])
+{
+ StylePackageData *pkgPtr = clientData;
+ return TtkEnumerateHashTable(interp, &pkgPtr->themeTable);
+}
+
+/* + style theme settings $theme $script
+ *
+ * Temporarily sets the current theme to $themeName,
+ * evaluates $script, then restores the old theme.
+ */
+static int
+StyleThemeSettingsCmd(
+ ClientData clientData, /* Master StylePackageData pointer */
+ Tcl_Interp *interp, /* Current interpreter */
+ int objc, /* Number of arguments */
+ Tcl_Obj *const objv[]) /* Argument objects */
+{
+ StylePackageData *pkgPtr = clientData;
+ Ttk_Theme oldTheme = pkgPtr->currentTheme;
+ Ttk_Theme newTheme;
+ int status;
+
+ if (objc != 5) {
+ Tcl_WrongNumArgs(interp, 3, objv, "theme script");
+ return TCL_ERROR;
+ }
+
+ newTheme = LookupTheme(interp, pkgPtr, Tcl_GetString(objv[3]));
+ if (!newTheme)
+ return TCL_ERROR;
+
+ pkgPtr->currentTheme = newTheme;
+ status = Tcl_EvalObjEx(interp, objv[4], 0);
+ pkgPtr->currentTheme = oldTheme;
+
+ return status;
+}
+
+/* + style element create name type ? ...args ?
+ */
+static int StyleElementCreateCmd(
+ ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[])
+{
+ StylePackageData *pkgPtr = clientData;
+ Ttk_Theme theme = pkgPtr->currentTheme;
+ const char *elementName, *factoryName;
+ Tcl_HashEntry *entryPtr;
+ FactoryRec *recPtr;
+
+ if (objc < 5) {
+ Tcl_WrongNumArgs(interp, 3, objv, "name type ?-option value ...?");
+ return TCL_ERROR;
+ }
+
+ elementName = Tcl_GetString(objv[3]);
+ factoryName = Tcl_GetString(objv[4]);
+
+ entryPtr = Tcl_FindHashEntry(&pkgPtr->factoryTable, factoryName);
+ if (!entryPtr) {
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "No such element type %s", factoryName));
+ Tcl_SetErrorCode(interp, "TTK", "LOOKUP", "ELEMENT_TYPE", factoryName,
+ NULL);
+ return TCL_ERROR;
+ }
+
+ recPtr = Tcl_GetHashValue(entryPtr);
+
+ return recPtr->factory(interp, recPtr->clientData,
+ theme, elementName, objc - 5, objv + 5);
+}
+
+/* + style element names --
+ * Return a list of elements defined in the current theme.
+ */
+static int StyleElementNamesCmd(
+ ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[])
+{
+ StylePackageData *pkgPtr = clientData;
+ Ttk_Theme theme = pkgPtr->currentTheme;
+
+ if (objc != 3) {
+ Tcl_WrongNumArgs(interp, 3, objv, NULL);
+ return TCL_ERROR;
+ }
+ return TtkEnumerateHashTable(interp, &theme->elementTable);
+}
+
+/* + style element options $element --
+ * Return list of element options for specified element
+ */
+static int StyleElementOptionsCmd(
+ ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[])
+{
+ StylePackageData *pkgPtr = clientData;
+ Ttk_Theme theme = pkgPtr->currentTheme;
+ const char *elementName;
+ Ttk_ElementClass *elementClass;
+
+ if (objc != 4) {
+ Tcl_WrongNumArgs(interp, 3, objv, "element");
+ return TCL_ERROR;
+ }
+
+ elementName = Tcl_GetString(objv[3]);
+ elementClass = Ttk_GetElement(theme, elementName);
+ if (elementClass) {
+ Ttk_ElementSpec *specPtr = elementClass->specPtr;
+ Ttk_ElementOptionSpec *option = specPtr->options;
+ Tcl_Obj *result = Tcl_NewListObj(0,0);
+
+ while (option->optionName) {
+ Tcl_ListObjAppendElement(
+ interp, result, Tcl_NewStringObj(option->optionName,-1));
+ ++option;
+ }
+
+ Tcl_SetObjResult(interp, result);
+ return TCL_OK;
+ }
+
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "element %s not found", elementName));
+ Tcl_SetErrorCode(interp, "TTK", "LOOKUP", "ELEMENT", elementName, NULL);
+ return TCL_ERROR;
+}
+
+/* + style layout name ?spec?
+ */
+static int StyleLayoutCmd(
+ ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[])
+{
+ StylePackageData *pkgPtr = clientData;
+ Ttk_Theme theme = pkgPtr->currentTheme;
+ const char *layoutName;
+ Ttk_LayoutTemplate layoutTemplate;
+
+ if (objc < 3 || objc > 4) {
+ Tcl_WrongNumArgs(interp, 2, objv, "name ?spec?");
+ return TCL_ERROR;
+ }
+
+ layoutName = Tcl_GetString(objv[2]);
+
+ if (objc == 3) {
+ layoutTemplate = Ttk_FindLayoutTemplate(theme, layoutName);
+ if (!layoutTemplate) {
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "Layout %s not found", layoutName));
+ Tcl_SetErrorCode(interp, "TTK", "LOOKUP", "LAYOUT", layoutName,
+ NULL);
+ return TCL_ERROR;
+ }
+ Tcl_SetObjResult(interp, Ttk_UnparseLayoutTemplate(layoutTemplate));
+ } else {
+ layoutTemplate = Ttk_ParseLayoutTemplate(interp, objv[3]);
+ if (!layoutTemplate) {
+ return TCL_ERROR;
+ }
+ Ttk_RegisterLayoutTemplate(theme, layoutName, layoutTemplate);
+ ThemeChanged(pkgPtr);
+ }
+ return TCL_OK;
+}
+
+/* + style theme use $theme --
+ * Sets the current theme to $theme
+ */
+static int
+StyleThemeUseCmd(
+ ClientData clientData, /* Master StylePackageData pointer */
+ Tcl_Interp *interp, /* Current interpreter */
+ int objc, /* Number of arguments */
+ Tcl_Obj *const objv[]) /* Argument objects */
+{
+ StylePackageData *pkgPtr = clientData;
+ Ttk_Theme theme;
+
+ if (objc < 3 || objc > 4) {
+ Tcl_WrongNumArgs(interp, 3, objv, "?theme?");
+ return TCL_ERROR;
+ }
+
+ if (objc == 3) {
+ return StyleThemeCurrentCmd(clientData, interp, objc, objv);
+ }
+
+ theme = LookupTheme(interp, pkgPtr, Tcl_GetString(objv[3]));
+ if (!theme) {
+ return TCL_ERROR;
+ }
+
+ return Ttk_UseTheme(interp, theme);
+}
+
+/*
+ * StyleObjCmd --
+ * Implementation of the [style] command.
+ */
+
+static const Ttk_Ensemble StyleThemeEnsemble[] = {
+ { "create", StyleThemeCreateCmd, 0 },
+ { "names", StyleThemeNamesCmd, 0 },
+ { "settings", StyleThemeSettingsCmd, 0 },
+ { "use", StyleThemeUseCmd, 0 },
+ { NULL, 0, 0 }
+};
+
+static const Ttk_Ensemble StyleElementEnsemble[] = {
+ { "create", StyleElementCreateCmd, 0 },
+ { "names", StyleElementNamesCmd, 0 },
+ { "options", StyleElementOptionsCmd, 0 },
+ { NULL, 0, 0 }
+};
+
+static const Ttk_Ensemble StyleEnsemble[] = {
+ { "configure", StyleConfigureCmd, 0 },
+ { "map", StyleMapCmd, 0 },
+ { "lookup", StyleLookupCmd, 0 },
+ { "layout", StyleLayoutCmd, 0 },
+ { "theme", 0, StyleThemeEnsemble },
+ { "element", 0, StyleElementEnsemble },
+ { NULL, 0, 0 }
+};
+
+static int
+StyleObjCmd(
+ ClientData clientData, /* Master StylePackageData pointer */
+ Tcl_Interp *interp, /* Current interpreter */
+ int objc, /* Number of arguments */
+ Tcl_Obj *const objv[]) /* Argument objects */
+{
+ return Ttk_InvokeEnsemble(StyleEnsemble, 1, clientData,interp,objc,objv);
+}
+
+MODULE_SCOPE
+int Ttk_InvokeEnsemble( /* Run an ensemble command */
+ const Ttk_Ensemble *ensemble, int cmdIndex,
+ void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[])
+{
+ while (cmdIndex < objc) {
+ int index;
+ if (Tcl_GetIndexFromObjStruct(interp,
+ objv[cmdIndex], ensemble, sizeof(ensemble[0]),
+ "command", 0, &index)
+ != TCL_OK)
+ {
+ return TCL_ERROR;
+ }
+
+ if (ensemble[index].command) {
+ return ensemble[index].command(clientData, interp, objc, objv);
+ }
+ ensemble = ensemble[index].ensemble;
+ ++cmdIndex;
+ }
+ Tcl_WrongNumArgs(interp, cmdIndex, objv, "option ?arg ...?");
+ return TCL_ERROR;
+}
+
+/*
+ * Ttk_StylePkgInit --
+ * Initializes all the structures that are used by the style
+ * package on a per-interp basis.
+ */
+
+void Ttk_StylePkgInit(Tcl_Interp *interp)
+{
+ Tcl_Namespace *nsPtr;
+
+ StylePackageData *pkgPtr = ckalloc(sizeof(StylePackageData));
+
+ pkgPtr->interp = interp;
+ Tcl_InitHashTable(&pkgPtr->themeTable, TCL_STRING_KEYS);
+ Tcl_InitHashTable(&pkgPtr->factoryTable, TCL_STRING_KEYS);
+ pkgPtr->cleanupList = NULL;
+ pkgPtr->cache = Ttk_CreateResourceCache(interp);
+ pkgPtr->themeChangePending = 0;
+
+ Tcl_SetAssocData(interp, PKG_ASSOC_KEY, Ttk_StylePkgFree, pkgPtr);
+
+ /*
+ * Create the default system theme:
+ *
+ * pkgPtr->defaultTheme must be initialized to 0 before
+ * calling Ttk_CreateTheme for the first time, since it's used
+ * as the parent theme.
+ */
+ pkgPtr->defaultTheme = 0;
+ pkgPtr->defaultTheme = pkgPtr->currentTheme =
+ Ttk_CreateTheme(interp, "default", NULL);
+
+ /*
+ * Register null element, used as a last-resort fallback:
+ */
+ Ttk_RegisterElement(interp, pkgPtr->defaultTheme, "", &ttkNullElementSpec, 0);
+
+ /*
+ * Register commands:
+ */
+ Tcl_CreateObjCommand(interp, "::ttk::style", StyleObjCmd, pkgPtr, 0);
+
+ nsPtr = Tcl_FindNamespace(interp, "::ttk", NULL, TCL_LEAVE_ERR_MSG);
+ Tcl_Export(interp, nsPtr, "style", 0 /* dontResetList */);
+
+ Ttk_RegisterElementFactory(interp, "from", Ttk_CloneElement, 0);
+}
+
+/*EOF*/
diff --git a/tk8.6/generic/ttk/ttkTheme.h b/tk8.6/generic/ttk/ttkTheme.h
new file mode 100644
index 0000000..7bf2a7f
--- /dev/null
+++ b/tk8.6/generic/ttk/ttkTheme.h
@@ -0,0 +1,444 @@
+/*
+ * Copyright (c) 2003 Joe English. Freely redistributable.
+ *
+ * Declarations for Tk theme engine.
+ */
+
+#ifndef _TTKTHEME
+#define _TTKTHEME
+
+#ifdef __cplusplus
+extern "C" {
+#endif
+
+#ifndef MODULE_SCOPE
+# ifdef __cplusplus
+# define MODULE_SCOPE extern "C"
+# else
+# define MODULE_SCOPE extern
+# endif
+#endif
+
+#define TTKAPI MODULE_SCOPE
+
+/* Ttk syncs to the Tk version & patchlevel */
+#define TTK_VERSION TK_VERSION
+#define TTK_PATCH_LEVEL TK_PATCH_LEVEL
+
+/*------------------------------------------------------------------------
+ * +++ Defaults for element option specifications.
+ */
+#define DEFAULT_FONT "TkDefaultFont"
+#define DEFAULT_BACKGROUND "#d9d9d9"
+#define DEFAULT_FOREGROUND "black"
+
+/*------------------------------------------------------------------------
+ * +++ Widget states.
+ * Keep in sync with stateNames[] in tkstate.c.
+ */
+
+typedef unsigned int Ttk_State;
+
+#define TTK_STATE_ACTIVE (1<<0)
+#define TTK_STATE_DISABLED (1<<1)
+#define TTK_STATE_FOCUS (1<<2)
+#define TTK_STATE_PRESSED (1<<3)
+#define TTK_STATE_SELECTED (1<<4)
+#define TTK_STATE_BACKGROUND (1<<5)
+#define TTK_STATE_ALTERNATE (1<<6)
+#define TTK_STATE_INVALID (1<<7)
+#define TTK_STATE_READONLY (1<<8)
+#define TTK_STATE_HOVER (1<<9)
+#define TTK_STATE_USER6 (1<<10)
+#define TTK_STATE_USER5 (1<<11)
+#define TTK_STATE_USER4 (1<<12)
+#define TTK_STATE_USER3 (1<<13)
+#define TTK_STATE_USER2 (1<<14)
+#define TTK_STATE_USER1 (1<<15)
+
+/* Maintenance note: if you get all the way to "USER1",
+ * see tkstate.c
+ */
+typedef struct
+{
+ unsigned int onbits; /* bits to turn on */
+ unsigned int offbits; /* bits to turn off */
+} Ttk_StateSpec;
+
+#define Ttk_StateMatches(state, spec) \
+ (((state) & ((spec)->onbits|(spec)->offbits)) == (spec)->onbits)
+
+#define Ttk_ModifyState(state, spec) \
+ (((state) & ~(spec)->offbits) | (spec)->onbits)
+
+TTKAPI int Ttk_GetStateSpecFromObj(Tcl_Interp *, Tcl_Obj *, Ttk_StateSpec *);
+TTKAPI Tcl_Obj *Ttk_NewStateSpecObj(unsigned int onbits,unsigned int offbits);
+
+/*------------------------------------------------------------------------
+ * +++ State maps and state tables.
+ */
+typedef Tcl_Obj *Ttk_StateMap;
+
+TTKAPI Ttk_StateMap Ttk_GetStateMapFromObj(Tcl_Interp *, Tcl_Obj *);
+TTKAPI Tcl_Obj *Ttk_StateMapLookup(Tcl_Interp*, Ttk_StateMap, Ttk_State);
+
+/*
+ * Table for looking up an integer index based on widget state:
+ */
+typedef struct
+{
+ int index; /* Value to return if this entry matches */
+ unsigned int onBits; /* Bits which must be set */
+ unsigned int offBits; /* Bits which must be cleared */
+} Ttk_StateTable;
+
+TTKAPI int Ttk_StateTableLookup(Ttk_StateTable map[], Ttk_State);
+
+/*------------------------------------------------------------------------
+ * +++ Padding.
+ * Used to represent internal padding and borders.
+ */
+typedef struct
+{
+ short left;
+ short top;
+ short right;
+ short bottom;
+} Ttk_Padding;
+
+TTKAPI int Ttk_GetPaddingFromObj(Tcl_Interp*,Tk_Window,Tcl_Obj*,Ttk_Padding*);
+TTKAPI int Ttk_GetBorderFromObj(Tcl_Interp*,Tcl_Obj*,Ttk_Padding*);
+
+TTKAPI Ttk_Padding Ttk_MakePadding(short l, short t, short r, short b);
+TTKAPI Ttk_Padding Ttk_UniformPadding(short borderWidth);
+TTKAPI Ttk_Padding Ttk_AddPadding(Ttk_Padding, Ttk_Padding);
+TTKAPI Ttk_Padding Ttk_RelievePadding(Ttk_Padding, int relief, int n);
+
+#define Ttk_PaddingWidth(p) ((p).left + (p).right)
+#define Ttk_PaddingHeight(p) ((p).top + (p).bottom)
+
+#define Ttk_SetMargins(tkwin, pad) \
+ Tk_SetInternalBorderEx(tkwin, pad.left, pad.right, pad.top, pad.bottom)
+
+/*------------------------------------------------------------------------
+ * +++ Boxes.
+ * Used to represent rectangular regions
+ */
+typedef struct /* Hey, this is an XRectangle! */
+{
+ int x;
+ int y;
+ int width;
+ int height;
+} Ttk_Box;
+
+TTKAPI Ttk_Box Ttk_MakeBox(int x, int y, int width, int height);
+TTKAPI int Ttk_BoxContains(Ttk_Box, int x, int y);
+
+#define Ttk_WinBox(tkwin) Ttk_MakeBox(0,0,Tk_Width(tkwin),Tk_Height(tkwin))
+
+/*------------------------------------------------------------------------
+ * +++ Layout utilities.
+ */
+typedef enum {
+ TTK_SIDE_LEFT, TTK_SIDE_TOP, TTK_SIDE_RIGHT, TTK_SIDE_BOTTOM
+} Ttk_Side;
+
+typedef unsigned int Ttk_Sticky;
+
+/*
+ * -sticky bits for Ttk_StickBox:
+ */
+#define TTK_STICK_W (0x1)
+#define TTK_STICK_E (0x2)
+#define TTK_STICK_N (0x4)
+#define TTK_STICK_S (0x8)
+
+/*
+ * Aliases and useful combinations:
+ */
+#define TTK_FILL_X (0x3) /* -sticky ew */
+#define TTK_FILL_Y (0xC) /* -sticky ns */
+#define TTK_FILL_BOTH (0xF) /* -sticky nswe */
+
+TTKAPI int Ttk_GetStickyFromObj(Tcl_Interp *, Tcl_Obj *, Ttk_Sticky *);
+TTKAPI Tcl_Obj *Ttk_NewStickyObj(Ttk_Sticky);
+
+/*
+ * Extra bits for position specifications (combine -side and -sticky)
+ */
+
+typedef unsigned int Ttk_PositionSpec; /* See below */
+
+#define TTK_PACK_LEFT (0x10) /* pack at left of current parcel */
+#define TTK_PACK_RIGHT (0x20) /* pack at right of current parcel */
+#define TTK_PACK_TOP (0x40) /* pack at top of current parcel */
+#define TTK_PACK_BOTTOM (0x80) /* pack at bottom of current parcel */
+#define TTK_EXPAND (0x100) /* use entire parcel */
+#define TTK_BORDER (0x200) /* draw this element after children */
+#define TTK_UNIT (0x400) /* treat descendants as a part of element */
+
+/*
+ * Extra bits for layout specifications
+ */
+#define _TTK_CHILDREN (0x1000)/* for LayoutSpecs -- children follow */
+#define _TTK_LAYOUT_END (0x2000)/* for LayoutSpecs -- end of child list */
+#define _TTK_LAYOUT (0x4000)/* for LayoutSpec tables -- define layout */
+
+#define _TTK_MASK_STICK (0x0F) /* See Ttk_UnparseLayout() */
+#define _TTK_MASK_PACK (0xF0) /* See Ttk_UnparseLayout(), packStrings */
+
+TTKAPI Ttk_Box Ttk_PackBox(Ttk_Box *cavity, int w, int h, Ttk_Side side);
+TTKAPI Ttk_Box Ttk_StickBox(Ttk_Box parcel, int w, int h, Ttk_Sticky sticky);
+TTKAPI Ttk_Box Ttk_AnchorBox(Ttk_Box parcel, int w, int h, Tk_Anchor anchor);
+TTKAPI Ttk_Box Ttk_PadBox(Ttk_Box b, Ttk_Padding p);
+TTKAPI Ttk_Box Ttk_ExpandBox(Ttk_Box b, Ttk_Padding p);
+TTKAPI Ttk_Box Ttk_PlaceBox(Ttk_Box *cavity, int w,int h, Ttk_Side,Ttk_Sticky);
+TTKAPI Ttk_Box Ttk_PositionBox(Ttk_Box *cavity, int w, int h, Ttk_PositionSpec);
+
+/*------------------------------------------------------------------------
+ * +++ Themes.
+ */
+MODULE_SCOPE void Ttk_StylePkgInit(Tcl_Interp *);
+
+typedef struct Ttk_Theme_ *Ttk_Theme;
+typedef struct Ttk_ElementClass_ Ttk_ElementClass;
+typedef struct Ttk_Layout_ *Ttk_Layout;
+typedef struct Ttk_LayoutNode_ *Ttk_Element;
+typedef struct Ttk_Style_ *Ttk_Style;
+
+TTKAPI Ttk_Theme Ttk_GetTheme(Tcl_Interp *interp, const char *name);
+TTKAPI Ttk_Theme Ttk_GetDefaultTheme(Tcl_Interp *interp);
+TTKAPI Ttk_Theme Ttk_GetCurrentTheme(Tcl_Interp *interp);
+
+TTKAPI Ttk_Theme Ttk_CreateTheme(
+ Tcl_Interp *interp, const char *name, Ttk_Theme parent);
+
+typedef int (Ttk_ThemeEnabledProc)(Ttk_Theme theme, void *clientData);
+MODULE_SCOPE void Ttk_SetThemeEnabledProc(Ttk_Theme, Ttk_ThemeEnabledProc, void *);
+
+MODULE_SCOPE int Ttk_UseTheme(Tcl_Interp *, Ttk_Theme);
+
+typedef void (Ttk_CleanupProc)(void *clientData);
+TTKAPI void Ttk_RegisterCleanup(
+ Tcl_Interp *interp, void *deleteData, Ttk_CleanupProc *cleanupProc);
+
+/*------------------------------------------------------------------------
+ * +++ Elements.
+ */
+
+enum TTKStyleVersion2 { TK_STYLE_VERSION_2 = 2 };
+
+typedef void (Ttk_ElementSizeProc)(void *clientData, void *elementRecord,
+ Tk_Window tkwin, int *widthPtr, int *heightPtr, Ttk_Padding*);
+typedef void (Ttk_ElementDrawProc)(void *clientData, void *elementRecord,
+ Tk_Window tkwin, Drawable d, Ttk_Box b, Ttk_State state);
+
+typedef struct Ttk_ElementOptionSpec
+{
+ const char *optionName; /* Command-line name of the widget option */
+ Tk_OptionType type; /* Accepted option types */
+ int offset; /* Offset of Tcl_Obj* field in element record */
+ const char *defaultValue; /* Default value to used if resource missing */
+} Ttk_ElementOptionSpec;
+
+#define TK_OPTION_ANY TK_OPTION_STRING
+
+typedef struct Ttk_ElementSpec {
+ enum TTKStyleVersion2 version; /* Version of the style support. */
+ size_t elementSize; /* Size of element record */
+ Ttk_ElementOptionSpec *options; /* List of options, NULL-terminated */
+ Ttk_ElementSizeProc *size; /* Compute min size and padding */
+ Ttk_ElementDrawProc *draw; /* Draw the element */
+} Ttk_ElementSpec;
+
+TTKAPI Ttk_ElementClass *Ttk_RegisterElement(
+ Tcl_Interp *interp, Ttk_Theme theme, const char *elementName,
+ Ttk_ElementSpec *, void *clientData);
+
+typedef int (*Ttk_ElementFactory)
+ (Tcl_Interp *, void *clientData,
+ Ttk_Theme, const char *elementName, int objc, Tcl_Obj *const objv[]);
+
+TTKAPI int Ttk_RegisterElementFactory(
+ Tcl_Interp *, const char *name, Ttk_ElementFactory, void *clientData);
+
+/*
+ * Null element implementation:
+ * has no geometry or layout; may be used as a stub or placeholder.
+ */
+
+typedef struct {
+ Tcl_Obj *unused;
+} NullElement;
+
+MODULE_SCOPE void TtkNullElementSize
+ (void *, void *, Tk_Window, int *, int *, Ttk_Padding *);
+MODULE_SCOPE void TtkNullElementDraw
+ (void *, void *, Tk_Window, Drawable, Ttk_Box, Ttk_State);
+MODULE_SCOPE Ttk_ElementOptionSpec TtkNullElementOptions[];
+MODULE_SCOPE Ttk_ElementSpec ttkNullElementSpec;
+
+/*------------------------------------------------------------------------
+ * +++ Layout templates.
+ */
+typedef struct {
+ const char * elementName;
+ unsigned opcode;
+} TTKLayoutInstruction, *Ttk_LayoutSpec;
+
+#define TTK_BEGIN_LAYOUT_TABLE(name) \
+ static TTKLayoutInstruction name[] = {
+#define TTK_LAYOUT(name, content) \
+ { name, _TTK_CHILDREN|_TTK_LAYOUT }, \
+ content \
+ { 0, _TTK_LAYOUT_END },
+#define TTK_GROUP(name, flags, children) \
+ { name, flags | _TTK_CHILDREN }, \
+ children \
+ { 0, _TTK_LAYOUT_END },
+#define TTK_NODE(name, flags) { name, flags },
+#define TTK_END_LAYOUT_TABLE { 0, _TTK_LAYOUT | _TTK_LAYOUT_END } };
+
+#define TTK_BEGIN_LAYOUT(name) static TTKLayoutInstruction name[] = {
+#define TTK_END_LAYOUT { 0, _TTK_LAYOUT_END } };
+
+TTKAPI void Ttk_RegisterLayout(
+ Ttk_Theme theme, const char *className, Ttk_LayoutSpec layoutSpec);
+
+TTKAPI void Ttk_RegisterLayouts(
+ Ttk_Theme theme, Ttk_LayoutSpec layoutTable);
+
+/*------------------------------------------------------------------------
+ * +++ Layout instances.
+ */
+
+MODULE_SCOPE Ttk_Layout Ttk_CreateLayout(
+ Tcl_Interp *, Ttk_Theme, const char *name,
+ void *recordPtr, Tk_OptionTable, Tk_Window tkwin);
+
+MODULE_SCOPE Ttk_Layout Ttk_CreateSublayout(
+ Tcl_Interp *, Ttk_Theme, Ttk_Layout, const char *name, Tk_OptionTable);
+
+MODULE_SCOPE void Ttk_FreeLayout(Ttk_Layout);
+
+MODULE_SCOPE void Ttk_LayoutSize(Ttk_Layout,Ttk_State,int *widthPtr,int *heightPtr);
+MODULE_SCOPE void Ttk_PlaceLayout(Ttk_Layout, Ttk_State, Ttk_Box);
+MODULE_SCOPE void Ttk_DrawLayout(Ttk_Layout, Ttk_State, Drawable);
+
+MODULE_SCOPE void Ttk_RebindSublayout(Ttk_Layout, void *recordPtr);
+
+MODULE_SCOPE Ttk_Element Ttk_IdentifyElement(Ttk_Layout, int x, int y);
+MODULE_SCOPE Ttk_Element Ttk_FindElement(Ttk_Layout, const char *nodeName);
+
+MODULE_SCOPE const char *Ttk_ElementName(Ttk_Element);
+MODULE_SCOPE Ttk_Box Ttk_ElementParcel(Ttk_Element);
+
+MODULE_SCOPE Ttk_Box Ttk_ClientRegion(Ttk_Layout, const char *elementName);
+
+MODULE_SCOPE Ttk_Box Ttk_LayoutNodeInternalParcel(Ttk_Layout,Ttk_Element);
+MODULE_SCOPE Ttk_Padding Ttk_LayoutNodeInternalPadding(Ttk_Layout,Ttk_Element);
+MODULE_SCOPE void Ttk_LayoutNodeReqSize(Ttk_Layout, Ttk_Element, int *w, int *h);
+
+MODULE_SCOPE void Ttk_PlaceElement(Ttk_Layout, Ttk_Element, Ttk_Box);
+MODULE_SCOPE void Ttk_ChangeElementState(Ttk_Element,unsigned set,unsigned clr);
+
+MODULE_SCOPE Tcl_Obj *Ttk_QueryOption(Ttk_Layout, const char *, Ttk_State);
+
+TTKAPI Ttk_Style Ttk_LayoutStyle(Ttk_Layout);
+TTKAPI Tcl_Obj *Ttk_StyleDefault(Ttk_Style, const char *optionName);
+TTKAPI Tcl_Obj *Ttk_StyleMap(Ttk_Style, const char *optionName, Ttk_State);
+
+/*------------------------------------------------------------------------
+ * +++ Resource cache.
+ * See resource.c for explanation.
+ */
+
+typedef struct Ttk_ResourceCache_ *Ttk_ResourceCache;
+MODULE_SCOPE Ttk_ResourceCache Ttk_CreateResourceCache(Tcl_Interp *);
+MODULE_SCOPE void Ttk_FreeResourceCache(Ttk_ResourceCache);
+
+MODULE_SCOPE Ttk_ResourceCache Ttk_GetResourceCache(Tcl_Interp*);
+MODULE_SCOPE Tcl_Obj *Ttk_UseFont(Ttk_ResourceCache, Tk_Window, Tcl_Obj *);
+MODULE_SCOPE Tcl_Obj *Ttk_UseColor(Ttk_ResourceCache, Tk_Window, Tcl_Obj *);
+MODULE_SCOPE Tcl_Obj *Ttk_UseBorder(Ttk_ResourceCache, Tk_Window, Tcl_Obj *);
+MODULE_SCOPE Tk_Image Ttk_UseImage(Ttk_ResourceCache, Tk_Window, Tcl_Obj *);
+
+MODULE_SCOPE void Ttk_RegisterNamedColor(Ttk_ResourceCache, const char *, XColor *);
+
+/*------------------------------------------------------------------------
+ * +++ Image specifications.
+ */
+
+typedef struct TtkImageSpec Ttk_ImageSpec;
+TTKAPI Ttk_ImageSpec *TtkGetImageSpec(Tcl_Interp *, Tk_Window, Tcl_Obj *);
+TTKAPI void TtkFreeImageSpec(Ttk_ImageSpec *);
+TTKAPI Tk_Image TtkSelectImage(Ttk_ImageSpec *, Ttk_State);
+
+/*------------------------------------------------------------------------
+ * +++ Miscellaneous enumerations.
+ * Other stuff that element implementations need to know about.
+ */
+typedef enum /* -default option values */
+{
+ TTK_BUTTON_DEFAULT_NORMAL, /* widget defaultable */
+ TTK_BUTTON_DEFAULT_ACTIVE, /* currently the default widget */
+ TTK_BUTTON_DEFAULT_DISABLED /* not defaultable */
+} Ttk_ButtonDefaultState;
+
+TTKAPI int Ttk_GetButtonDefaultStateFromObj(Tcl_Interp *, Tcl_Obj *, int *);
+
+typedef enum /* -compound option values */
+{
+ TTK_COMPOUND_NONE, /* image if specified, otherwise text */
+ TTK_COMPOUND_TEXT, /* text only */
+ TTK_COMPOUND_IMAGE, /* image only */
+ TTK_COMPOUND_CENTER, /* text overlays image */
+ TTK_COMPOUND_TOP, /* image above text */
+ TTK_COMPOUND_BOTTOM, /* image below text */
+ TTK_COMPOUND_LEFT, /* image to left of text */
+ TTK_COMPOUND_RIGHT /* image to right of text */
+} Ttk_Compound;
+
+TTKAPI int Ttk_GetCompoundFromObj(Tcl_Interp *, Tcl_Obj *, int *);
+
+typedef enum { /* -orient option values */
+ TTK_ORIENT_HORIZONTAL,
+ TTK_ORIENT_VERTICAL
+} Ttk_Orient;
+
+/*------------------------------------------------------------------------
+ * +++ Utilities.
+ */
+
+typedef struct TtkEnsemble {
+ const char *name; /* subcommand name */
+ Tcl_ObjCmdProc *command; /* subcommand implementation, OR: */
+ const struct TtkEnsemble *ensemble; /* subcommand ensemble */
+} Ttk_Ensemble;
+
+MODULE_SCOPE int Ttk_InvokeEnsemble( /* Run an ensemble command */
+ const Ttk_Ensemble *commands, int cmdIndex,
+ void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]);
+
+MODULE_SCOPE int TtkEnumerateHashTable(Tcl_Interp *, Tcl_HashTable *);
+
+/*------------------------------------------------------------------------
+ * +++ Stub table declarations.
+ */
+
+#include "ttkDecls.h"
+
+/*
+ * Drawing utilities for theme code:
+ * (@@@ find a better home for this)
+ */
+typedef enum { ARROW_UP, ARROW_DOWN, ARROW_LEFT, ARROW_RIGHT } ArrowDirection;
+MODULE_SCOPE void TtkArrowSize(int h, ArrowDirection, int *widthPtr, int *heightPtr);
+MODULE_SCOPE void TtkDrawArrow(Display *, Drawable, GC, Ttk_Box, ArrowDirection);
+MODULE_SCOPE void TtkFillArrow(Display *, Drawable, GC, Ttk_Box, ArrowDirection);
+
+#ifdef __cplusplus
+}
+#endif
+#endif /* _TTKTHEME */
diff --git a/tk8.6/generic/ttk/ttkThemeInt.h b/tk8.6/generic/ttk/ttkThemeInt.h
new file mode 100644
index 0000000..3aaada8
--- /dev/null
+++ b/tk8.6/generic/ttk/ttkThemeInt.h
@@ -0,0 +1,42 @@
+/*
+ * Theme engine: private definitions.
+ *
+ * Copyright (c) 2004 Joe English. Freely redistributable.
+ */
+
+#ifndef _TTKTHEMEINT
+#define _TTKTHEMEINT
+
+#include "ttkTheme.h"
+
+typedef struct Ttk_TemplateNode_ Ttk_TemplateNode, *Ttk_LayoutTemplate;
+
+MODULE_SCOPE Ttk_ElementClass *Ttk_GetElement(Ttk_Theme, const char *name);
+MODULE_SCOPE const char *Ttk_ElementClassName(Ttk_ElementClass *);
+
+MODULE_SCOPE void Ttk_ElementSize(
+ Ttk_ElementClass *, Ttk_Style, char *recordPtr, Tk_OptionTable,
+ Tk_Window tkwin, Ttk_State state,
+ int *widthPtr, int *heightPtr, Ttk_Padding*);
+MODULE_SCOPE void Ttk_DrawElement(
+ Ttk_ElementClass *, Ttk_Style, char *recordPtr, Tk_OptionTable,
+ Tk_Window tkwin, Drawable d, Ttk_Box b, Ttk_State state);
+
+MODULE_SCOPE Tcl_Obj *Ttk_QueryStyle(
+ Ttk_Style, void *, Tk_OptionTable, const char *, Ttk_State state);
+
+MODULE_SCOPE Ttk_LayoutTemplate Ttk_ParseLayoutTemplate(
+ Tcl_Interp *, Tcl_Obj *);
+MODULE_SCOPE Tcl_Obj *Ttk_UnparseLayoutTemplate(Ttk_LayoutTemplate);
+MODULE_SCOPE Ttk_LayoutTemplate Ttk_BuildLayoutTemplate(Ttk_LayoutSpec);
+MODULE_SCOPE void Ttk_FreeLayoutTemplate(Ttk_LayoutTemplate);
+MODULE_SCOPE void Ttk_RegisterLayoutTemplate(
+ Ttk_Theme theme, const char *layoutName, Ttk_LayoutTemplate);
+
+MODULE_SCOPE Ttk_Style Ttk_GetStyle(Ttk_Theme themePtr, const char *styleName);
+MODULE_SCOPE Ttk_LayoutTemplate Ttk_FindLayoutTemplate(
+ Ttk_Theme themePtr, const char *layoutName);
+
+MODULE_SCOPE const char *Ttk_StyleName(Ttk_Style);
+
+#endif /* _TTKTHEMEINT */
diff --git a/tk8.6/generic/ttk/ttkTrace.c b/tk8.6/generic/ttk/ttkTrace.c
new file mode 100644
index 0000000..ba66db4
--- /dev/null
+++ b/tk8.6/generic/ttk/ttkTrace.c
@@ -0,0 +1,190 @@
+/*
+ * Copyright 2003, Joe English
+ *
+ * Simplified interface to Tcl_TraceVariable.
+ *
+ * PROBLEM: Can't distinguish "variable does not exist" (which is OK)
+ * from other errors (which are not).
+ */
+
+#include <tk.h>
+#include "ttkTheme.h"
+#include "ttkWidget.h"
+
+struct TtkTraceHandle_
+{
+ Tcl_Interp *interp; /* Containing interpreter */
+ Tcl_Obj *varnameObj; /* Name of variable being traced */
+ Ttk_TraceProc callback; /* Callback procedure */
+ void *clientData; /* Data to pass to callback */
+};
+
+/*
+ * Tcl_VarTraceProc for trace handles.
+ */
+static char *
+VarTraceProc(
+ ClientData clientData, /* Widget record pointer */
+ Tcl_Interp *interp, /* Interpreter containing variable. */
+ const char *name1, /* (unused) */
+ const char *name2, /* (unused) */
+ int flags) /* Information about what happened. */
+{
+ Ttk_TraceHandle *tracePtr = clientData;
+ const char *name, *value;
+ Tcl_Obj *valuePtr;
+
+ if (flags & TCL_INTERP_DESTROYED) {
+ return NULL;
+ }
+
+ name = Tcl_GetString(tracePtr->varnameObj);
+
+ /*
+ * If the variable is being unset, then re-establish the trace:
+ */
+ if (flags & TCL_TRACE_DESTROYED) {
+ /*
+ * If a prior call to Ttk_UntraceVariable() left behind an
+ * indicator that we wanted this handler to be deleted (see below),
+ * cleanup the ClientData bits and exit.
+ */
+ if (tracePtr->interp == NULL) {
+ Tcl_DecrRefCount(tracePtr->varnameObj);
+ ckfree((ClientData)tracePtr);
+ return NULL;
+ }
+ Tcl_TraceVar2(interp, name, NULL,
+ TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS,
+ VarTraceProc, clientData);
+ tracePtr->callback(tracePtr->clientData, NULL);
+ return NULL;
+ }
+
+ /*
+ * Call the callback:
+ */
+ valuePtr = Tcl_GetVar2Ex(interp, name, NULL, TCL_GLOBAL_ONLY);
+ value = valuePtr ? Tcl_GetString(valuePtr) : NULL;
+ tracePtr->callback(tracePtr->clientData, value);
+
+ return NULL;
+}
+
+/* Ttk_TraceVariable(interp, varNameObj, callback, clientdata) --
+ * Attach a write trace to the specified variable,
+ * which will pass the variable's value to 'callback'
+ * whenever the variable is set.
+ *
+ * When the variable is unset, passes NULL to the callback
+ * and reattaches the trace.
+ */
+Ttk_TraceHandle *Ttk_TraceVariable(
+ Tcl_Interp *interp,
+ Tcl_Obj *varnameObj,
+ Ttk_TraceProc callback,
+ void *clientData)
+{
+ Ttk_TraceHandle *h = ckalloc(sizeof(*h));
+ int status;
+
+ h->interp = interp;
+ h->varnameObj = Tcl_DuplicateObj(varnameObj);
+ Tcl_IncrRefCount(h->varnameObj);
+ h->clientData = clientData;
+ h->callback = callback;
+
+ status = Tcl_TraceVar2(interp, Tcl_GetString(varnameObj),
+ NULL, TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS,
+ VarTraceProc, (ClientData)h);
+
+ if (status != TCL_OK) {
+ Tcl_DecrRefCount(h->varnameObj);
+ ckfree(h);
+ return NULL;
+ }
+
+ return h;
+}
+
+/*
+ * Ttk_UntraceVariable --
+ * Remove previously-registered trace and free the handle.
+ */
+void Ttk_UntraceVariable(Ttk_TraceHandle *h)
+{
+ if (h) {
+ ClientData cd = NULL;
+
+ /*
+ * Workaround for Tcl Bug 3062331. The trace design problem is
+ * that when variable unset traces fire, Tcl documents that the
+ * traced variable has already been unset. It's already gone.
+ * So from within an unset trace, if you try to call
+ * Tcl_UntraceVar() on that variable, it will do nothing, because
+ * the variable by that name can no longer be found. It's gone.
+ * This means callers of Tcl_UntraceVar() that might be running
+ * in response to an unset trace have to handle the possibility
+ * that their Tcl_UntraceVar() call will do nothing. In this case,
+ * we have to support the possibility that Tcl_UntraceVar() will
+ * leave the trace in place, so we need to leave the ClientData
+ * untouched so when that trace does fire it will not crash.
+ */
+
+ /*
+ * Search the traces on the variable to see if the one we are tasked
+ * with removing is present.
+ */
+ while ((cd = Tcl_VarTraceInfo(h->interp, Tcl_GetString(h->varnameObj),
+ TCL_GLOBAL_ONLY, VarTraceProc, cd)) != NULL) {
+ if (cd == (ClientData) h) {
+ break;
+ }
+ }
+ /*
+ * If the trace we wish to delete is not visible, Tcl_UntraceVar
+ * will do nothing, so don't try to call it. Instead set an
+ * indicator in the Ttk_TraceHandle that we need to cleanup later.
+ */
+ if (cd == NULL) {
+ h->interp = NULL;
+ return;
+ }
+ Tcl_UntraceVar2(h->interp, Tcl_GetString(h->varnameObj),
+ NULL, TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS,
+ VarTraceProc, (ClientData)h);
+ Tcl_DecrRefCount(h->varnameObj);
+ ckfree(h);
+ }
+}
+
+/*
+ * Ttk_FireTrace --
+ * Executes a trace handle as if the variable has been written.
+ *
+ * Note: may reenter the interpreter.
+ */
+int Ttk_FireTrace(Ttk_TraceHandle *tracePtr)
+{
+ Tcl_Interp *interp = tracePtr->interp;
+ void *clientData = tracePtr->clientData;
+ const char *name = Tcl_GetString(tracePtr->varnameObj);
+ Ttk_TraceProc callback = tracePtr->callback;
+ Tcl_Obj *valuePtr;
+ const char *value;
+
+ /* Read the variable.
+ * Note that this can reenter the interpreter, and anything can happen --
+ * including the current trace handle being freed!
+ */
+ valuePtr = Tcl_GetVar2Ex(interp, name, NULL, TCL_GLOBAL_ONLY);
+ value = valuePtr ? Tcl_GetString(valuePtr) : NULL;
+
+ /* Call callback.
+ */
+ callback(clientData, value);
+
+ return TCL_OK;
+}
+
+/*EOF*/
diff --git a/tk8.6/generic/ttk/ttkTrack.c b/tk8.6/generic/ttk/ttkTrack.c
new file mode 100644
index 0000000..396b073
--- /dev/null
+++ b/tk8.6/generic/ttk/ttkTrack.c
@@ -0,0 +1,183 @@
+/*
+ * Copyright (c) 2004, Joe English
+ *
+ * TtkTrackElementState() -- helper routine for widgets
+ * like scrollbars in which individual elements may
+ * be active or pressed instead of the widget as a whole.
+ *
+ * Usage:
+ * TtkTrackElementState(&recordPtr->core);
+ *
+ * Registers an event handler on the widget that tracks pointer
+ * events and updates the state of the element under the
+ * mouse cursor.
+ *
+ * The "active" element is the one under the mouse cursor,
+ * and is normally set to the ACTIVE state unless another element
+ * is currently being pressed.
+ *
+ * The active element becomes "pressed" on <ButtonPress> events,
+ * and remains "active" and "pressed" until the corresponding
+ * <ButtonRelease> event.
+ *
+ * TODO: Handle "chords" properly (e.g., <B1-ButtonPress-2>)
+ */
+
+#include <tk.h>
+#include "ttkTheme.h"
+#include "ttkWidget.h"
+
+typedef struct {
+ WidgetCore *corePtr; /* widget to track */
+ Ttk_Layout tracking; /* current layout being tracked */
+ Ttk_Element activeElement; /* element under the mouse cursor */
+ Ttk_Element pressedElement; /* currently pressed element */
+} ElementStateTracker;
+
+/*
+ * ActivateElement(es, node) --
+ * Make 'node' the active element if non-NULL.
+ * Deactivates the currently active element if different.
+ *
+ * The active element has TTK_STATE_ACTIVE set _unless_
+ * another element is 'pressed'
+ */
+static void ActivateElement(ElementStateTracker *es, Ttk_Element element)
+{
+ if (es->activeElement == element) {
+ /* No change */
+ return;
+ }
+
+ if (!es->pressedElement) {
+ if (es->activeElement) {
+ /* Deactivate old element */
+ Ttk_ChangeElementState(es->activeElement, 0,TTK_STATE_ACTIVE);
+ }
+ if (element) {
+ /* Activate new element */
+ Ttk_ChangeElementState(element, TTK_STATE_ACTIVE,0);
+ }
+ TtkRedisplayWidget(es->corePtr);
+ }
+
+ es->activeElement = element;
+}
+
+/* ReleaseElement --
+ * Releases the currently pressed element, if any.
+ */
+static void ReleaseElement(ElementStateTracker *es)
+{
+ if (!es->pressedElement)
+ return;
+
+ Ttk_ChangeElementState(
+ es->pressedElement, 0,TTK_STATE_PRESSED|TTK_STATE_ACTIVE);
+ es->pressedElement = 0;
+
+ /* Reactivate element under the mouse cursor:
+ */
+ if (es->activeElement)
+ Ttk_ChangeElementState(es->activeElement, TTK_STATE_ACTIVE,0);
+
+ TtkRedisplayWidget(es->corePtr);
+}
+
+/* PressElement --
+ * Presses the specified element.
+ */
+static void PressElement(ElementStateTracker *es, Ttk_Element element)
+{
+ if (es->pressedElement) {
+ ReleaseElement(es);
+ }
+
+ if (element) {
+ Ttk_ChangeElementState(
+ element, TTK_STATE_PRESSED|TTK_STATE_ACTIVE, 0);
+ }
+
+ es->pressedElement = element;
+ TtkRedisplayWidget(es->corePtr);
+}
+
+/* ElementStateEventProc --
+ * Event handler for tracking element states.
+ */
+
+static const unsigned ElementStateMask =
+ ButtonPressMask
+ | ButtonReleaseMask
+ | PointerMotionMask
+ | LeaveWindowMask
+ | EnterWindowMask
+ | StructureNotifyMask
+ ;
+
+static void
+ElementStateEventProc(ClientData clientData, XEvent *ev)
+{
+ ElementStateTracker *es = clientData;
+ Ttk_Layout layout = es->corePtr->layout;
+ Ttk_Element element;
+
+ /* Guard against dangling pointers [#2431428]
+ */
+ if (es->tracking != layout) {
+ es->pressedElement = es->activeElement = 0;
+ es->tracking = layout;
+ }
+
+ switch (ev->type)
+ {
+ case MotionNotify :
+ element = Ttk_IdentifyElement(
+ layout, ev->xmotion.x, ev->xmotion.y);
+ ActivateElement(es, element);
+ break;
+ case LeaveNotify:
+ ActivateElement(es, 0);
+ if (ev->xcrossing.mode == NotifyGrab)
+ PressElement(es, 0);
+ break;
+ case EnterNotify:
+ element = Ttk_IdentifyElement(
+ layout, ev->xcrossing.x, ev->xcrossing.y);
+ ActivateElement(es, element);
+ break;
+ case ButtonPress:
+ element = Ttk_IdentifyElement(
+ layout, ev->xbutton.x, ev->xbutton.y);
+ if (element)
+ PressElement(es, element);
+ break;
+ case ButtonRelease:
+ ReleaseElement(es);
+ break;
+ case DestroyNotify:
+ /* Unregister this event handler and free client data.
+ */
+ Tk_DeleteEventHandler(es->corePtr->tkwin,
+ ElementStateMask, ElementStateEventProc, es);
+ ckfree(clientData);
+ break;
+ }
+}
+
+/*
+ * TtkTrackElementState --
+ * Register an event handler to manage the 'pressed'
+ * and 'active' states of individual widget elements.
+ */
+
+void TtkTrackElementState(WidgetCore *corePtr)
+{
+ ElementStateTracker *es = ckalloc(sizeof(*es));
+ es->corePtr = corePtr;
+ es->tracking = 0;
+ es->activeElement = es->pressedElement = 0;
+ Tk_CreateEventHandler(corePtr->tkwin,
+ ElementStateMask,ElementStateEventProc,es);
+}
+
diff --git a/tk8.6/generic/ttk/ttkTreeview.c b/tk8.6/generic/ttk/ttkTreeview.c
new file mode 100644
index 0000000..d957ad2
--- /dev/null
+++ b/tk8.6/generic/ttk/ttkTreeview.c
@@ -0,0 +1,3448 @@
+/*
+ * Copyright (c) 2004, Joe English
+ *
+ * ttk::treeview widget implementation.
+ */
+
+#include <string.h>
+#include <stdio.h>
+#include <tk.h>
+#include "ttkTheme.h"
+#include "ttkWidget.h"
+
+#define DEF_TREE_ROWS "10"
+#define DEF_COLWIDTH "200"
+#define DEF_MINWIDTH "20"
+
+static const int DEFAULT_ROWHEIGHT = 20;
+static const int DEFAULT_INDENT = 20;
+static const int HALO = 4; /* separator */
+
+#define TTK_STATE_OPEN TTK_STATE_USER1
+#define TTK_STATE_LEAF TTK_STATE_USER2
+
+#define STATE_CHANGED (0x100) /* item state option changed */
+
+/*------------------------------------------------------------------------
+ * +++ Tree items.
+ *
+ * INVARIANTS:
+ * item->children ==> item->children->parent == item
+ * item->next ==> item->next->parent == item->parent
+ * item->next ==> item->next->prev == item
+ * item->prev ==> item->prev->next == item
+ */
+
+typedef struct TreeItemRec TreeItem;
+struct TreeItemRec {
+ Tcl_HashEntry *entryPtr; /* Back-pointer to hash table entry */
+ TreeItem *parent; /* Parent item */
+ TreeItem *children; /* Linked list of child items */
+ TreeItem *next; /* Next sibling */
+ TreeItem *prev; /* Previous sibling */
+
+ /*
+ * Options and instance data:
+ */
+ Ttk_State state;
+ Tcl_Obj *textObj;
+ Tcl_Obj *imageObj;
+ Tcl_Obj *valuesObj;
+ Tcl_Obj *openObj;
+ Tcl_Obj *tagsObj;
+
+ /*
+ * Derived resources:
+ */
+ Ttk_TagSet tagset;
+ Ttk_ImageSpec *imagespec;
+};
+
+#define ITEM_OPTION_TAGS_CHANGED 0x100
+#define ITEM_OPTION_IMAGE_CHANGED 0x200
+
+static Tk_OptionSpec ItemOptionSpecs[] = {
+ {TK_OPTION_STRING, "-text", "text", "Text",
+ "", Tk_Offset(TreeItem,textObj), -1,
+ 0,0,0 },
+ {TK_OPTION_STRING, "-image", "image", "Image",
+ NULL, Tk_Offset(TreeItem,imageObj), -1,
+ TK_OPTION_NULL_OK,0,ITEM_OPTION_IMAGE_CHANGED },
+ {TK_OPTION_STRING, "-values", "values", "Values",
+ NULL, Tk_Offset(TreeItem,valuesObj), -1,
+ TK_OPTION_NULL_OK,0,0 },
+ {TK_OPTION_BOOLEAN, "-open", "open", "Open",
+ "0", Tk_Offset(TreeItem,openObj), -1,
+ 0,0,0 },
+ {TK_OPTION_STRING, "-tags", "tags", "Tags",
+ NULL, Tk_Offset(TreeItem,tagsObj), -1,
+ TK_OPTION_NULL_OK,0,ITEM_OPTION_TAGS_CHANGED },
+
+ {TK_OPTION_END, 0,0,0, NULL, -1,-1, 0,0,0}
+};
+
+/* + NewItem --
+ * Allocate a new, uninitialized, unlinked item
+ */
+static TreeItem *NewItem(void)
+{
+ TreeItem *item = ckalloc(sizeof(*item));
+
+ item->entryPtr = 0;
+ item->parent = item->children = item->next = item->prev = NULL;
+
+ item->state = 0ul;
+ item->textObj = NULL;
+ item->imageObj = NULL;
+ item->valuesObj = NULL;
+ item->openObj = NULL;
+ item->tagsObj = NULL;
+
+ item->tagset = NULL;
+ item->imagespec = NULL;
+
+ return item;
+}
+
+/* + FreeItem --
+ * Destroy an item
+ */
+static void FreeItem(TreeItem *item)
+{
+ if (item->textObj) { Tcl_DecrRefCount(item->textObj); }
+ if (item->imageObj) { Tcl_DecrRefCount(item->imageObj); }
+ if (item->valuesObj) { Tcl_DecrRefCount(item->valuesObj); }
+ if (item->openObj) { Tcl_DecrRefCount(item->openObj); }
+ if (item->tagsObj) { Tcl_DecrRefCount(item->tagsObj); }
+
+ if (item->tagset) { Ttk_FreeTagSet(item->tagset); }
+ if (item->imagespec) { TtkFreeImageSpec(item->imagespec); }
+
+ ckfree(item);
+}
+
+static void FreeItemCB(void *clientData) { FreeItem(clientData); }
+
+/* + DetachItem --
+ * Unlink an item from the tree.
+ */
+static void DetachItem(TreeItem *item)
+{
+ if (item->parent && item->parent->children == item)
+ item->parent->children = item->next;
+ if (item->prev)
+ item->prev->next = item->next;
+ if (item->next)
+ item->next->prev = item->prev;
+ item->next = item->prev = item->parent = NULL;
+}
+
+/* + InsertItem --
+ * Insert an item into the tree after the specified item.
+ *
+ * Preconditions:
+ * + item is currently detached
+ * + prev != NULL ==> prev->parent == parent.
+ */
+static void InsertItem(TreeItem *parent, TreeItem *prev, TreeItem *item)
+{
+ item->parent = parent;
+ item->prev = prev;
+ if (prev) {
+ item->next = prev->next;
+ prev->next = item;
+ } else {
+ item->next = parent->children;
+ parent->children = item;
+ }
+ if (item->next) {
+ item->next->prev = item;
+ }
+}
+
+/* + NextPreorder --
+ * Return the next item in preorder traversal order.
+ */
+
+static TreeItem *NextPreorder(TreeItem *item)
+{
+ if (item->children)
+ return item->children;
+ while (!item->next) {
+ item = item->parent;
+ if (!item)
+ return 0;
+ }
+ return item->next;
+}
+
+/*------------------------------------------------------------------------
+ * +++ Display items and tag options.
+ */
+
+typedef struct {
+ Tcl_Obj *textObj; /* taken from item / data cell */
+ Tcl_Obj *imageObj; /* taken from item */
+ Tcl_Obj *anchorObj; /* from column <<NOTE-ANCHOR>> */
+ Tcl_Obj *backgroundObj; /* remainder from tag */
+ Tcl_Obj *foregroundObj;
+ Tcl_Obj *fontObj;
+} DisplayItem;
+
+static Tk_OptionSpec TagOptionSpecs[] = {
+ {TK_OPTION_STRING, "-text", "text", "Text",
+ NULL, Tk_Offset(DisplayItem,textObj), -1,
+ TK_OPTION_NULL_OK,0,0 },
+ {TK_OPTION_STRING, "-image", "image", "Image",
+ NULL, Tk_Offset(DisplayItem,imageObj), -1,
+ TK_OPTION_NULL_OK,0,0 },
+ {TK_OPTION_ANCHOR, "-anchor", "anchor", "Anchor",
+ NULL, Tk_Offset(DisplayItem,anchorObj), -1,
+ TK_OPTION_NULL_OK, 0, GEOMETRY_CHANGED}, /* <<NOTE-ANCHOR>> */
+ {TK_OPTION_COLOR, "-background", "windowColor", "WindowColor",
+ NULL, Tk_Offset(DisplayItem,backgroundObj), -1,
+ TK_OPTION_NULL_OK,0,0 },
+ {TK_OPTION_COLOR, "-foreground", "textColor", "TextColor",
+ NULL, Tk_Offset(DisplayItem,foregroundObj), -1,
+ TK_OPTION_NULL_OK,0,0 },
+ {TK_OPTION_FONT, "-font", "font", "Font",
+ NULL, Tk_Offset(DisplayItem,fontObj), -1,
+ TK_OPTION_NULL_OK,0,GEOMETRY_CHANGED },
+
+ {TK_OPTION_END, 0,0,0, NULL, -1,-1, 0,0,0}
+};
+
+/*------------------------------------------------------------------------
+ * +++ Columns.
+ *
+ * There are separate option tables associated with the column record:
+ * ColumnOptionSpecs is for configuring the column,
+ * and HeadingOptionSpecs is for drawing headings.
+ */
+typedef struct {
+ int width; /* Column width, in pixels */
+ int minWidth; /* Minimum column width, in pixels */
+ int stretch; /* Should column stretch while resizing? */
+ Tcl_Obj *idObj; /* Column identifier, from -columns option */
+
+ Tcl_Obj *anchorObj; /* -anchor for cell data <<NOTE-ANCHOR>> */
+
+ /* Column heading data:
+ */
+ Tcl_Obj *headingObj; /* Heading label */
+ Tcl_Obj *headingImageObj; /* Heading image */
+ Tcl_Obj *headingAnchorObj; /* -anchor for heading label */
+ Tcl_Obj *headingCommandObj; /* Command to execute */
+ Tcl_Obj *headingStateObj; /* @@@ testing ... */
+ Ttk_State headingState; /* ... */
+
+ /* Temporary storage for cell data
+ */
+ Tcl_Obj *data;
+} TreeColumn;
+
+static void InitColumn(TreeColumn *column)
+{
+ column->width = 200;
+ column->minWidth = 20;
+ column->stretch = 1;
+ column->idObj = 0;
+ column->anchorObj = 0;
+
+ column->headingState = 0;
+ column->headingObj = 0;
+ column->headingImageObj = 0;
+ column->headingAnchorObj = 0;
+ column->headingStateObj = 0;
+ column->headingCommandObj = 0;
+
+ column->data = 0;
+}
+
+static void FreeColumn(TreeColumn *column)
+{
+ if (column->idObj) { Tcl_DecrRefCount(column->idObj); }
+ if (column->anchorObj) { Tcl_DecrRefCount(column->anchorObj); }
+
+ if (column->headingObj) { Tcl_DecrRefCount(column->headingObj); }
+ if (column->headingImageObj) { Tcl_DecrRefCount(column->headingImageObj); }
+ if (column->headingAnchorObj) { Tcl_DecrRefCount(column->headingAnchorObj); }
+ if (column->headingStateObj) { Tcl_DecrRefCount(column->headingStateObj); }
+ if (column->headingCommandObj) { Tcl_DecrRefCount(column->headingCommandObj); }
+
+ /* Don't touch column->data, it's scratch storage */
+}
+
+static Tk_OptionSpec ColumnOptionSpecs[] = {
+ {TK_OPTION_INT, "-width", "width", "Width",
+ DEF_COLWIDTH, -1, Tk_Offset(TreeColumn,width),
+ 0,0,GEOMETRY_CHANGED },
+ {TK_OPTION_INT, "-minwidth", "minWidth", "MinWidth",
+ DEF_MINWIDTH, -1, Tk_Offset(TreeColumn,minWidth),
+ 0,0,0 },
+ {TK_OPTION_BOOLEAN, "-stretch", "stretch", "Stretch",
+ "1", -1, Tk_Offset(TreeColumn,stretch),
+ 0,0,0 },
+ {TK_OPTION_ANCHOR, "-anchor", "anchor", "Anchor",
+ "w", Tk_Offset(TreeColumn,anchorObj), -1, /* <<NOTE-ANCHOR>> */
+ 0,0,0 },
+ {TK_OPTION_STRING, "-id", "id", "ID",
+ NULL, Tk_Offset(TreeColumn,idObj), -1,
+ TK_OPTION_NULL_OK,0,READONLY_OPTION },
+ {TK_OPTION_END, 0,0,0, NULL, -1,-1, 0,0,0}
+};
+
+static Tk_OptionSpec HeadingOptionSpecs[] = {
+ {TK_OPTION_STRING, "-text", "text", "Text",
+ "", Tk_Offset(TreeColumn,headingObj), -1,
+ 0,0,0 },
+ {TK_OPTION_STRING, "-image", "image", "Image",
+ "", Tk_Offset(TreeColumn,headingImageObj), -1,
+ 0,0,0 },
+ {TK_OPTION_ANCHOR, "-anchor", "anchor", "Anchor",
+ "center", Tk_Offset(TreeColumn,headingAnchorObj), -1,
+ 0,0,0 },
+ {TK_OPTION_STRING, "-command", "", "",
+ "", Tk_Offset(TreeColumn,headingCommandObj), -1,
+ TK_OPTION_NULL_OK,0,0 },
+ {TK_OPTION_STRING, "state", "", "",
+ "", Tk_Offset(TreeColumn,headingStateObj), -1,
+ 0,0,STATE_CHANGED },
+ {TK_OPTION_END, 0,0,0, NULL, -1,-1, 0,0,0}
+};
+
+/*------------------------------------------------------------------------
+ * +++ -show option:
+ * TODO: Implement SHOW_BRANCHES.
+ */
+
+#define SHOW_TREE (0x1) /* Show tree column? */
+#define SHOW_HEADINGS (0x2) /* Show heading row? */
+
+#define DEFAULT_SHOW "tree headings"
+
+static const char *showStrings[] = {
+ "tree", "headings", NULL
+};
+
+static int GetEnumSetFromObj(
+ Tcl_Interp *interp,
+ Tcl_Obj *objPtr,
+ const char *table[],
+ unsigned *resultPtr)
+{
+ unsigned result = 0;
+ int i, objc;
+ Tcl_Obj **objv;
+
+ if (Tcl_ListObjGetElements(interp, objPtr, &objc, &objv) != TCL_OK)
+ return TCL_ERROR;
+
+ for (i = 0; i < objc; ++i) {
+ int index;
+ if (TCL_OK != Tcl_GetIndexFromObjStruct(interp, objv[i], table,
+ sizeof(char *), "value", TCL_EXACT, &index))
+ {
+ return TCL_ERROR;
+ }
+ result |= (1 << index);
+ }
+
+ *resultPtr = result;
+ return TCL_OK;
+}
+
+/*------------------------------------------------------------------------
+ * +++ Treeview widget record.
+ *
+ * Dependencies:
+ * columns, columnNames: -columns
+ * displayColumns: -columns, -displaycolumns
+ * headingHeight: [layout]
+ * rowHeight, indent: style
+ */
+typedef struct {
+ /* Resources acquired at initialization-time:
+ */
+ Tk_OptionTable itemOptionTable;
+ Tk_OptionTable columnOptionTable;
+ Tk_OptionTable headingOptionTable;
+ Tk_OptionTable tagOptionTable;
+ Tk_BindingTable bindingTable;
+ Ttk_TagTable tagTable;
+
+ /* Acquired in GetLayout hook:
+ */
+ Ttk_Layout itemLayout;
+ Ttk_Layout cellLayout;
+ Ttk_Layout headingLayout;
+ Ttk_Layout rowLayout;
+
+ int headingHeight; /* Space for headings */
+ int rowHeight; /* Height of each item */
+ int indent; /* #pixels horizontal offset for child items */
+
+ /* Tree data:
+ */
+ Tcl_HashTable items; /* Map: item name -> item */
+ int serial; /* Next item # for autogenerated names */
+ TreeItem *root; /* Root item */
+
+ TreeColumn column0; /* Column options for display column #0 */
+ TreeColumn *columns; /* Array of column options for data columns */
+
+ TreeItem *focus; /* Current focus item */
+ TreeItem *endPtr; /* See EndPosition() */
+
+ /* Widget options:
+ */
+ Tcl_Obj *columnsObj; /* List of symbolic column names */
+ Tcl_Obj *displayColumnsObj; /* List of columns to display */
+
+ Tcl_Obj *heightObj; /* height (rows) */
+ Tcl_Obj *paddingObj; /* internal padding */
+
+ Tcl_Obj *showObj; /* -show list */
+ Tcl_Obj *selectModeObj; /* -selectmode option */
+
+ Scrollable xscroll;
+ ScrollHandle xscrollHandle;
+ Scrollable yscroll;
+ ScrollHandle yscrollHandle;
+
+ /* Derived resources:
+ */
+ Tcl_HashTable columnNames; /* Map: column name -> column table entry */
+ int nColumns; /* #columns */
+ unsigned showFlags; /* bitmask of subparts to display */
+
+ TreeColumn **displayColumns; /* List of columns for display (incl tree) */
+ int nDisplayColumns; /* #display columns */
+ Ttk_Box headingArea; /* Display area for column headings */
+ Ttk_Box treeArea; /* Display area for tree */
+ int slack; /* Slack space (see Resizing section) */
+
+} TreePart;
+
+typedef struct {
+ WidgetCore core;
+ TreePart tree;
+} Treeview;
+
+#define USER_MASK 0x0100
+#define COLUMNS_CHANGED (USER_MASK)
+#define DCOLUMNS_CHANGED (USER_MASK<<1)
+#define SCROLLCMD_CHANGED (USER_MASK<<2)
+#define SHOW_CHANGED (USER_MASK<<3)
+
+static const char *SelectModeStrings[] = { "none", "browse", "extended", NULL };
+
+static Tk_OptionSpec TreeviewOptionSpecs[] = {
+ {TK_OPTION_STRING, "-columns", "columns", "Columns",
+ "", Tk_Offset(Treeview,tree.columnsObj), -1,
+ 0,0,COLUMNS_CHANGED | GEOMETRY_CHANGED /*| READONLY_OPTION*/ },
+ {TK_OPTION_STRING, "-displaycolumns","displayColumns","DisplayColumns",
+ "#all", Tk_Offset(Treeview,tree.displayColumnsObj), -1,
+ 0,0,DCOLUMNS_CHANGED | GEOMETRY_CHANGED },
+ {TK_OPTION_STRING, "-show", "show", "Show",
+ DEFAULT_SHOW, Tk_Offset(Treeview,tree.showObj), -1,
+ 0,0,SHOW_CHANGED | GEOMETRY_CHANGED },
+
+ {TK_OPTION_STRING_TABLE, "-selectmode", "selectMode", "SelectMode",
+ "extended", Tk_Offset(Treeview,tree.selectModeObj), -1,
+ 0,(ClientData)SelectModeStrings,0 },
+
+ {TK_OPTION_PIXELS, "-height", "height", "Height",
+ DEF_TREE_ROWS, Tk_Offset(Treeview,tree.heightObj), -1,
+ 0,0,GEOMETRY_CHANGED},
+ {TK_OPTION_STRING, "-padding", "padding", "Pad",
+ NULL, Tk_Offset(Treeview,tree.paddingObj), -1,
+ TK_OPTION_NULL_OK,0,GEOMETRY_CHANGED },
+
+ {TK_OPTION_STRING, "-xscrollcommand", "xScrollCommand", "ScrollCommand",
+ NULL, -1, Tk_Offset(Treeview, tree.xscroll.scrollCmd),
+ TK_OPTION_NULL_OK, 0, SCROLLCMD_CHANGED},
+ {TK_OPTION_STRING, "-yscrollcommand", "yScrollCommand", "ScrollCommand",
+ NULL, -1, Tk_Offset(Treeview, tree.yscroll.scrollCmd),
+ TK_OPTION_NULL_OK, 0, SCROLLCMD_CHANGED},
+
+ WIDGET_TAKEFOCUS_TRUE,
+ WIDGET_INHERIT_OPTIONS(ttkCoreOptionSpecs)
+};
+
+/*------------------------------------------------------------------------
+ * +++ Utilities.
+ */
+typedef void (*HashEntryIterator)(void *hashValue);
+
+static void foreachHashEntry(Tcl_HashTable *ht, HashEntryIterator func)
+{
+ Tcl_HashSearch search;
+ Tcl_HashEntry *entryPtr = Tcl_FirstHashEntry(ht, &search);
+ while (entryPtr != NULL) {
+ func(Tcl_GetHashValue(entryPtr));
+ entryPtr = Tcl_NextHashEntry(&search);
+ }
+}
+
+/* + unshareObj(objPtr) --
+ * Ensure that a Tcl_Obj * has refcount 1 -- either return objPtr
+ * itself, or a duplicated copy.
+ */
+static Tcl_Obj *unshareObj(Tcl_Obj *objPtr)
+{
+ if (Tcl_IsShared(objPtr)) {
+ Tcl_Obj *newObj = Tcl_DuplicateObj(objPtr);
+ Tcl_DecrRefCount(objPtr);
+ Tcl_IncrRefCount(newObj);
+ return newObj;
+ }
+ return objPtr;
+}
+
+/* DisplayLayout --
+ * Rebind, place, and draw a layout + object combination.
+ */
+static void DisplayLayout(
+ Ttk_Layout layout, void *recordPtr, Ttk_State state, Ttk_Box b, Drawable d)
+{
+ Ttk_RebindSublayout(layout, recordPtr);
+ Ttk_PlaceLayout(layout, state, b);
+ Ttk_DrawLayout(layout, state, d);
+}
+
+/* + GetColumn --
+ * Look up column by name or number.
+ * Returns: pointer to column table entry, NULL if not found.
+ * Leaves an error message in interp->result on error.
+ */
+static TreeColumn *GetColumn(
+ Tcl_Interp *interp, Treeview *tv, Tcl_Obj *columnIDObj)
+{
+ Tcl_HashEntry *entryPtr;
+ int columnIndex;
+
+ /* Check for named column:
+ */
+ entryPtr = Tcl_FindHashEntry(
+ &tv->tree.columnNames, Tcl_GetString(columnIDObj));
+ if (entryPtr) {
+ return Tcl_GetHashValue(entryPtr);
+ }
+
+ /* Check for number:
+ */
+ if (Tcl_GetIntFromObj(NULL, columnIDObj, &columnIndex) == TCL_OK) {
+ if (columnIndex < 0 || columnIndex >= tv->tree.nColumns) {
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "Column index %s out of bounds",
+ Tcl_GetString(columnIDObj)));
+ Tcl_SetErrorCode(interp, "TTK", "TREE", "COLBOUND", NULL);
+ return NULL;
+ }
+
+ return tv->tree.columns + columnIndex;
+ }
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "Invalid column index %s", Tcl_GetString(columnIDObj)));
+ Tcl_SetErrorCode(interp, "TTK", "TREE", "COLUMN", NULL);
+ return NULL;
+}
+
+/* + FindColumn --
+ * Look up column by name, number, or display index.
+ */
+static TreeColumn *FindColumn(
+ Tcl_Interp *interp, Treeview *tv, Tcl_Obj *columnIDObj)
+{
+ int colno;
+
+ if (sscanf(Tcl_GetString(columnIDObj), "#%d", &colno) == 1)
+ { /* Display column specification, #n */
+ if (colno >= 0 && colno < tv->tree.nDisplayColumns) {
+ return tv->tree.displayColumns[colno];
+ }
+ /* else */
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "Column %s out of range", Tcl_GetString(columnIDObj)));
+ Tcl_SetErrorCode(interp, "TTK", "TREE", "COLUMN", NULL);
+ return NULL;
+ }
+
+ return GetColumn(interp, tv, columnIDObj);
+}
+
+/* + FindItem --
+ * Locates the item with the specified identifier in the tree.
+ * If there is no such item, leaves an error message in interp.
+ */
+static TreeItem *FindItem(
+ Tcl_Interp *interp, Treeview *tv, Tcl_Obj *itemNameObj)
+{
+ const char *itemName = Tcl_GetString(itemNameObj);
+ Tcl_HashEntry *entryPtr = Tcl_FindHashEntry(&tv->tree.items, itemName);
+
+ if (!entryPtr) {
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "Item %s not found", itemName));
+ Tcl_SetErrorCode(interp, "TTK", "TREE", "ITEM", NULL);
+ return 0;
+ }
+ return Tcl_GetHashValue(entryPtr);
+}
+
+/* + GetItemListFromObj --
+ * Parse a Tcl_Obj * as a list of items.
+ * Returns a NULL-terminated array of items; result must
+ * be ckfree()d. On error, returns NULL and leaves an error
+ * message in interp.
+ */
+
+static TreeItem **GetItemListFromObj(
+ Tcl_Interp *interp, Treeview *tv, Tcl_Obj *objPtr)
+{
+ TreeItem **items;
+ Tcl_Obj **elements;
+ int i, nElements;
+
+ if (Tcl_ListObjGetElements(interp,objPtr,&nElements,&elements) != TCL_OK) {
+ return NULL;
+ }
+
+ items = ckalloc((nElements + 1)*sizeof(TreeItem*));
+ for (i = 0; i < nElements; ++i) {
+ items[i] = FindItem(interp, tv, elements[i]);
+ if (!items[i]) {
+ ckfree(items);
+ return NULL;
+ }
+ }
+ items[i] = NULL;
+ return items;
+}
+
+/* + ItemName --
+ * Returns the item's ID.
+ */
+static const char *ItemName(Treeview *tv, TreeItem *item)
+{
+ return Tcl_GetHashKey(&tv->tree.items, item->entryPtr);
+}
+
+/* + ItemID --
+ * Returns a fresh Tcl_Obj * (refcount 0) holding the
+ * item identifier of the specified item.
+ */
+static Tcl_Obj *ItemID(Treeview *tv, TreeItem *item)
+{
+ return Tcl_NewStringObj(ItemName(tv, item), -1);
+}
+
+/*------------------------------------------------------------------------
+ * +++ Column configuration.
+ */
+
+/* + TreeviewFreeColumns --
+ * Free column data.
+ */
+static void TreeviewFreeColumns(Treeview *tv)
+{
+ int i;
+
+ Tcl_DeleteHashTable(&tv->tree.columnNames);
+ Tcl_InitHashTable(&tv->tree.columnNames, TCL_STRING_KEYS);
+
+ if (tv->tree.columns) {
+ for (i = 0; i < tv->tree.nColumns; ++i)
+ FreeColumn(tv->tree.columns + i);
+ ckfree(tv->tree.columns);
+ tv->tree.columns = 0;
+ }
+}
+
+/* + TreeviewInitColumns --
+ * Initialize column data when -columns changes.
+ * Returns: TCL_OK or TCL_ERROR;
+ */
+static int TreeviewInitColumns(Tcl_Interp *interp, Treeview *tv)
+{
+ Tcl_Obj **columns;
+ int i, ncols;
+
+ if (Tcl_ListObjGetElements(
+ interp, tv->tree.columnsObj, &ncols, &columns) != TCL_OK)
+ {
+ return TCL_ERROR;
+ }
+
+ /*
+ * Free old values:
+ */
+ TreeviewFreeColumns(tv);
+
+ /*
+ * Initialize columns array and columnNames hash table:
+ */
+ tv->tree.nColumns = ncols;
+ tv->tree.columns = ckalloc(tv->tree.nColumns * sizeof(TreeColumn));
+
+ for (i = 0; i < ncols; ++i) {
+ int isNew;
+ Tcl_Obj *columnName = Tcl_DuplicateObj(columns[i]);
+
+ Tcl_HashEntry *entryPtr = Tcl_CreateHashEntry(
+ &tv->tree.columnNames, Tcl_GetString(columnName), &isNew);
+ Tcl_SetHashValue(entryPtr, tv->tree.columns + i);
+
+ InitColumn(tv->tree.columns + i);
+ Tk_InitOptions(
+ interp, (ClientData)(tv->tree.columns + i),
+ tv->tree.columnOptionTable, tv->core.tkwin);
+ Tk_InitOptions(
+ interp, (ClientData)(tv->tree.columns + i),
+ tv->tree.headingOptionTable, tv->core.tkwin);
+ Tcl_IncrRefCount(columnName);
+ tv->tree.columns[i].idObj = columnName;
+ }
+
+ return TCL_OK;
+}
+
+/* + TreeviewInitDisplayColumns --
+ * Initializes the 'displayColumns' array.
+ *
+ * Note that displayColumns[0] is always the tree column,
+ * even when SHOW_TREE is not set.
+ *
+ * @@@ TODO: disallow duplicated columns
+ */
+static int TreeviewInitDisplayColumns(Tcl_Interp *interp, Treeview *tv)
+{
+ Tcl_Obj **dcolumns;
+ int index, ndcols;
+ TreeColumn **displayColumns = 0;
+
+ if (Tcl_ListObjGetElements(interp,
+ tv->tree.displayColumnsObj, &ndcols, &dcolumns) != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ if (!strcmp(Tcl_GetString(tv->tree.displayColumnsObj), "#all")) {
+ ndcols = tv->tree.nColumns;
+ displayColumns = ckalloc((ndcols+1) * sizeof(TreeColumn*));
+ for (index = 0; index < ndcols; ++index) {
+ displayColumns[index+1] = tv->tree.columns + index;
+ }
+ } else {
+ displayColumns = ckalloc((ndcols+1) * sizeof(TreeColumn*));
+ for (index = 0; index < ndcols; ++index) {
+ displayColumns[index+1] = GetColumn(interp, tv, dcolumns[index]);
+ if (!displayColumns[index+1]) {
+ ckfree(displayColumns);
+ return TCL_ERROR;
+ }
+ }
+ }
+ displayColumns[0] = &tv->tree.column0;
+
+ if (tv->tree.displayColumns)
+ ckfree(tv->tree.displayColumns);
+ tv->tree.displayColumns = displayColumns;
+ tv->tree.nDisplayColumns = ndcols + 1;
+
+ return TCL_OK;
+}
+
+/*------------------------------------------------------------------------
+ * +++ Resizing.
+ * slack invariant: TreeWidth(tree) + slack = treeArea.width
+ */
+
+#define FirstColumn(tv) ((tv->tree.showFlags&SHOW_TREE) ? 0 : 1)
+
+/* + TreeWidth --
+ * Compute the requested tree width from the sum of visible column widths.
+ */
+static int TreeWidth(Treeview *tv)
+{
+ int i = FirstColumn(tv);
+ int width = 0;
+
+ while (i < tv->tree.nDisplayColumns) {
+ width += tv->tree.displayColumns[i++]->width;
+ }
+ return width;
+}
+
+/* + RecomputeSlack --
+ */
+static void RecomputeSlack(Treeview *tv)
+{
+ tv->tree.slack = tv->tree.treeArea.width - TreeWidth(tv);
+}
+
+/* + PickupSlack/DepositSlack --
+ * When resizing columns, distribute extra space to 'slack' first,
+ * and only adjust column widths if 'slack' goes to zero.
+ * That is, don't bother changing column widths if the tree
+ * is already scrolled or short.
+ */
+static int PickupSlack(Treeview *tv, int extra)
+{
+ int newSlack = tv->tree.slack + extra;
+
+ if ( (newSlack < 0 && 0 <= tv->tree.slack)
+ || (newSlack > 0 && 0 >= tv->tree.slack))
+ {
+ tv->tree.slack = 0;
+ return newSlack;
+ } else {
+ tv->tree.slack = newSlack;
+ return 0;
+ }
+}
+
+static void DepositSlack(Treeview *tv, int extra)
+{
+ tv->tree.slack += extra;
+}
+
+/* + Stretch --
+ * Adjust width of column by N pixels, down to minimum width.
+ * Returns: #pixels actually moved.
+ */
+static int Stretch(TreeColumn *c, int n)
+{
+ int newWidth = n + c->width;
+ if (newWidth < c->minWidth) {
+ n = c->minWidth - c->width;
+ c->width = c->minWidth;
+ } else {
+ c->width = newWidth;
+ }
+ return n;
+}
+
+/* + ShoveLeft --
+ * Adjust width of (stretchable) columns to the left by N pixels.
+ * Returns: leftover slack.
+ */
+static int ShoveLeft(Treeview *tv, int i, int n)
+{
+ int first = FirstColumn(tv);
+ while (n != 0 && i >= first) {
+ TreeColumn *c = tv->tree.displayColumns[i];
+ if (c->stretch) {
+ n -= Stretch(c, n);
+ }
+ --i;
+ }
+ return n;
+}
+
+/* + ShoveRight --
+ * Adjust width of (stretchable) columns to the right by N pixels.
+ * Returns: leftover slack.
+ */
+static int ShoveRight(Treeview *tv, int i, int n)
+{
+ while (n != 0 && i < tv->tree.nDisplayColumns) {
+ TreeColumn *c = tv->tree.displayColumns[i];
+ if (c->stretch) {
+ n -= Stretch(c, n);
+ }
+ ++i;
+ }
+ return n;
+}
+
+/* + DistributeWidth --
+ * Distribute n pixels evenly across all stretchable display columns.
+ * Returns: leftover slack.
+ * Notes:
+ * The "((++w % m) < r)" term is there so that the remainder r = n % m
+ * is distributed round-robin.
+ */
+static int DistributeWidth(Treeview *tv, int n)
+{
+ int w = TreeWidth(tv);
+ int m = 0;
+ int i, d, r;
+
+ for (i = FirstColumn(tv); i < tv->tree.nDisplayColumns; ++i) {
+ if (tv->tree.displayColumns[i]->stretch) {
+ ++m;
+ }
+ }
+ if (m == 0) {
+ return n;
+ }
+
+ d = n / m;
+ r = n % m;
+ if (r < 0) { r += m; --d; }
+
+ for (i = FirstColumn(tv); i < tv->tree.nDisplayColumns; ++i) {
+ TreeColumn *c = tv->tree.displayColumns[i];
+ if (c->stretch) {
+ n -= Stretch(c, d + ((++w % m) < r));
+ }
+ }
+ return n;
+}
+
+/* + ResizeColumns --
+ * Recompute column widths based on available width.
+ * Pick up slack first;
+ * Distribute the remainder evenly across stretchable columns;
+ * If any is still left over due to minwidth constraints, shove left.
+ */
+static void ResizeColumns(Treeview *tv, int newWidth)
+{
+ int delta = newWidth - (TreeWidth(tv) + tv->tree.slack);
+ DepositSlack(tv,
+ ShoveLeft(tv, tv->tree.nDisplayColumns - 1,
+ DistributeWidth(tv, PickupSlack(tv, delta))));
+}
+
+/* + DragColumn --
+ * Move the separator to the right of specified column,
+ * adjusting other column widths as necessary.
+ */
+static void DragColumn(Treeview *tv, int i, int delta)
+{
+ TreeColumn *c = tv->tree.displayColumns[i];
+ int dl = delta - ShoveLeft(tv, i-1, delta - Stretch(c, delta));
+ int dr = ShoveRight(tv, i+1, PickupSlack(tv, -dl));
+ DepositSlack(tv, dr);
+}
+
+/*------------------------------------------------------------------------
+ * +++ Event handlers.
+ */
+
+static TreeItem *IdentifyItem(Treeview *tv, int y); /*forward*/
+
+static const unsigned int TreeviewBindEventMask =
+ KeyPressMask|KeyReleaseMask
+ | ButtonPressMask|ButtonReleaseMask
+ | PointerMotionMask|ButtonMotionMask
+ | VirtualEventMask
+ ;
+
+static void TreeviewBindEventProc(void *clientData, XEvent *event)
+{
+ Treeview *tv = clientData;
+ TreeItem *item = NULL;
+ Ttk_TagSet tagset;
+
+ /*
+ * Figure out where to deliver the event.
+ */
+ switch (event->type)
+ {
+ case KeyPress:
+ case KeyRelease:
+ case VirtualEvent:
+ item = tv->tree.focus;
+ break;
+ case ButtonPress:
+ case ButtonRelease:
+ item = IdentifyItem(tv, event->xbutton.y);
+ break;
+ case MotionNotify:
+ item = IdentifyItem(tv, event->xmotion.y);
+ break;
+ default:
+ break;
+ }
+
+ if (!item) {
+ return;
+ }
+
+ /* ASSERT: Ttk_GetTagSetFromObj succeeds.
+ * NB: must use a local copy of the tagset,
+ * in case a binding script stomps on -tags.
+ */
+ tagset = Ttk_GetTagSetFromObj(NULL, tv->tree.tagTable, item->tagsObj);
+
+ /*
+ * Fire binding:
+ */
+ Tcl_Preserve(clientData);
+ Tk_BindEvent(tv->tree.bindingTable, event, tv->core.tkwin,
+ tagset->nTags, (void **)tagset->tags);
+ Tcl_Release(clientData);
+
+ Ttk_FreeTagSet(tagset);
+}
+
+/*------------------------------------------------------------------------
+ * +++ Initialization and cleanup.
+ */
+
+static void TreeviewInitialize(Tcl_Interp *interp, void *recordPtr)
+{
+ Treeview *tv = recordPtr;
+ int unused;
+
+ tv->tree.itemOptionTable =
+ Tk_CreateOptionTable(interp, ItemOptionSpecs);
+ tv->tree.columnOptionTable =
+ Tk_CreateOptionTable(interp, ColumnOptionSpecs);
+ tv->tree.headingOptionTable =
+ Tk_CreateOptionTable(interp, HeadingOptionSpecs);
+ tv->tree.tagOptionTable =
+ Tk_CreateOptionTable(interp, TagOptionSpecs);
+
+ tv->tree.tagTable = Ttk_CreateTagTable(
+ interp, tv->core.tkwin, TagOptionSpecs, sizeof(DisplayItem));
+ tv->tree.bindingTable = Tk_CreateBindingTable(interp);
+ Tk_CreateEventHandler(tv->core.tkwin,
+ TreeviewBindEventMask, TreeviewBindEventProc, tv);
+
+ tv->tree.itemLayout
+ = tv->tree.cellLayout
+ = tv->tree.headingLayout
+ = tv->tree.rowLayout
+ = 0;
+ tv->tree.headingHeight = tv->tree.rowHeight = DEFAULT_ROWHEIGHT;
+ tv->tree.indent = DEFAULT_INDENT;
+
+ Tcl_InitHashTable(&tv->tree.columnNames, TCL_STRING_KEYS);
+ tv->tree.nColumns = tv->tree.nDisplayColumns = 0;
+ tv->tree.columns = NULL;
+ tv->tree.displayColumns = NULL;
+ tv->tree.showFlags = ~0;
+
+ InitColumn(&tv->tree.column0);
+ Tk_InitOptions(
+ interp, (ClientData)(&tv->tree.column0),
+ tv->tree.columnOptionTable, tv->core.tkwin);
+ Tk_InitOptions(
+ interp, (ClientData)(&tv->tree.column0),
+ tv->tree.headingOptionTable, tv->core.tkwin);
+
+ Tcl_InitHashTable(&tv->tree.items, TCL_STRING_KEYS);
+ tv->tree.serial = 0;
+
+ tv->tree.focus = tv->tree.endPtr = 0;
+
+ /* Create root item "":
+ */
+ tv->tree.root = NewItem();
+ Tk_InitOptions(interp, (ClientData)tv->tree.root,
+ tv->tree.itemOptionTable, tv->core.tkwin);
+ tv->tree.root->tagset = Ttk_GetTagSetFromObj(NULL, tv->tree.tagTable, NULL);
+ tv->tree.root->entryPtr = Tcl_CreateHashEntry(&tv->tree.items, "", &unused);
+ Tcl_SetHashValue(tv->tree.root->entryPtr, tv->tree.root);
+
+ /* Scroll handles:
+ */
+ tv->tree.xscrollHandle = TtkCreateScrollHandle(&tv->core,&tv->tree.xscroll);
+ tv->tree.yscrollHandle = TtkCreateScrollHandle(&tv->core,&tv->tree.yscroll);
+
+ /* Size parameters:
+ */
+ tv->tree.treeArea = tv->tree.headingArea = Ttk_MakeBox(0,0,0,0);
+ tv->tree.slack = 0;
+}
+
+static void TreeviewCleanup(void *recordPtr)
+{
+ Treeview *tv = recordPtr;
+
+ Tk_DeleteEventHandler(tv->core.tkwin,
+ TreeviewBindEventMask, TreeviewBindEventProc, tv);
+ Tk_DeleteBindingTable(tv->tree.bindingTable);
+ Ttk_DeleteTagTable(tv->tree.tagTable);
+
+ if (tv->tree.itemLayout) Ttk_FreeLayout(tv->tree.itemLayout);
+ if (tv->tree.cellLayout) Ttk_FreeLayout(tv->tree.cellLayout);
+ if (tv->tree.headingLayout) Ttk_FreeLayout(tv->tree.headingLayout);
+ if (tv->tree.rowLayout) Ttk_FreeLayout(tv->tree.rowLayout);
+
+ TreeviewFreeColumns(tv);
+
+ if (tv->tree.displayColumns)
+ Tcl_Free((ClientData)tv->tree.displayColumns);
+
+ foreachHashEntry(&tv->tree.items, FreeItemCB);
+ Tcl_DeleteHashTable(&tv->tree.items);
+
+ TtkFreeScrollHandle(tv->tree.xscrollHandle);
+ TtkFreeScrollHandle(tv->tree.yscrollHandle);
+}
+
+/* + TreeviewConfigure --
+ * Configuration widget hook.
+ *
+ * BUG: If user sets -columns and -displaycolumns, but -displaycolumns
+ * has an error, the widget is left in an inconsistent state.
+ */
+static int
+TreeviewConfigure(Tcl_Interp *interp, void *recordPtr, int mask)
+{
+ Treeview *tv = recordPtr;
+ unsigned showFlags = tv->tree.showFlags;
+
+ if (mask & COLUMNS_CHANGED) {
+ if (TreeviewInitColumns(interp, tv) != TCL_OK)
+ return TCL_ERROR;
+ mask |= DCOLUMNS_CHANGED;
+ }
+ if (mask & DCOLUMNS_CHANGED) {
+ if (TreeviewInitDisplayColumns(interp, tv) != TCL_OK)
+ return TCL_ERROR;
+ }
+ if (mask & SCROLLCMD_CHANGED) {
+ TtkScrollbarUpdateRequired(tv->tree.xscrollHandle);
+ TtkScrollbarUpdateRequired(tv->tree.yscrollHandle);
+ }
+ if ( (mask & SHOW_CHANGED)
+ && GetEnumSetFromObj(
+ interp,tv->tree.showObj,showStrings,&showFlags) != TCL_OK)
+ {
+ return TCL_ERROR;
+ }
+
+ if (TtkCoreConfigure(interp, recordPtr, mask) != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ tv->tree.showFlags = showFlags;
+
+ if (mask & (SHOW_CHANGED | DCOLUMNS_CHANGED)) {
+ RecomputeSlack(tv);
+ }
+ return TCL_OK;
+}
+
+/* + ConfigureItem --
+ * Set item options.
+ */
+static int ConfigureItem(
+ Tcl_Interp *interp, Treeview *tv, TreeItem *item,
+ int objc, Tcl_Obj *const objv[])
+{
+ Tk_SavedOptions savedOptions;
+ int mask;
+ Ttk_ImageSpec *newImageSpec = NULL;
+ Ttk_TagSet newTagSet = NULL;
+
+ if (Tk_SetOptions(interp, (ClientData)item, tv->tree.itemOptionTable,
+ objc, objv, tv->core.tkwin, &savedOptions, &mask)
+ != TCL_OK)
+ {
+ return TCL_ERROR;
+ }
+
+ /* Make sure that -values is a valid list:
+ */
+ if (item->valuesObj) {
+ int unused;
+ if (Tcl_ListObjLength(interp, item->valuesObj, &unused) != TCL_OK)
+ goto error;
+ }
+
+ /* Check -image.
+ */
+ if ((mask & ITEM_OPTION_IMAGE_CHANGED) && item->imageObj) {
+ newImageSpec = TtkGetImageSpec(interp, tv->core.tkwin, item->imageObj);
+ if (!newImageSpec) {
+ goto error;
+ }
+ }
+
+ /* Check -tags.
+ * Side effect: may create new tags.
+ */
+ if (mask & ITEM_OPTION_TAGS_CHANGED) {
+ newTagSet = Ttk_GetTagSetFromObj(
+ interp, tv->tree.tagTable, item->tagsObj);
+ if (!newTagSet) {
+ goto error;
+ }
+ }
+
+ /* Keep TTK_STATE_OPEN flag in sync with item->openObj.
+ * We use both a state flag and a Tcl_Obj* resource so elements
+ * can access the value in either way.
+ */
+ if (item->openObj) {
+ int isOpen;
+ if (Tcl_GetBooleanFromObj(interp, item->openObj, &isOpen) != TCL_OK)
+ goto error;
+ if (isOpen)
+ item->state |= TTK_STATE_OPEN;
+ else
+ item->state &= ~TTK_STATE_OPEN;
+ }
+
+ /* All OK.
+ */
+ Tk_FreeSavedOptions(&savedOptions);
+ if (mask & ITEM_OPTION_TAGS_CHANGED) {
+ if (item->tagset) { Ttk_FreeTagSet(item->tagset); }
+ item->tagset = newTagSet;
+ }
+ if (mask & ITEM_OPTION_IMAGE_CHANGED) {
+ if (item->imagespec) { TtkFreeImageSpec(item->imagespec); }
+ item->imagespec = newImageSpec;
+ }
+ TtkRedisplayWidget(&tv->core);
+ return TCL_OK;
+
+error:
+ Tk_RestoreSavedOptions(&savedOptions);
+ if (newTagSet) { Ttk_FreeTagSet(newTagSet); }
+ if (newImageSpec) { TtkFreeImageSpec(newImageSpec); }
+ return TCL_ERROR;
+}
+
+/* + ConfigureColumn --
+ * Set column options.
+ */
+static int ConfigureColumn(
+ Tcl_Interp *interp, Treeview *tv, TreeColumn *column,
+ int objc, Tcl_Obj *const objv[])
+{
+ Tk_SavedOptions savedOptions;
+ int mask;
+
+ if (Tk_SetOptions(interp, (ClientData)column,
+ tv->tree.columnOptionTable, objc, objv, tv->core.tkwin,
+ &savedOptions,&mask) != TCL_OK)
+ {
+ return TCL_ERROR;
+ }
+
+ if (mask & READONLY_OPTION) {
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "Attempt to change read-only option", -1));
+ Tcl_SetErrorCode(interp, "TTK", "TREE", "READONLY", NULL);
+ goto error;
+ }
+
+ /* Propagate column width changes to overall widget request width,
+ * but only if the widget is currently unmapped, in order to prevent
+ * geometry jumping during interactive column resize.
+ */
+ if (mask & GEOMETRY_CHANGED) {
+ if (!Tk_IsMapped(tv->core.tkwin)) {
+ TtkResizeWidget(&tv->core);
+ }
+ RecomputeSlack(tv);
+ }
+ TtkRedisplayWidget(&tv->core);
+
+ /* ASSERT: SLACKINVARIANT */
+
+ Tk_FreeSavedOptions(&savedOptions);
+ return TCL_OK;
+
+error:
+ Tk_RestoreSavedOptions(&savedOptions);
+ return TCL_ERROR;
+}
+
+/* + ConfigureHeading --
+ * Set heading options.
+ */
+static int ConfigureHeading(
+ Tcl_Interp *interp, Treeview *tv, TreeColumn *column,
+ int objc, Tcl_Obj *const objv[])
+{
+ Tk_SavedOptions savedOptions;
+ int mask;
+
+ if (Tk_SetOptions(interp, (ClientData)column,
+ tv->tree.headingOptionTable, objc, objv, tv->core.tkwin,
+ &savedOptions,&mask) != TCL_OK)
+ {
+ return TCL_ERROR;
+ }
+
+ /* @@@ testing ... */
+ if ((mask & STATE_CHANGED) && column->headingStateObj) {
+ Ttk_StateSpec stateSpec;
+ if (Ttk_GetStateSpecFromObj(
+ interp, column->headingStateObj, &stateSpec) != TCL_OK)
+ {
+ goto error;
+ }
+ column->headingState = Ttk_ModifyState(column->headingState,&stateSpec);
+ Tcl_DecrRefCount(column->headingStateObj);
+ column->headingStateObj = Ttk_NewStateSpecObj(column->headingState,0);
+ Tcl_IncrRefCount(column->headingStateObj);
+ }
+
+ TtkRedisplayWidget(&tv->core);
+ Tk_FreeSavedOptions(&savedOptions);
+ return TCL_OK;
+
+error:
+ Tk_RestoreSavedOptions(&savedOptions);
+ return TCL_ERROR;
+}
+
+/*------------------------------------------------------------------------
+ * +++ Geometry routines.
+ */
+
+/* + CountRows --
+ * Returns the number of viewable rows rooted at item
+ */
+static int CountRows(TreeItem *item)
+{
+ int rows = 1;
+
+ if (item->state & TTK_STATE_OPEN) {
+ TreeItem *child = item->children;
+ while (child) {
+ rows += CountRows(child);
+ child = child->next;
+ }
+ }
+ return rows;
+}
+
+/* + IdentifyRow --
+ * Recursive search for item at specified y position.
+ * Main work routine for IdentifyItem()
+ */
+static TreeItem *IdentifyRow(
+ Treeview *tv, /* Widget record */
+ TreeItem *item, /* Where to start search */
+ int *ypos, /* Scan position */
+ int y) /* Target y coordinate */
+{
+ while (item) {
+ int next_ypos = *ypos + tv->tree.rowHeight;
+ if (*ypos <= y && y <= next_ypos) {
+ return item;
+ }
+ *ypos = next_ypos;
+ if (item->state & TTK_STATE_OPEN) {
+ TreeItem *subitem = IdentifyRow(tv, item->children, ypos, y);
+ if (subitem) {
+ return subitem;
+ }
+ }
+ item = item->next;
+ }
+ return 0;
+}
+
+/* + IdentifyItem --
+ * Locate the item at the specified y position, if any.
+ */
+static TreeItem *IdentifyItem(Treeview *tv, int y)
+{
+ int rowHeight = tv->tree.rowHeight;
+ int ypos = tv->tree.treeArea.y - rowHeight * tv->tree.yscroll.first;
+ return IdentifyRow(tv, tv->tree.root->children, &ypos, y);
+}
+
+/* + IdentifyDisplayColumn --
+ * Returns the display column number at the specified x position,
+ * or -1 if x is outside any columns.
+ */
+static int IdentifyDisplayColumn(Treeview *tv, int x, int *x1)
+{
+ int colno = FirstColumn(tv);
+ int xpos = tv->tree.treeArea.x - tv->tree.xscroll.first;
+
+ while (colno < tv->tree.nDisplayColumns) {
+ TreeColumn *column = tv->tree.displayColumns[colno];
+ int next_xpos = xpos + column->width;
+ if (xpos <= x && x <= next_xpos + HALO) {
+ *x1 = next_xpos;
+ return colno;
+ }
+ ++colno;
+ xpos = next_xpos;
+ }
+
+ return -1;
+}
+
+/* + RowNumber --
+ * Calculate which row the specified item appears on;
+ * returns -1 if the item is not viewable.
+ * Xref: DrawForest, IdentifyItem.
+ */
+static int RowNumber(Treeview *tv, TreeItem *item)
+{
+ TreeItem *p = tv->tree.root->children;
+ int n = 0;
+
+ while (p) {
+ if (p == item)
+ return n;
+
+ ++n;
+
+ /* Find next viewable item in preorder traversal order
+ */
+ if (p->children && (p->state & TTK_STATE_OPEN)) {
+ p = p->children;
+ } else {
+ while (!p->next && p && p->parent)
+ p = p->parent;
+ if (p)
+ p = p->next;
+ }
+ }
+
+ return -1;
+}
+
+/* + ItemDepth -- return the depth of a tree item.
+ * The depth of an item is equal to the number of proper ancestors,
+ * not counting the root node.
+ */
+static int ItemDepth(TreeItem *item)
+{
+ int depth = 0;
+ while (item->parent) {
+ ++depth;
+ item = item->parent;
+ }
+ return depth-1;
+}
+
+/* + ItemRow --
+ * Returns row number of specified item relative to root,
+ * -1 if item is not viewable.
+ */
+static int ItemRow(Treeview *tv, TreeItem *p)
+{
+ TreeItem *root = tv->tree.root;
+ int rowNumber = 0;
+
+ for (;;) {
+ if (p->prev) {
+ p = p->prev;
+ rowNumber += CountRows(p);
+ } else {
+ p = p->parent;
+ if (!(p && (p->state & TTK_STATE_OPEN))) {
+ /* detached or closed ancestor */
+ return -1;
+ }
+ if (p == root) {
+ return rowNumber;
+ }
+ ++rowNumber;
+ }
+ }
+}
+
+/* + BoundingBox --
+ * Compute the parcel of the specified column of the specified item,
+ * (or the entire item if column is NULL)
+ * Returns: 0 if item or column is not viewable, 1 otherwise.
+ */
+static int BoundingBox(
+ Treeview *tv, /* treeview widget */
+ TreeItem *item, /* desired item */
+ TreeColumn *column, /* desired column */
+ Ttk_Box *bbox_rtn) /* bounding box of item */
+{
+ int row = ItemRow(tv, item);
+ Ttk_Box bbox = tv->tree.treeArea;
+
+ if (row < tv->tree.yscroll.first || row > tv->tree.yscroll.last) {
+ /* not viewable, or off-screen */
+ return 0;
+ }
+
+ bbox.y += (row - tv->tree.yscroll.first) * tv->tree.rowHeight;
+ bbox.height = tv->tree.rowHeight;
+
+ bbox.x -= tv->tree.xscroll.first;
+ bbox.width = TreeWidth(tv);
+
+ if (column) {
+ int xpos = 0, i = FirstColumn(tv);
+ while (i < tv->tree.nDisplayColumns) {
+ if (tv->tree.displayColumns[i] == column) {
+ break;
+ }
+ xpos += tv->tree.displayColumns[i]->width;
+ ++i;
+ }
+ if (i == tv->tree.nDisplayColumns) { /* specified column unviewable */
+ return 0;
+ }
+ bbox.x += xpos;
+ bbox.width = column->width;
+
+ /* Account for indentation in tree column:
+ */
+ if (column == &tv->tree.column0) {
+ int indent = tv->tree.indent * ItemDepth(item);
+ bbox.x += indent;
+ bbox.width -= indent;
+ }
+ }
+ *bbox_rtn = bbox;
+ return 1;
+}
+
+/* + IdentifyRegion --
+ */
+
+typedef enum {
+ REGION_NOTHING = 0,
+ REGION_HEADING,
+ REGION_SEPARATOR,
+ REGION_TREE,
+ REGION_CELL
+} TreeRegion;
+
+static const char *regionStrings[] = {
+ "nothing", "heading", "separator", "tree", "cell", 0
+};
+
+static TreeRegion IdentifyRegion(Treeview *tv, int x, int y)
+{
+ int x1 = 0, colno;
+
+ colno = IdentifyDisplayColumn(tv, x, &x1);
+ if (Ttk_BoxContains(tv->tree.headingArea, x, y)) {
+ if (colno < 0) {
+ return REGION_NOTHING;
+ } else if (-HALO <= x1 - x && x1 - x <= HALO) {
+ return REGION_SEPARATOR;
+ } else {
+ return REGION_HEADING;
+ }
+ } else if (Ttk_BoxContains(tv->tree.treeArea, x, y)) {
+ TreeItem *item = IdentifyItem(tv, y);
+ if (item && colno > 0) {
+ return REGION_CELL;
+ } else if (item) {
+ return REGION_TREE;
+ }
+ }
+ return REGION_NOTHING;
+}
+
+/*------------------------------------------------------------------------
+ * +++ Display routines.
+ */
+
+/* + GetSublayout --
+ * Utility routine; acquires a sublayout for items, cells, etc.
+ */
+static Ttk_Layout GetSublayout(
+ Tcl_Interp *interp,
+ Ttk_Theme themePtr,
+ Ttk_Layout parentLayout,
+ const char *layoutName,
+ Tk_OptionTable optionTable,
+ Ttk_Layout *layoutPtr)
+{
+ Ttk_Layout newLayout = Ttk_CreateSublayout(
+ interp, themePtr, parentLayout, layoutName, optionTable);
+
+ if (newLayout) {
+ if (*layoutPtr)
+ Ttk_FreeLayout(*layoutPtr);
+ *layoutPtr = newLayout;
+ }
+ return newLayout;
+}
+
+/* + TreeviewGetLayout --
+ * GetLayout() widget hook.
+ */
+static Ttk_Layout TreeviewGetLayout(
+ Tcl_Interp *interp, Ttk_Theme themePtr, void *recordPtr)
+{
+ Treeview *tv = recordPtr;
+ Ttk_Layout treeLayout = TtkWidgetGetLayout(interp, themePtr, recordPtr);
+ Tcl_Obj *objPtr;
+ int unused;
+
+ if (!(
+ treeLayout
+ && GetSublayout(interp, themePtr, treeLayout, ".Item",
+ tv->tree.tagOptionTable, &tv->tree.itemLayout)
+ && GetSublayout(interp, themePtr, treeLayout, ".Cell",
+ tv->tree.tagOptionTable, &tv->tree.cellLayout)
+ && GetSublayout(interp, themePtr, treeLayout, ".Heading",
+ tv->tree.headingOptionTable, &tv->tree.headingLayout)
+ && GetSublayout(interp, themePtr, treeLayout, ".Row",
+ tv->tree.tagOptionTable, &tv->tree.rowLayout)
+ )) {
+ return 0;
+ }
+
+ /* Compute heading height.
+ */
+ Ttk_RebindSublayout(tv->tree.headingLayout, &tv->tree.column0);
+ Ttk_LayoutSize(tv->tree.headingLayout, 0, &unused, &tv->tree.headingHeight);
+
+ /* Get item height, indent from style:
+ * @@@ TODO: sanity-check.
+ */
+ tv->tree.rowHeight = DEFAULT_ROWHEIGHT;
+ tv->tree.indent = DEFAULT_INDENT;
+ if ((objPtr = Ttk_QueryOption(treeLayout, "-rowheight", 0))) {
+ (void)Tcl_GetIntFromObj(NULL, objPtr, &tv->tree.rowHeight);
+ }
+ if ((objPtr = Ttk_QueryOption(treeLayout, "-indent", 0))) {
+ (void)Tcl_GetIntFromObj(NULL, objPtr, &tv->tree.indent);
+ }
+
+ return treeLayout;
+}
+
+/* + TreeviewDoLayout --
+ * DoLayout() widget hook. Computes widget layout.
+ *
+ * Side effects:
+ * Computes headingArea and treeArea.
+ * Computes subtree height.
+ * Invokes scroll callbacks.
+ */
+static void TreeviewDoLayout(void *clientData)
+{
+ Treeview *tv = clientData;
+ int visibleRows;
+
+ /* ASSERT: SLACKINVARIANT */
+
+ Ttk_PlaceLayout(tv->core.layout,tv->core.state,Ttk_WinBox(tv->core.tkwin));
+ tv->tree.treeArea = Ttk_ClientRegion(tv->core.layout, "treearea");
+
+ ResizeColumns(tv, tv->tree.treeArea.width);
+ /* ASSERT: SLACKINVARIANT */
+
+ TtkScrolled(tv->tree.xscrollHandle,
+ tv->tree.xscroll.first,
+ tv->tree.xscroll.first + tv->tree.treeArea.width,
+ TreeWidth(tv));
+
+ if (tv->tree.showFlags & SHOW_HEADINGS) {
+ tv->tree.headingArea = Ttk_PackBox(
+ &tv->tree.treeArea, 1, tv->tree.headingHeight, TTK_SIDE_TOP);
+ } else {
+ tv->tree.headingArea = Ttk_MakeBox(0,0,0,0);
+ }
+
+ visibleRows = tv->tree.treeArea.height / tv->tree.rowHeight;
+ tv->tree.root->state |= TTK_STATE_OPEN;
+ TtkScrolled(tv->tree.yscrollHandle,
+ tv->tree.yscroll.first,
+ tv->tree.yscroll.first + visibleRows,
+ CountRows(tv->tree.root) - 1);
+}
+
+/* + TreeviewSize --
+ * SizeProc() widget hook. Size is determined by
+ * -height option and column widths.
+ */
+static int TreeviewSize(void *clientData, int *widthPtr, int *heightPtr)
+{
+ Treeview *tv = clientData;
+ int nRows, padHeight, padWidth;
+
+ Ttk_LayoutSize(tv->core.layout, tv->core.state, &padWidth, &padHeight);
+ Tcl_GetIntFromObj(NULL, tv->tree.heightObj, &nRows);
+
+ *widthPtr = padWidth + TreeWidth(tv);
+ *heightPtr = padHeight + tv->tree.rowHeight * nRows;
+
+ if (tv->tree.showFlags & SHOW_HEADINGS) {
+ *heightPtr += tv->tree.headingHeight;
+ }
+
+ return 1;
+}
+
+/* + ItemState --
+ * Returns the state of the specified item, based
+ * on widget state, item state, and other information.
+ */
+static Ttk_State ItemState(Treeview *tv, TreeItem *item)
+{
+ Ttk_State state = tv->core.state | item->state;
+ if (!item->children)
+ state |= TTK_STATE_LEAF;
+ if (item != tv->tree.focus)
+ state &= ~TTK_STATE_FOCUS;
+ return state;
+}
+
+/* + DrawHeadings --
+ * Draw tree headings.
+ */
+static void DrawHeadings(Treeview *tv, Drawable d)
+{
+ const int x0 = tv->tree.headingArea.x - tv->tree.xscroll.first;
+ const int y0 = tv->tree.headingArea.y;
+ const int h0 = tv->tree.headingArea.height;
+ int i = FirstColumn(tv);
+ int x = 0;
+
+ while (i < tv->tree.nDisplayColumns) {
+ TreeColumn *column = tv->tree.displayColumns[i];
+ Ttk_Box parcel = Ttk_MakeBox(x0+x, y0, column->width, h0);
+ DisplayLayout(tv->tree.headingLayout,
+ column, column->headingState, parcel, d);
+ x += column->width;
+ ++i;
+ }
+}
+
+/* + PrepareItem --
+ * Fill in a displayItem record.
+ */
+static void PrepareItem(
+ Treeview *tv, TreeItem *item, DisplayItem *displayItem)
+{
+ Ttk_Style style = Ttk_LayoutStyle(tv->core.layout);
+ Ttk_State state = ItemState(tv, item);
+
+ Ttk_TagSetValues(tv->tree.tagTable, item->tagset, displayItem);
+ Ttk_TagSetApplyStyle(tv->tree.tagTable, style, state, displayItem);
+}
+
+/* + DrawCells --
+ * Draw data cells for specified item.
+ */
+static void DrawCells(
+ Treeview *tv, TreeItem *item, DisplayItem *displayItem,
+ Drawable d, int x, int y)
+{
+ Ttk_Layout layout = tv->tree.cellLayout;
+ Ttk_State state = ItemState(tv, item);
+ Ttk_Padding cellPadding = {4, 0, 4, 0};
+ int rowHeight = tv->tree.rowHeight;
+ int nValues = 0;
+ Tcl_Obj **values = 0;
+ int i;
+
+ if (!item->valuesObj) {
+ return;
+ }
+
+ Tcl_ListObjGetElements(NULL, item->valuesObj, &nValues, &values);
+ for (i = 0; i < tv->tree.nColumns; ++i) {
+ tv->tree.columns[i].data = (i < nValues) ? values[i] : 0;
+ }
+
+ for (i = 1; i < tv->tree.nDisplayColumns; ++i) {
+ TreeColumn *column = tv->tree.displayColumns[i];
+ Ttk_Box parcel = Ttk_PadBox(
+ Ttk_MakeBox(x, y, column->width, rowHeight), cellPadding);
+
+ displayItem->textObj = column->data;
+ displayItem->anchorObj = column->anchorObj; /* <<NOTE-ANCHOR>> */
+
+ DisplayLayout(layout, displayItem, state, parcel, d);
+ x += column->width;
+ }
+}
+
+/* + DrawItem --
+ * Draw an item (row background, tree label, and cells).
+ */
+static void DrawItem(
+ Treeview *tv, TreeItem *item, Drawable d, int depth, int row)
+{
+ Ttk_State state = ItemState(tv, item);
+ DisplayItem displayItem;
+ int rowHeight = tv->tree.rowHeight;
+ int x = tv->tree.treeArea.x - tv->tree.xscroll.first;
+ int y = tv->tree.treeArea.y + rowHeight * (row - tv->tree.yscroll.first);
+
+ if (row % 2) state |= TTK_STATE_ALTERNATE;
+
+ PrepareItem(tv, item, &displayItem);
+
+ /* Draw row background:
+ */
+ {
+ Ttk_Box rowBox = Ttk_MakeBox(x, y, TreeWidth(tv), rowHeight);
+ DisplayLayout(tv->tree.rowLayout, &displayItem, state, rowBox, d);
+ }
+
+ /* Draw tree label:
+ */
+ if (tv->tree.showFlags & SHOW_TREE) {
+ int indent = depth * tv->tree.indent;
+ int colwidth = tv->tree.column0.width;
+ Ttk_Box parcel = Ttk_MakeBox(
+ x+indent, y, colwidth-indent, rowHeight);
+ if (item->textObj) { displayItem.textObj = item->textObj; }
+ if (item->imageObj) { displayItem.imageObj = item->imageObj; }
+ /* ??? displayItem.anchorObj = 0; <<NOTE-ANCHOR>> */
+ DisplayLayout(tv->tree.itemLayout, &displayItem, state, parcel, d);
+ x += colwidth;
+ }
+
+ /* Draw data cells:
+ */
+ DrawCells(tv, item, &displayItem, d, x, y);
+}
+
+/* + DrawSubtree --
+ * Draw an item and all of its (viewable) descendants.
+ *
+ * Returns:
+ * Row number of the last item drawn.
+ */
+
+static int DrawForest( /* forward */
+ Treeview *tv, TreeItem *item, Drawable d, int depth, int row);
+
+static int DrawSubtree(
+ Treeview *tv, TreeItem *item, Drawable d, int depth, int row)
+{
+ if (row >= tv->tree.yscroll.first) {
+ DrawItem(tv, item, d, depth, row);
+ }
+
+ if (item->state & TTK_STATE_OPEN) {
+ return DrawForest(tv, item->children, d, depth + 1, row + 1);
+ } else {
+ return row + 1;
+ }
+}
+
+/* + DrawForest --
+ * Draw a sequence of items and their visible descendants.
+ *
+ * Returns:
+ * Row number of the last item drawn.
+ */
+static int DrawForest(
+ Treeview *tv, TreeItem *item, Drawable d, int depth, int row)
+{
+ while (item && row <= tv->tree.yscroll.last) {
+ row = DrawSubtree(tv, item, d, depth, row);
+ item = item->next;
+ }
+ return row;
+}
+
+/* + TreeviewDisplay --
+ * Display() widget hook. Draw the widget contents.
+ */
+static void TreeviewDisplay(void *clientData, Drawable d)
+{
+ Treeview *tv = clientData;
+
+ Ttk_DrawLayout(tv->core.layout, tv->core.state, d);
+ if (tv->tree.showFlags & SHOW_HEADINGS) {
+ DrawHeadings(tv, d);
+ }
+ DrawForest(tv, tv->tree.root->children, d, 0,0);
+}
+
+/*------------------------------------------------------------------------
+ * +++ Utilities for widget commands
+ */
+
+/* + InsertPosition --
+ * Locate the previous sibling for [$tree insert].
+ *
+ * Returns a pointer to the item just before the specified index,
+ * or 0 if the item is to be inserted at the beginning.
+ */
+static TreeItem *InsertPosition(TreeItem *parent, int index)
+{
+ TreeItem *prev = 0, *next = parent->children;
+
+ while (next != 0 && index > 0) {
+ --index;
+ prev = next;
+ next = prev->next;
+ }
+
+ return prev;
+}
+
+/* + EndPosition --
+ * Locate the last child of the specified node.
+ *
+ * To avoid quadratic-time behavior in the common cases
+ * where the treeview is populated in breadth-first or
+ * depth-first order using [$tv insert $parent end ...],
+ * we cache the result from the last call to EndPosition()
+ * and start the search from there on a cache hit.
+ *
+ */
+static TreeItem *EndPosition(Treeview *tv, TreeItem *parent)
+{
+ TreeItem *endPtr = tv->tree.endPtr;
+
+ while (endPtr && endPtr->parent != parent) {
+ endPtr = endPtr->parent;
+ }
+ if (!endPtr) {
+ endPtr = parent->children;
+ }
+
+ if (endPtr) {
+ while (endPtr->next) {
+ endPtr = endPtr->next;
+ }
+ tv->tree.endPtr = endPtr;
+ }
+
+ return endPtr;
+}
+
+/* + AncestryCheck --
+ * Verify that specified item is not an ancestor of the specified parent;
+ * returns 1 if OK, 0 and leaves an error message in interp otherwise.
+ */
+static int AncestryCheck(
+ Tcl_Interp *interp, Treeview *tv, TreeItem *item, TreeItem *parent)
+{
+ TreeItem *p = parent;
+ while (p) {
+ if (p == item) {
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "Cannot insert %s as descendant of %s",
+ ItemName(tv, item), ItemName(tv, parent)));
+ Tcl_SetErrorCode(interp, "TTK", "TREE", "ANCESTRY", NULL);
+ return 0;
+ }
+ p = p->parent;
+ }
+ return 1;
+}
+
+/* + DeleteItems --
+ * Remove an item and all of its descendants from the hash table
+ * and detach them from the tree; returns a linked list (chained
+ * along the ->next pointer) of deleted items.
+ */
+static TreeItem *DeleteItems(TreeItem *item, TreeItem *delq)
+{
+ if (item->entryPtr) {
+ DetachItem(item);
+ while (item->children) {
+ delq = DeleteItems(item->children, delq);
+ }
+ Tcl_DeleteHashEntry(item->entryPtr);
+ item->entryPtr = 0;
+ item->next = delq;
+ delq = item;
+ } /* else -- item has already been unlinked */
+ return delq;
+}
+
+/*------------------------------------------------------------------------
+ * +++ Widget commands -- item inquiry.
+ */
+
+/* + $tv children $item ?newchildren? --
+ * Return the list of children associated with $item
+ */
+static int TreeviewChildrenCommand(
+ void *recordPtr, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[])
+{
+ Treeview *tv = recordPtr;
+ TreeItem *item;
+ Tcl_Obj *result;
+
+ if (objc < 3 || objc > 4) {
+ Tcl_WrongNumArgs(interp, 2, objv, "item ?newchildren?");
+ return TCL_ERROR;
+ }
+ item = FindItem(interp, tv, objv[2]);
+ if (!item) {
+ return TCL_ERROR;
+ }
+
+ if (objc == 3) {
+ result = Tcl_NewListObj(0,0);
+ for (item = item->children; item; item = item->next) {
+ Tcl_ListObjAppendElement(interp, result, ItemID(tv, item));
+ }
+ Tcl_SetObjResult(interp, result);
+ } else {
+ TreeItem **newChildren = GetItemListFromObj(interp, tv, objv[3]);
+ TreeItem *child;
+ int i;
+
+ if (!newChildren)
+ return TCL_ERROR;
+
+ /* Sanity-check:
+ */
+ for (i=0; newChildren[i]; ++i) {
+ if (!AncestryCheck(interp, tv, newChildren[i], item)) {
+ ckfree(newChildren);
+ return TCL_ERROR;
+ }
+ }
+
+ /* Detach old children:
+ */
+ child = item->children;
+ while (child) {
+ TreeItem *next = child->next;
+ DetachItem(child);
+ child = next;
+ }
+
+ /* Detach new children from their current locations:
+ */
+ for (i=0; newChildren[i]; ++i) {
+ DetachItem(newChildren[i]);
+ }
+
+ /* Reinsert new children:
+ * Note: it is not an error for an item to be listed more than once,
+ * though it probably should be...
+ */
+ child = 0;
+ for (i=0; newChildren[i]; ++i) {
+ if (newChildren[i]->parent) {
+ /* This is a duplicate element which has already been
+ * inserted. Ignore it.
+ */
+ continue;
+ }
+ InsertItem(item, child, newChildren[i]);
+ child = newChildren[i];
+ }
+
+ ckfree(newChildren);
+ TtkRedisplayWidget(&tv->core);
+ }
+
+ return TCL_OK;
+}
+
+/* + $tv parent $item --
+ * Return the item ID of $item's parent.
+ */
+static int TreeviewParentCommand(
+ void *recordPtr, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[])
+{
+ Treeview *tv = recordPtr;
+ TreeItem *item;
+
+ if (objc != 3) {
+ Tcl_WrongNumArgs(interp, 2, objv, "item");
+ return TCL_ERROR;
+ }
+ item = FindItem(interp, tv, objv[2]);
+ if (!item) {
+ return TCL_ERROR;
+ }
+
+ if (item->parent) {
+ Tcl_SetObjResult(interp, ItemID(tv, item->parent));
+ } else {
+ /* This is the root item. @@@ Return an error? */
+ Tcl_ResetResult(interp);
+ }
+
+ return TCL_OK;
+}
+
+/* + $tv next $item
+ * Return the ID of $item's next sibling.
+ */
+static int TreeviewNextCommand(
+ void *recordPtr, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[])
+{
+ Treeview *tv = recordPtr;
+ TreeItem *item;
+
+ if (objc != 3) {
+ Tcl_WrongNumArgs(interp, 2, objv, "item");
+ return TCL_ERROR;
+ }
+ item = FindItem(interp, tv, objv[2]);
+ if (!item) {
+ return TCL_ERROR;
+ }
+
+ if (item->next) {
+ Tcl_SetObjResult(interp, ItemID(tv, item->next));
+ } /* else -- leave interp-result empty */
+
+ return TCL_OK;
+}
+
+/* + $tv prev $item
+ * Return the ID of $item's previous sibling.
+ */
+static int TreeviewPrevCommand(
+ void *recordPtr, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[])
+{
+ Treeview *tv = recordPtr;
+ TreeItem *item;
+
+ if (objc != 3) {
+ Tcl_WrongNumArgs(interp, 2, objv, "item");
+ return TCL_ERROR;
+ }
+ item = FindItem(interp, tv, objv[2]);
+ if (!item) {
+ return TCL_ERROR;
+ }
+
+ if (item->prev) {
+ Tcl_SetObjResult(interp, ItemID(tv, item->prev));
+ } /* else -- leave interp-result empty */
+
+ return TCL_OK;
+}
+
+/* + $tv index $item --
+ * Return the index of $item within its parent.
+ */
+static int TreeviewIndexCommand(
+ void *recordPtr, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[])
+{
+ Treeview *tv = recordPtr;
+ TreeItem *item;
+ int index = 0;
+
+ if (objc != 3) {
+ Tcl_WrongNumArgs(interp, 2, objv, "item");
+ return TCL_ERROR;
+ }
+ item = FindItem(interp, tv, objv[2]);
+ if (!item) {
+ return TCL_ERROR;
+ }
+
+ while (item->prev) {
+ ++index;
+ item = item->prev;
+ }
+
+ Tcl_SetObjResult(interp, Tcl_NewIntObj(index));
+ return TCL_OK;
+}
+
+/* + $tv exists $itemid --
+ * Test if the specified item id is present in the tree.
+ */
+static int TreeviewExistsCommand(
+ void *recordPtr, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[])
+{
+ Treeview *tv = recordPtr;
+ Tcl_HashEntry *entryPtr;
+
+ if (objc != 3) {
+ Tcl_WrongNumArgs(interp, 2, objv, "itemid");
+ return TCL_ERROR;
+ }
+
+ entryPtr = Tcl_FindHashEntry(&tv->tree.items, Tcl_GetString(objv[2]));
+ Tcl_SetObjResult(interp, Tcl_NewBooleanObj(entryPtr != 0));
+ return TCL_OK;
+}
+
+/* + $tv bbox $itemid ?$column? --
+ * Return bounding box [x y width height] of specified item.
+ */
+static int TreeviewBBoxCommand(
+ void *recordPtr, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[])
+{
+ Treeview *tv = recordPtr;
+ TreeItem *item = 0;
+ TreeColumn *column = 0;
+ Ttk_Box bbox;
+
+ if (objc < 3 || objc > 4) {
+ Tcl_WrongNumArgs(interp, 2, objv, "itemid ?column");
+ return TCL_ERROR;
+ }
+
+ item = FindItem(interp, tv, objv[2]);
+ if (!item) {
+ return TCL_ERROR;
+ }
+ if (objc >=4 && (column = FindColumn(interp,tv,objv[3])) == NULL) {
+ return TCL_ERROR;
+ }
+
+ if (BoundingBox(tv, item, column, &bbox)) {
+ Tcl_SetObjResult(interp, Ttk_NewBoxObj(bbox));
+ }
+
+ return TCL_OK;
+}
+
+/* + $tv identify $x $y -- (obsolescent)
+ * Implements the old, horrible, 2-argument form of [$tv identify].
+ *
+ * Returns: one of
+ * heading #n
+ * cell itemid #n
+ * item itemid element
+ * row itemid
+ */
+static int TreeviewHorribleIdentify(
+ Tcl_Interp *interp, int objc, Tcl_Obj *const objv[], Treeview *tv)
+{
+ const char *what = "nothing", *detail = NULL;
+ TreeItem *item = 0;
+ Tcl_Obj *result;
+ int dColumnNumber;
+ char dcolbuf[16];
+ int x, y, x1;
+
+ /* ASSERT: objc == 4 */
+
+ if ( Tcl_GetIntFromObj(interp, objv[2], &x) != TCL_OK
+ || Tcl_GetIntFromObj(interp, objv[3], &y) != TCL_OK
+ ) {
+ return TCL_ERROR;
+ }
+
+ dColumnNumber = IdentifyDisplayColumn(tv, x, &x1);
+ if (dColumnNumber < 0) {
+ goto done;
+ }
+ sprintf(dcolbuf, "#%d", dColumnNumber);
+
+ if (Ttk_BoxContains(tv->tree.headingArea,x,y)) {
+ if (-HALO <= x1 - x && x1 - x <= HALO) {
+ what = "separator";
+ } else {
+ what = "heading";
+ }
+ detail = dcolbuf;
+ } else if (Ttk_BoxContains(tv->tree.treeArea,x,y)) {
+ item = IdentifyItem(tv, y);
+ if (item && dColumnNumber > 0) {
+ what = "cell";
+ detail = dcolbuf;
+ } else if (item) {
+ Ttk_Layout layout = tv->tree.itemLayout;
+ Ttk_Box itemBox;
+ DisplayItem displayItem;
+ Ttk_Element element;
+
+ BoundingBox(tv, item, NULL, &itemBox);
+ PrepareItem(tv, item, &displayItem); /*@@@ FIX: -text, etc*/
+ Ttk_RebindSublayout(layout, &displayItem);
+ Ttk_PlaceLayout(layout, ItemState(tv,item), itemBox);
+ element = Ttk_IdentifyElement(layout, x, y);
+
+ if (element) {
+ what = "item";
+ detail = Ttk_ElementName(element);
+ } else {
+ what = "row";
+ }
+ }
+ }
+
+done:
+ result = Tcl_NewListObj(0,0);
+ Tcl_ListObjAppendElement(NULL, result, Tcl_NewStringObj(what, -1));
+ if (item)
+ Tcl_ListObjAppendElement(NULL, result, ItemID(tv, item));
+ if (detail)
+ Tcl_ListObjAppendElement(NULL, result, Tcl_NewStringObj(detail, -1));
+
+ Tcl_SetObjResult(interp, result);
+ return TCL_OK;
+}
+
+/* + $tv identify $component $x $y --
+ * Identify the component at position x,y.
+ */
+
+static int TreeviewIdentifyCommand(
+ void *recordPtr, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[])
+{
+ static const char *submethodStrings[] =
+ { "region", "item", "column", "row", "element", NULL };
+ enum { I_REGION, I_ITEM, I_COLUMN, I_ROW, I_ELEMENT };
+
+ Treeview *tv = recordPtr;
+ int submethod;
+ int x, y;
+
+ TreeRegion region;
+ Ttk_Box bbox;
+ TreeItem *item;
+ TreeColumn *column = 0;
+ int colno, x1;
+
+ if (objc == 4) { /* Old form */
+ return TreeviewHorribleIdentify(interp, objc, objv, tv);
+ } else if (objc != 5) {
+ Tcl_WrongNumArgs(interp, 2, objv, "command x y");
+ return TCL_ERROR;
+ }
+
+ if (Tcl_GetIndexFromObjStruct(interp, objv[2], submethodStrings,
+ sizeof(char *), "command", TCL_EXACT, &submethod) != TCL_OK
+ || Tcl_GetIntFromObj(interp, objv[3], &x) != TCL_OK
+ || Tcl_GetIntFromObj(interp, objv[4], &y) != TCL_OK
+ ) {
+ return TCL_ERROR;
+ }
+
+ region = IdentifyRegion(tv, x, y);
+ item = IdentifyItem(tv, y);
+ colno = IdentifyDisplayColumn(tv, x, &x1);
+ column = (colno >= 0) ? tv->tree.displayColumns[colno] : NULL;
+
+ switch (submethod)
+ {
+ case I_REGION :
+ Tcl_SetObjResult(interp,Tcl_NewStringObj(regionStrings[region],-1));
+ break;
+
+ case I_ITEM :
+ case I_ROW :
+ if (item) {
+ Tcl_SetObjResult(interp, ItemID(tv, item));
+ }
+ break;
+
+ case I_COLUMN :
+ if (colno >= 0) {
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf("#%d", colno));
+ }
+ break;
+
+ case I_ELEMENT :
+ {
+ Ttk_Layout layout = 0;
+ DisplayItem displayItem;
+ Ttk_Element element;
+
+ switch (region) {
+ case REGION_NOTHING:
+ layout = tv->core.layout;
+ return TCL_OK; /* @@@ NYI */
+ case REGION_HEADING:
+ case REGION_SEPARATOR:
+ layout = tv->tree.headingLayout;
+ return TCL_OK; /* @@@ NYI */
+ case REGION_TREE:
+ layout = tv->tree.itemLayout;
+ break;
+ case REGION_CELL:
+ layout = tv->tree.cellLayout;
+ break;
+ }
+
+ if (!BoundingBox(tv, item, column, &bbox)) {
+ return TCL_OK;
+ }
+
+ PrepareItem(tv, item, &displayItem); /*@@@ FIX: fill in -text,etc */
+ Ttk_RebindSublayout(layout, &displayItem);
+ Ttk_PlaceLayout(layout, ItemState(tv,item), bbox);
+ element = Ttk_IdentifyElement(layout, x, y);
+
+ if (element) {
+ const char *elementName = Ttk_ElementName(element);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(elementName, -1));
+ }
+ break;
+ }
+ }
+ return TCL_OK;
+}
+
+/*------------------------------------------------------------------------
+ * +++ Widget commands -- item and column configuration.
+ */
+
+/* + $tv item $item ?options ....?
+ * Query or configure item options.
+ */
+static int TreeviewItemCommand(
+ void *recordPtr, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[])
+{
+ Treeview *tv = recordPtr;
+ TreeItem *item;
+
+ if (objc < 3) {
+ Tcl_WrongNumArgs(interp, 2, objv, "item ?option ?value??...");
+ return TCL_ERROR;
+ }
+ if (!(item = FindItem(interp, tv, objv[2]))) {
+ return TCL_ERROR;
+ }
+
+ if (objc == 3) {
+ return TtkEnumerateOptions(interp, item, ItemOptionSpecs,
+ tv->tree.itemOptionTable, tv->core.tkwin);
+ } else if (objc == 4) {
+ return TtkGetOptionValue(interp, item, objv[3],
+ tv->tree.itemOptionTable, tv->core.tkwin);
+ } else {
+ return ConfigureItem(interp, tv, item, objc-3, objv+3);
+ }
+}
+
+/* + $tv column column ?options ....?
+ * Column data accessor
+ */
+static int TreeviewColumnCommand(
+ void *recordPtr, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[])
+{
+ Treeview *tv = recordPtr;
+ TreeColumn *column;
+
+ if (objc < 3) {
+ Tcl_WrongNumArgs(interp, 2, objv, "column -option value...");
+ return TCL_ERROR;
+ }
+ if (!(column = FindColumn(interp, tv, objv[2]))) {
+ return TCL_ERROR;
+ }
+
+ if (objc == 3) {
+ return TtkEnumerateOptions(interp, column, ColumnOptionSpecs,
+ tv->tree.columnOptionTable, tv->core.tkwin);
+ } else if (objc == 4) {
+ return TtkGetOptionValue(interp, column, objv[3],
+ tv->tree.columnOptionTable, tv->core.tkwin);
+ } else {
+ return ConfigureColumn(interp, tv, column, objc-3, objv+3);
+ }
+}
+
+/* + $tv heading column ?options ....?
+ * Heading data accessor
+ */
+static int TreeviewHeadingCommand(
+ void *recordPtr, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[])
+{
+ Treeview *tv = recordPtr;
+ Tk_OptionTable optionTable = tv->tree.headingOptionTable;
+ Tk_Window tkwin = tv->core.tkwin;
+ TreeColumn *column;
+
+ if (objc < 3) {
+ Tcl_WrongNumArgs(interp, 2, objv, "column -option value...");
+ return TCL_ERROR;
+ }
+ if (!(column = FindColumn(interp, tv, objv[2]))) {
+ return TCL_ERROR;
+ }
+
+ if (objc == 3) {
+ return TtkEnumerateOptions(
+ interp, column, HeadingOptionSpecs, optionTable, tkwin);
+ } else if (objc == 4) {
+ return TtkGetOptionValue(
+ interp, column, objv[3], optionTable, tkwin);
+ } else {
+ return ConfigureHeading(interp, tv, column, objc-3,objv+3);
+ }
+}
+
+/* + $tv set $item ?$column ?value??
+ * Query or configure cell values
+ */
+static int TreeviewSetCommand(
+ void *recordPtr, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[])
+{
+ Treeview *tv = recordPtr;
+ TreeItem *item;
+ TreeColumn *column;
+ int columnNumber;
+
+ if (objc < 3 || objc > 5) {
+ Tcl_WrongNumArgs(interp, 2, objv, "item ?column ?value??");
+ return TCL_ERROR;
+ }
+ if (!(item = FindItem(interp, tv, objv[2])))
+ return TCL_ERROR;
+
+ /* Make sure -values exists:
+ */
+ if (!item->valuesObj) {
+ item->valuesObj = Tcl_NewListObj(0,0);
+ Tcl_IncrRefCount(item->valuesObj);
+ }
+
+ if (objc == 3) {
+ /* Return dictionary:
+ */
+ Tcl_Obj *result = Tcl_NewListObj(0,0);
+ Tcl_Obj *value;
+ for (columnNumber=0; columnNumber<tv->tree.nColumns; ++columnNumber) {
+ Tcl_ListObjIndex(interp, item->valuesObj, columnNumber, &value);
+ if (value) {
+ Tcl_ListObjAppendElement(NULL, result,
+ tv->tree.columns[columnNumber].idObj);
+ Tcl_ListObjAppendElement(NULL, result, value);
+ }
+ }
+ Tcl_SetObjResult(interp, result);
+ return TCL_OK;
+ }
+
+ /* else -- get or set column
+ */
+ if (!(column = FindColumn(interp, tv, objv[3])))
+ return TCL_ERROR;
+
+ if (column == &tv->tree.column0) {
+ /* @@@ Maybe set -text here instead? */
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "Display column #0 cannot be set", -1));
+ Tcl_SetErrorCode(interp, "TTK", "TREE", "COLUMN_0", NULL);
+ return TCL_ERROR;
+ }
+
+ /* Note: we don't do any error checking in the list operations,
+ * since item->valuesObj is guaranteed to be a list.
+ */
+ columnNumber = column - tv->tree.columns;
+
+ if (objc == 4) { /* get column */
+ Tcl_Obj *result = 0;
+ Tcl_ListObjIndex(interp, item->valuesObj, columnNumber, &result);
+ if (!result) {
+ result = Tcl_NewStringObj("",0);
+ }
+ Tcl_SetObjResult(interp, result);
+ return TCL_OK;
+ } else { /* set column */
+ int length;
+
+ item->valuesObj = unshareObj(item->valuesObj);
+
+ /* Make sure -values is fully populated:
+ */
+ Tcl_ListObjLength(interp, item->valuesObj, &length);
+ while (length < tv->tree.nColumns) {
+ Tcl_Obj *empty = Tcl_NewStringObj("",0);
+ Tcl_ListObjAppendElement(interp, item->valuesObj, empty);
+ ++length;
+ }
+
+ /* Set value:
+ */
+ Tcl_ListObjReplace(interp,item->valuesObj,columnNumber,1,1,objv+4);
+ TtkRedisplayWidget(&tv->core);
+ return TCL_OK;
+ }
+}
+
+/*------------------------------------------------------------------------
+ * +++ Widget commands -- tree modification.
+ */
+
+/* + $tv insert $parent $index ?-id id? ?-option value ...?
+ * Insert a new item.
+ */
+static int TreeviewInsertCommand(
+ void *recordPtr, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[])
+{
+ Treeview *tv = recordPtr;
+ TreeItem *parent, *sibling, *newItem;
+ Tcl_HashEntry *entryPtr;
+ int isNew;
+
+ if (objc < 4) {
+ Tcl_WrongNumArgs(interp, 2, objv, "parent index ?-id id? -options...");
+ return TCL_ERROR;
+ }
+
+ /* Get parent node:
+ */
+ if ((parent = FindItem(interp, tv, objv[2])) == NULL) {
+ return TCL_ERROR;
+ }
+
+ /* Locate previous sibling based on $index:
+ */
+ if (!strcmp(Tcl_GetString(objv[3]), "end")) {
+ sibling = EndPosition(tv, parent);
+ } else {
+ int index;
+ if (Tcl_GetIntFromObj(interp, objv[3], &index) != TCL_OK)
+ return TCL_ERROR;
+ sibling = InsertPosition(parent, index);
+ }
+
+ /* Get node name:
+ * If -id supplied and does not already exist, use that;
+ * Otherwise autogenerate new one.
+ */
+ objc -= 4; objv += 4;
+ if (objc >= 2 && !strcmp("-id", Tcl_GetString(objv[0]))) {
+ const char *itemName = Tcl_GetString(objv[1]);
+
+ entryPtr = Tcl_CreateHashEntry(&tv->tree.items, itemName, &isNew);
+ if (!isNew) {
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "Item %s already exists", itemName));
+ Tcl_SetErrorCode(interp, "TTK", "TREE", "ITEM_EXISTS", NULL);
+ return TCL_ERROR;
+ }
+ objc -= 2; objv += 2;
+ } else {
+ char idbuf[16];
+ do {
+ ++tv->tree.serial;
+ sprintf(idbuf, "I%03X", tv->tree.serial);
+ entryPtr = Tcl_CreateHashEntry(&tv->tree.items, idbuf, &isNew);
+ } while (!isNew);
+ }
+
+ /* Create and configure new item:
+ */
+ newItem = NewItem();
+ Tk_InitOptions(
+ interp, (ClientData)newItem, tv->tree.itemOptionTable, tv->core.tkwin);
+ newItem->tagset = Ttk_GetTagSetFromObj(NULL, tv->tree.tagTable, NULL);
+ if (ConfigureItem(interp, tv, newItem, objc, objv) != TCL_OK) {
+ Tcl_DeleteHashEntry(entryPtr);
+ FreeItem(newItem);
+ return TCL_ERROR;
+ }
+
+ /* Store in hash table, link into tree:
+ */
+ Tcl_SetHashValue(entryPtr, newItem);
+ newItem->entryPtr = entryPtr;
+ InsertItem(parent, sibling, newItem);
+ TtkRedisplayWidget(&tv->core);
+
+ Tcl_SetObjResult(interp, ItemID(tv, newItem));
+ return TCL_OK;
+}
+
+/* + $tv detach $item --
+ * Unlink $item from the tree.
+ */
+static int TreeviewDetachCommand(
+ void *recordPtr, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[])
+{
+ Treeview *tv = recordPtr;
+ TreeItem **items;
+ int i;
+
+ if (objc != 3) {
+ Tcl_WrongNumArgs(interp, 2, objv, "item");
+ return TCL_ERROR;
+ }
+ if (!(items = GetItemListFromObj(interp, tv, objv[2]))) {
+ return TCL_ERROR;
+ }
+
+ /* Sanity-check */
+ for (i = 0; items[i]; ++i) {
+ if (items[i] == tv->tree.root) {
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "Cannot detach root item", -1));
+ Tcl_SetErrorCode(interp, "TTK", "TREE", "ROOT", NULL);
+ ckfree(items);
+ return TCL_ERROR;
+ }
+ }
+
+ for (i = 0; items[i]; ++i) {
+ DetachItem(items[i]);
+ }
+
+ TtkRedisplayWidget(&tv->core);
+ ckfree(items);
+ return TCL_OK;
+}
+
+/* + $tv delete $items --
+ * Delete each item in $items.
+ *
+ * Do this in two passes:
+ * First detach the item and all its descendants and remove them
+ * from the hash table. Free the items themselves in a second pass.
+ *
+ * It's done this way because an item may appear more than once
+ * in the list of items to delete (either directly or as a descendant
+ * of a previously deleted item.)
+ */
+
+static int TreeviewDeleteCommand(
+ void *recordPtr, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[])
+{
+ Treeview *tv = recordPtr;
+ TreeItem **items, *delq;
+ int i;
+
+ if (objc != 3) {
+ Tcl_WrongNumArgs(interp, 2, objv, "items");
+ return TCL_ERROR;
+ }
+
+ if (!(items = GetItemListFromObj(interp, tv, objv[2]))) {
+ return TCL_ERROR;
+ }
+
+ /* Sanity-check:
+ */
+ for (i=0; items[i]; ++i) {
+ if (items[i] == tv->tree.root) {
+ ckfree(items);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "Cannot delete root item", -1));
+ Tcl_SetErrorCode(interp, "TTK", "TREE", "ROOT", NULL);
+ return TCL_ERROR;
+ }
+ }
+
+ /* Remove items from hash table.
+ */
+ delq = 0;
+ for (i=0; items[i]; ++i) {
+ delq = DeleteItems(items[i], delq);
+ }
+
+ /* Free items:
+ */
+ while (delq) {
+ TreeItem *next = delq->next;
+ if (tv->tree.focus == delq)
+ tv->tree.focus = 0;
+ if (tv->tree.endPtr == delq)
+ tv->tree.endPtr = 0;
+ FreeItem(delq);
+ delq = next;
+ }
+
+ ckfree(items);
+ TtkRedisplayWidget(&tv->core);
+ return TCL_OK;
+}
+
+/* + $tv move $item $parent $index
+ * Move $item to the specified $index in $parent's child list.
+ */
+static int TreeviewMoveCommand(
+ void *recordPtr, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[])
+{
+ Treeview *tv = recordPtr;
+ TreeItem *item, *parent;
+ TreeItem *sibling;
+
+ if (objc != 5) {
+ Tcl_WrongNumArgs(interp, 2, objv, "item parent index");
+ return TCL_ERROR;
+ }
+ if ( (item = FindItem(interp, tv, objv[2])) == 0
+ || (parent = FindItem(interp, tv, objv[3])) == 0)
+ {
+ return TCL_ERROR;
+ }
+
+ /* Locate previous sibling based on $index:
+ */
+ if (!strcmp(Tcl_GetString(objv[4]), "end")) {
+ sibling = EndPosition(tv, parent);
+ } else {
+ TreeItem *p;
+ int index;
+
+ if (Tcl_GetIntFromObj(interp, objv[4], &index) != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ sibling = 0;
+ for (p = parent->children; p != NULL && index > 0; p = p->next) {
+ if (p != item) {
+ --index;
+ } /* else -- moving node forward, count index+1 nodes */
+ sibling = p;
+ }
+ }
+
+ /* Check ancestry:
+ */
+ if (!AncestryCheck(interp, tv, item, parent)) {
+ return TCL_ERROR;
+ }
+
+ /* Moving an item after itself is a no-op:
+ */
+ if (item == sibling) {
+ return TCL_OK;
+ }
+
+ /* Move item:
+ */
+ DetachItem(item);
+ InsertItem(parent, sibling, item);
+
+ TtkRedisplayWidget(&tv->core);
+ return TCL_OK;
+}
+
+/*------------------------------------------------------------------------
+ * +++ Widget commands -- scrolling
+ */
+
+static int TreeviewXViewCommand(
+ void *recordPtr, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[])
+{
+ Treeview *tv = recordPtr;
+ return TtkScrollviewCommand(interp, objc, objv, tv->tree.xscrollHandle);
+}
+
+static int TreeviewYViewCommand(
+ void *recordPtr, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[])
+{
+ Treeview *tv = recordPtr;
+ return TtkScrollviewCommand(interp, objc, objv, tv->tree.yscrollHandle);
+}
+
+/* $tree see $item --
+ * Ensure that $item is visible.
+ */
+static int TreeviewSeeCommand(
+ void *recordPtr, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[])
+{
+ Treeview *tv = recordPtr;
+ TreeItem *item, *parent;
+ int rowNumber;
+
+ if (objc != 3) {
+ Tcl_WrongNumArgs(interp, 2, objv, "item");
+ return TCL_ERROR;
+ }
+ if (!(item = FindItem(interp, tv, objv[2]))) {
+ return TCL_ERROR;
+ }
+
+ /* Make sure all ancestors are open:
+ */
+ for (parent = item->parent; parent; parent = parent->parent) {
+ if (!(parent->state & TTK_STATE_OPEN)) {
+ parent->openObj = unshareObj(parent->openObj);
+ Tcl_SetBooleanObj(parent->openObj, 1);
+ parent->state |= TTK_STATE_OPEN;
+ TtkRedisplayWidget(&tv->core);
+ }
+ }
+ tv->tree.yscroll.total = CountRows(tv->tree.root) - 1;
+
+ /* Make sure item is visible:
+ */
+ rowNumber = RowNumber(tv, item);
+ if (rowNumber < tv->tree.yscroll.first) {
+ TtkScrollTo(tv->tree.yscrollHandle, rowNumber);
+ } else if (rowNumber >= tv->tree.yscroll.last) {
+ TtkScrollTo(tv->tree.yscrollHandle,
+ tv->tree.yscroll.first + (1+rowNumber - tv->tree.yscroll.last));
+ }
+
+ return TCL_OK;
+}
+
+/*------------------------------------------------------------------------
+ * +++ Widget commands -- interactive column resize
+ */
+
+/* + $tree drag $column $newX --
+ * Set right edge of display column $column to x position $X
+ */
+static int TreeviewDragCommand(
+ void *recordPtr, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[])
+{
+ Treeview *tv = recordPtr;
+ int left = tv->tree.treeArea.x - tv->tree.xscroll.first;
+ int i = FirstColumn(tv);
+ TreeColumn *column;
+ int newx;
+
+ if (objc != 4) {
+ Tcl_WrongNumArgs(interp, 2, objv, "column xposition");
+ return TCL_ERROR;
+ }
+
+ if ( (column = FindColumn(interp, tv, objv[2])) == 0
+ || Tcl_GetIntFromObj(interp, objv[3], &newx) != TCL_OK)
+ {
+ return TCL_ERROR;
+ }
+
+ for (;i < tv->tree.nDisplayColumns; ++i) {
+ TreeColumn *c = tv->tree.displayColumns[i];
+ int right = left + c->width;
+ if (c == column) {
+ DragColumn(tv, i, newx - right);
+ /* ASSERT: SLACKINVARIANT */
+ TtkRedisplayWidget(&tv->core);
+ return TCL_OK;
+ }
+ left = right;
+ }
+
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "column %s is not displayed", Tcl_GetString(objv[2])));
+ Tcl_SetErrorCode(interp, "TTK", "TREE", "COLUMN_INVISIBLE", NULL);
+ return TCL_ERROR;
+}
+
+/*------------------------------------------------------------------------
+ * +++ Widget commands -- focus and selection
+ */
+
+/* + $tree focus ?item?
+ */
+static int TreeviewFocusCommand(
+ void *recordPtr, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[])
+{
+ Treeview *tv = recordPtr;
+
+ if (objc == 2) {
+ if (tv->tree.focus) {
+ Tcl_SetObjResult(interp, ItemID(tv, tv->tree.focus));
+ }
+ return TCL_OK;
+ } else if (objc == 3) {
+ TreeItem *newFocus = FindItem(interp, tv, objv[2]);
+ if (!newFocus)
+ return TCL_ERROR;
+ tv->tree.focus = newFocus;
+ TtkRedisplayWidget(&tv->core);
+ return TCL_OK;
+ } else {
+ Tcl_WrongNumArgs(interp, 2, objv, "?newFocus?");
+ return TCL_ERROR;
+ }
+}
+
+/* + $tree selection ?add|remove|set|toggle $items?
+ */
+static int TreeviewSelectionCommand(
+ void *recordPtr, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[])
+{
+ enum {
+ SELECTION_SET, SELECTION_ADD, SELECTION_REMOVE, SELECTION_TOGGLE
+ };
+ static const char *selopStrings[] = {
+ "set", "add", "remove", "toggle", NULL
+ };
+
+ Treeview *tv = recordPtr;
+ int selop, i;
+ TreeItem *item, **items;
+
+ if (objc == 2) {
+ Tcl_Obj *result = Tcl_NewListObj(0,0);
+ for (item = tv->tree.root->children; item; item=NextPreorder(item)) {
+ if (item->state & TTK_STATE_SELECTED)
+ Tcl_ListObjAppendElement(NULL, result, ItemID(tv, item));
+ }
+ Tcl_SetObjResult(interp, result);
+ return TCL_OK;
+ }
+
+ if (objc != 4) {
+ Tcl_WrongNumArgs(interp, 2, objv, "?add|remove|set|toggle items?");
+ return TCL_ERROR;
+ }
+
+ if (Tcl_GetIndexFromObjStruct(interp, objv[2], selopStrings,
+ sizeof(char *), "selection operation", 0, &selop) != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ items = GetItemListFromObj(interp, tv, objv[3]);
+ if (!items) {
+ return TCL_ERROR;
+ }
+
+ switch (selop)
+ {
+ case SELECTION_SET:
+ for (item=tv->tree.root; item; item=NextPreorder(item)) {
+ item->state &= ~TTK_STATE_SELECTED;
+ }
+ /*FALLTHRU*/
+ case SELECTION_ADD:
+ for (i=0; items[i]; ++i) {
+ items[i]->state |= TTK_STATE_SELECTED;
+ }
+ break;
+ case SELECTION_REMOVE:
+ for (i=0; items[i]; ++i) {
+ items[i]->state &= ~TTK_STATE_SELECTED;
+ }
+ break;
+ case SELECTION_TOGGLE:
+ for (i=0; items[i]; ++i) {
+ items[i]->state ^= TTK_STATE_SELECTED;
+ }
+ break;
+ }
+
+ ckfree(items);
+ TtkSendVirtualEvent(tv->core.tkwin, "TreeviewSelect");
+ TtkRedisplayWidget(&tv->core);
+
+ return TCL_OK;
+}
+
+/*------------------------------------------------------------------------
+ * +++ Widget commands -- tags and bindings.
+ */
+
+/* + $tv tag bind $tag ?$sequence ?$script??
+ */
+static int TreeviewTagBindCommand(
+ void *recordPtr, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[])
+{
+ Treeview *tv = recordPtr;
+ Ttk_TagTable tagTable = tv->tree.tagTable;
+ Tk_BindingTable bindingTable = tv->tree.bindingTable;
+ Ttk_Tag tag;
+
+ if (objc < 4 || objc > 6) {
+ Tcl_WrongNumArgs(interp, 3, objv, "tagName ?sequence? ?script?");
+ return TCL_ERROR;
+ }
+
+ tag = Ttk_GetTagFromObj(tagTable, objv[3]);
+ if (!tag) { return TCL_ERROR; }
+
+ if (objc == 4) { /* $tv tag bind $tag */
+ Tk_GetAllBindings(interp, bindingTable, tag);
+ } else if (objc == 5) { /* $tv tag bind $tag $sequence */
+ /* TODO: distinguish "no such binding" (OK) from "bad pattern" (ERROR)
+ */
+ const char *script = Tk_GetBinding(interp,
+ bindingTable, tag, Tcl_GetString(objv[4]));
+ if (script != NULL) {
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(script,-1));
+ }
+ } else if (objc == 6) { /* $tv tag bind $tag $sequence $script */
+ const char *sequence = Tcl_GetString(objv[4]);
+ const char *script = Tcl_GetString(objv[5]);
+
+ if (!*script) { /* Delete existing binding */
+ Tk_DeleteBinding(interp, bindingTable, tag, sequence);
+ } else {
+ unsigned long mask = Tk_CreateBinding(interp,
+ bindingTable, tag, sequence, script, 0);
+
+ /* Test mask to make sure event is supported:
+ */
+ if (mask & (~TreeviewBindEventMask)) {
+ Tk_DeleteBinding(interp, bindingTable, tag, sequence);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "unsupported event %s\nonly key, button, motion, and"
+ " virtual events supported", sequence));
+ Tcl_SetErrorCode(interp, "TTK", "TREE", "BIND_EVENTS", NULL);
+ return TCL_ERROR;
+ }
+ }
+ }
+ return TCL_OK;
+}
+
+/* + $tv tag configure $tag ?-option ?value -option value...??
+ */
+static int TreeviewTagConfigureCommand(
+ void *recordPtr, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[])
+{
+ Treeview *tv = recordPtr;
+ Ttk_TagTable tagTable = tv->tree.tagTable;
+ Ttk_Tag tag;
+
+ if (objc < 4) {
+ Tcl_WrongNumArgs(interp, 3, objv, "tagName ?-option ?value ...??");
+ return TCL_ERROR;
+ }
+
+ tag = Ttk_GetTagFromObj(tagTable, objv[3]);
+
+ if (objc == 4) {
+ return Ttk_EnumerateTagOptions(interp, tagTable, tag);
+ } else if (objc == 5) {
+ Tcl_Obj *result = Ttk_TagOptionValue(interp, tagTable, tag, objv[4]);
+ if (result) {
+ Tcl_SetObjResult(interp, result);
+ return TCL_OK;
+ } /* else */
+ return TCL_ERROR;
+ }
+ /* else */
+ TtkRedisplayWidget(&tv->core);
+ return Ttk_ConfigureTag(interp, tagTable, tag, objc - 4, objv + 4);
+}
+
+/* + $tv tag has $tag ?$item?
+ */
+static int TreeviewTagHasCommand(
+ void *recordPtr, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[])
+{
+ Treeview *tv = recordPtr;
+
+ if (objc == 4) { /* Return list of all items with tag */
+ Ttk_Tag tag = Ttk_GetTagFromObj(tv->tree.tagTable, objv[3]);
+ TreeItem *item = tv->tree.root;
+ Tcl_Obj *result = Tcl_NewListObj(0,0);
+
+ while (item) {
+ if (Ttk_TagSetContains(item->tagset, tag)) {
+ Tcl_ListObjAppendElement(NULL, result, ItemID(tv, item));
+ }
+ item = NextPreorder(item);
+ }
+
+ Tcl_SetObjResult(interp, result);
+ return TCL_OK;
+ } else if (objc == 5) { /* Test if item has specified tag */
+ Ttk_Tag tag = Ttk_GetTagFromObj(tv->tree.tagTable, objv[3]);
+ TreeItem *item = FindItem(interp, tv, objv[4]);
+ if (!item) {
+ return TCL_ERROR;
+ }
+ Tcl_SetObjResult(interp,
+ Tcl_NewBooleanObj(Ttk_TagSetContains(item->tagset, tag)));
+ return TCL_OK;
+ } else {
+ Tcl_WrongNumArgs(interp, 3, objv, "tagName ?item?");
+ return TCL_ERROR;
+ }
+}
+
+/* + $tv tag names $tag
+ */
+static int TreeviewTagNamesCommand(
+ void *recordPtr, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[])
+{
+ Treeview *tv = recordPtr;
+
+ if (objc != 3) {
+ Tcl_WrongNumArgs(interp, 3, objv, "");
+ return TCL_ERROR;
+ }
+
+ return Ttk_EnumerateTags(interp, tv->tree.tagTable);
+}
+
+/* + $tv tag add $tag $items
+ */
+static void AddTag(TreeItem *item, Ttk_Tag tag)
+{
+ if (Ttk_TagSetAdd(item->tagset, tag)) {
+ if (item->tagsObj) Tcl_DecrRefCount(item->tagsObj);
+ item->tagsObj = Ttk_NewTagSetObj(item->tagset);
+ Tcl_IncrRefCount(item->tagsObj);
+ }
+}
+
+static int TreeviewTagAddCommand(
+ void *recordPtr, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[])
+{
+ Treeview *tv = recordPtr;
+ Ttk_Tag tag;
+ TreeItem **items;
+ int i;
+
+ if (objc != 5) {
+ Tcl_WrongNumArgs(interp, 3, objv, "tagName items");
+ return TCL_ERROR;
+ }
+
+ tag = Ttk_GetTagFromObj(tv->tree.tagTable, objv[3]);
+ items = GetItemListFromObj(interp, tv, objv[4]);
+
+ if (!items) {
+ return TCL_ERROR;
+ }
+
+ for (i=0; items[i]; ++i) {
+ AddTag(items[i], tag);
+ }
+
+ TtkRedisplayWidget(&tv->core);
+
+ return TCL_OK;
+}
+
+/* + $tv tag remove $tag ?$items?
+ */
+static void RemoveTag(TreeItem *item, Ttk_Tag tag)
+{
+ if (Ttk_TagSetRemove(item->tagset, tag)) {
+ if (item->tagsObj) Tcl_DecrRefCount(item->tagsObj);
+ item->tagsObj = Ttk_NewTagSetObj(item->tagset);
+ Tcl_IncrRefCount(item->tagsObj);
+ }
+}
+
+static int TreeviewTagRemoveCommand(
+ void *recordPtr, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[])
+{
+ Treeview *tv = recordPtr;
+ Ttk_Tag tag;
+
+ if (objc < 4) {
+ Tcl_WrongNumArgs(interp, 3, objv, "tagName items");
+ return TCL_ERROR;
+ }
+
+ tag = Ttk_GetTagFromObj(tv->tree.tagTable, objv[3]);
+
+ if (objc == 5) {
+ TreeItem **items = GetItemListFromObj(interp, tv, objv[4]);
+ int i;
+
+ if (!items) {
+ return TCL_ERROR;
+ }
+ for (i=0; items[i]; ++i) {
+ RemoveTag(items[i], tag);
+ }
+ } else if (objc == 4) {
+ TreeItem *item = tv->tree.root;
+ while (item) {
+ RemoveTag(item, tag);
+ item=NextPreorder(item);
+ }
+ }
+
+ TtkRedisplayWidget(&tv->core);
+
+ return TCL_OK;
+}
+
+static const Ttk_Ensemble TreeviewTagCommands[] = {
+ { "add", TreeviewTagAddCommand,0 },
+ { "bind", TreeviewTagBindCommand,0 },
+ { "configure", TreeviewTagConfigureCommand,0 },
+ { "has", TreeviewTagHasCommand,0 },
+ { "names", TreeviewTagNamesCommand,0 },
+ { "remove", TreeviewTagRemoveCommand,0 },
+ { 0,0,0 }
+};
+
+/*------------------------------------------------------------------------
+ * +++ Widget commands record.
+ */
+static const Ttk_Ensemble TreeviewCommands[] = {
+ { "bbox", TreeviewBBoxCommand,0 },
+ { "children", TreeviewChildrenCommand,0 },
+ { "cget", TtkWidgetCgetCommand,0 },
+ { "column", TreeviewColumnCommand,0 },
+ { "configure", TtkWidgetConfigureCommand,0 },
+ { "delete", TreeviewDeleteCommand,0 },
+ { "detach", TreeviewDetachCommand,0 },
+ { "drag", TreeviewDragCommand,0 },
+ { "exists", TreeviewExistsCommand,0 },
+ { "focus", TreeviewFocusCommand,0 },
+ { "heading", TreeviewHeadingCommand,0 },
+ { "identify", TreeviewIdentifyCommand,0 },
+ { "index", TreeviewIndexCommand,0 },
+ { "instate", TtkWidgetInstateCommand,0 },
+ { "insert", TreeviewInsertCommand,0 },
+ { "item", TreeviewItemCommand,0 },
+ { "move", TreeviewMoveCommand,0 },
+ { "next", TreeviewNextCommand,0 },
+ { "parent", TreeviewParentCommand,0 },
+ { "prev", TreeviewPrevCommand,0 },
+ { "see", TreeviewSeeCommand,0 },
+ { "selection" , TreeviewSelectionCommand,0 },
+ { "set", TreeviewSetCommand,0 },
+ { "state", TtkWidgetStateCommand,0 },
+ { "tag", 0,TreeviewTagCommands },
+ { "xview", TreeviewXViewCommand,0 },
+ { "yview", TreeviewYViewCommand,0 },
+ { 0,0,0 }
+};
+
+/*------------------------------------------------------------------------
+ * +++ Widget definition.
+ */
+
+static WidgetSpec TreeviewWidgetSpec = {
+ "Treeview", /* className */
+ sizeof(Treeview), /* recordSize */
+ TreeviewOptionSpecs, /* optionSpecs */
+ TreeviewCommands, /* subcommands */
+ TreeviewInitialize, /* initializeProc */
+ TreeviewCleanup, /* cleanupProc */
+ TreeviewConfigure, /* configureProc */
+ TtkNullPostConfigure, /* postConfigureProc */
+ TreeviewGetLayout, /* getLayoutProc */
+ TreeviewSize, /* sizeProc */
+ TreeviewDoLayout, /* layoutProc */
+ TreeviewDisplay /* displayProc */
+};
+
+/*------------------------------------------------------------------------
+ * +++ Layout specifications.
+ */
+
+TTK_BEGIN_LAYOUT_TABLE(LayoutTable)
+
+TTK_LAYOUT("Treeview",
+ TTK_GROUP("Treeview.field", TTK_FILL_BOTH|TTK_BORDER,
+ TTK_GROUP("Treeview.padding", TTK_FILL_BOTH,
+ TTK_NODE("Treeview.treearea", TTK_FILL_BOTH))))
+
+TTK_LAYOUT("Item",
+ TTK_GROUP("Treeitem.padding", TTK_FILL_BOTH,
+ TTK_NODE("Treeitem.indicator", TTK_PACK_LEFT)
+ TTK_NODE("Treeitem.image", TTK_PACK_LEFT)
+ TTK_GROUP("Treeitem.focus", TTK_PACK_LEFT,
+ TTK_NODE("Treeitem.text", TTK_PACK_LEFT))))
+
+TTK_LAYOUT("Cell",
+ TTK_GROUP("Treedata.padding", TTK_FILL_BOTH,
+ TTK_NODE("Treeitem.text", TTK_FILL_BOTH)))
+
+TTK_LAYOUT("Heading",
+ TTK_NODE("Treeheading.cell", TTK_FILL_BOTH)
+ TTK_GROUP("Treeheading.border", TTK_FILL_BOTH,
+ TTK_GROUP("Treeheading.padding", TTK_FILL_BOTH,
+ TTK_NODE("Treeheading.image", TTK_PACK_RIGHT)
+ TTK_NODE("Treeheading.text", TTK_FILL_X))))
+
+TTK_LAYOUT("Row",
+ TTK_NODE("Treeitem.row", TTK_FILL_BOTH))
+
+TTK_END_LAYOUT_TABLE
+
+/*------------------------------------------------------------------------
+ * +++ Tree indicator element.
+ */
+
+typedef struct {
+ Tcl_Obj *colorObj;
+ Tcl_Obj *sizeObj;
+ Tcl_Obj *marginsObj;
+} TreeitemIndicator;
+
+static Ttk_ElementOptionSpec TreeitemIndicatorOptions[] = {
+ { "-foreground", TK_OPTION_COLOR,
+ Tk_Offset(TreeitemIndicator,colorObj), DEFAULT_FOREGROUND },
+ { "-indicatorsize", TK_OPTION_PIXELS,
+ Tk_Offset(TreeitemIndicator,sizeObj), "12" },
+ { "-indicatormargins", TK_OPTION_STRING,
+ Tk_Offset(TreeitemIndicator,marginsObj), "2 2 4 2" },
+ { NULL, 0, 0, NULL }
+};
+
+static void TreeitemIndicatorSize(
+ void *clientData, void *elementRecord, Tk_Window tkwin,
+ int *widthPtr, int *heightPtr, Ttk_Padding *paddingPtr)
+{
+ TreeitemIndicator *indicator = elementRecord;
+ Ttk_Padding margins;
+ int size = 0;
+
+ Ttk_GetPaddingFromObj(NULL, tkwin, indicator->marginsObj, &margins);
+ Tk_GetPixelsFromObj(NULL, tkwin, indicator->sizeObj, &size);
+
+ *widthPtr = size + Ttk_PaddingWidth(margins);
+ *heightPtr = size + Ttk_PaddingHeight(margins);
+}
+
+static void TreeitemIndicatorDraw(
+ void *clientData, void *elementRecord, Tk_Window tkwin,
+ Drawable d, Ttk_Box b, Ttk_State state)
+{
+ TreeitemIndicator *indicator = elementRecord;
+ ArrowDirection direction =
+ (state & TTK_STATE_OPEN) ? ARROW_DOWN : ARROW_RIGHT;
+ Ttk_Padding margins;
+ XColor *borderColor = Tk_GetColorFromObj(tkwin, indicator->colorObj);
+ XGCValues gcvalues; GC gc; unsigned mask;
+
+ if (state & TTK_STATE_LEAF) /* don't draw anything */
+ return;
+
+ Ttk_GetPaddingFromObj(NULL,tkwin,indicator->marginsObj,&margins);
+ b = Ttk_PadBox(b, margins);
+
+ gcvalues.foreground = borderColor->pixel;
+ gcvalues.line_width = 1;
+ mask = GCForeground | GCLineWidth;
+ gc = Tk_GetGC(tkwin, mask, &gcvalues);
+
+ TtkDrawArrow(Tk_Display(tkwin), d, gc, b, direction);
+
+ Tk_FreeGC(Tk_Display(tkwin), gc);
+}
+
+static Ttk_ElementSpec TreeitemIndicatorElementSpec = {
+ TK_STYLE_VERSION_2,
+ sizeof(TreeitemIndicator),
+ TreeitemIndicatorOptions,
+ TreeitemIndicatorSize,
+ TreeitemIndicatorDraw
+};
+
+/*------------------------------------------------------------------------
+ * +++ Row element.
+ */
+
+typedef struct {
+ Tcl_Obj *backgroundObj;
+ Tcl_Obj *rowNumberObj;
+} RowElement;
+
+static Ttk_ElementOptionSpec RowElementOptions[] = {
+ { "-background", TK_OPTION_COLOR,
+ Tk_Offset(RowElement,backgroundObj), DEFAULT_BACKGROUND },
+ { "-rownumber", TK_OPTION_INT,
+ Tk_Offset(RowElement,rowNumberObj), "0" },
+ { NULL, 0, 0, NULL }
+};
+
+static void RowElementDraw(
+ void *clientData, void *elementRecord, Tk_Window tkwin,
+ Drawable d, Ttk_Box b, Ttk_State state)
+{
+ RowElement *row = elementRecord;
+ XColor *color = Tk_GetColorFromObj(tkwin, row->backgroundObj);
+ GC gc = Tk_GCForColor(color, d);
+ XFillRectangle(Tk_Display(tkwin), d, gc,
+ b.x, b.y, b.width, b.height);
+}
+
+static Ttk_ElementSpec RowElementSpec = {
+ TK_STYLE_VERSION_2,
+ sizeof(RowElement),
+ RowElementOptions,
+ TtkNullElementSize,
+ RowElementDraw
+};
+
+/*------------------------------------------------------------------------
+ * +++ Initialisation.
+ */
+
+MODULE_SCOPE
+void TtkTreeview_Init(Tcl_Interp *interp)
+{
+ Ttk_Theme theme = Ttk_GetDefaultTheme(interp);
+
+ RegisterWidget(interp, "ttk::treeview", &TreeviewWidgetSpec);
+
+ Ttk_RegisterElement(interp, theme, "Treeitem.indicator",
+ &TreeitemIndicatorElementSpec, 0);
+ Ttk_RegisterElement(interp, theme, "Treeitem.row", &RowElementSpec, 0);
+ Ttk_RegisterElement(interp, theme, "Treeheading.cell", &RowElementSpec, 0);
+ Ttk_RegisterElement(interp, theme, "treearea", &ttkNullElementSpec, 0);
+
+ Ttk_RegisterLayouts(theme, LayoutTable);
+}
+
+/*EOF*/
diff --git a/tk8.6/generic/ttk/ttkWidget.c b/tk8.6/generic/ttk/ttkWidget.c
new file mode 100644
index 0000000..c50efc5
--- /dev/null
+++ b/tk8.6/generic/ttk/ttkWidget.c
@@ -0,0 +1,791 @@
+/*
+ * Copyright (c) 2003, Joe English
+ *
+ * Core widget utilities.
+ */
+
+#include <string.h>
+#include <tk.h>
+#include "ttkTheme.h"
+#include "ttkWidget.h"
+
+#ifdef MAC_OSX_TK
+#define TK_NO_DOUBLE_BUFFERING 1
+#endif
+
+/*------------------------------------------------------------------------
+ * +++ Internal helper routines.
+ */
+
+/* UpdateLayout --
+ * Call the widget's get-layout hook to recompute corePtr->layout.
+ * Returns TCL_OK if successful, returns TCL_ERROR and leaves
+ * the layout unchanged otherwise.
+ */
+static int UpdateLayout(Tcl_Interp *interp, WidgetCore *corePtr)
+{
+ Ttk_Theme themePtr = Ttk_GetCurrentTheme(interp);
+ Ttk_Layout newLayout =
+ corePtr->widgetSpec->getLayoutProc(interp, themePtr,corePtr);
+
+ if (newLayout) {
+ if (corePtr->layout) {
+ Ttk_FreeLayout(corePtr->layout);
+ }
+ corePtr->layout = newLayout;
+ return TCL_OK;
+ }
+ return TCL_ERROR;
+}
+
+/* SizeChanged --
+ * Call the widget's sizeProc to compute new requested size
+ * and pass it to the geometry manager.
+ */
+static void SizeChanged(WidgetCore *corePtr)
+{
+ int reqWidth = 1, reqHeight = 1;
+
+ if (corePtr->widgetSpec->sizeProc(corePtr,&reqWidth,&reqHeight)) {
+ Tk_GeometryRequest(corePtr->tkwin, reqWidth, reqHeight);
+ }
+}
+
+#ifndef TK_NO_DOUBLE_BUFFERING
+
+/* BeginDrawing --
+ * Returns a Drawable for drawing the widget contents.
+ * This is normally an off-screen Pixmap, copied to
+ * the window by EndDrawing().
+ */
+static Drawable BeginDrawing(Tk_Window tkwin)
+{
+ return Tk_GetPixmap(Tk_Display(tkwin), Tk_WindowId(tkwin),
+ Tk_Width(tkwin), Tk_Height(tkwin), Tk_Depth(tkwin));
+}
+
+/* EndDrawing --
+ * Copy the drawable contents to the screen and release resources.
+ */
+static void EndDrawing(Tk_Window tkwin, Drawable d)
+{
+ XGCValues gcValues;
+ GC gc;
+
+ gcValues.function = GXcopy;
+ gcValues.graphics_exposures = False;
+ gc = Tk_GetGC(tkwin, GCFunction|GCGraphicsExposures, &gcValues);
+
+ XCopyArea(Tk_Display(tkwin), d, Tk_WindowId(tkwin), gc,
+ 0, 0, (unsigned) Tk_Width(tkwin), (unsigned) Tk_Height(tkwin),
+ 0, 0);
+
+ Tk_FreePixmap(Tk_Display(tkwin), d);
+ Tk_FreeGC(Tk_Display(tkwin), gc);
+}
+#else
+/* No double-buffering: draw directly into the window. */
+static Drawable BeginDrawing(Tk_Window tkwin) { return Tk_WindowId(tkwin); }
+static void EndDrawing(Tk_Window tkwin, Drawable d) { }
+#endif
+
+/* DrawWidget --
+ * Redraw a widget. Called as an idle handler.
+ */
+static void DrawWidget(ClientData recordPtr)
+{
+ WidgetCore *corePtr = recordPtr;
+
+ corePtr->flags &= ~REDISPLAY_PENDING;
+ if (Tk_IsMapped(corePtr->tkwin)) {
+ Drawable d = BeginDrawing(corePtr->tkwin);
+ corePtr->widgetSpec->layoutProc(recordPtr);
+ corePtr->widgetSpec->displayProc(recordPtr, d);
+ EndDrawing(corePtr->tkwin, d);
+ }
+}
+
+/* TtkRedisplayWidget --
+ * Schedule redisplay as an idle handler.
+ */
+void TtkRedisplayWidget(WidgetCore *corePtr)
+{
+ if (corePtr->flags & WIDGET_DESTROYED) {
+ return;
+ }
+
+ if (!(corePtr->flags & REDISPLAY_PENDING)) {
+ Tcl_DoWhenIdle(DrawWidget, corePtr);
+ corePtr->flags |= REDISPLAY_PENDING;
+ }
+}
+
+/* TtkResizeWidget --
+ * Recompute widget size, schedule geometry propagation and redisplay.
+ */
+void TtkResizeWidget(WidgetCore *corePtr)
+{
+ if (corePtr->flags & WIDGET_DESTROYED) {
+ return;
+ }
+
+ SizeChanged(corePtr);
+ TtkRedisplayWidget(corePtr);
+}
+
+/* TtkWidgetChangeState --
+ * Set / clear the specified bits in the 'state' flag,
+ */
+void TtkWidgetChangeState(WidgetCore *corePtr,
+ unsigned int setBits, unsigned int clearBits)
+{
+ Ttk_State oldState = corePtr->state;
+ corePtr->state = (oldState & ~clearBits) | setBits;
+ if (corePtr->state ^ oldState) {
+ TtkRedisplayWidget(corePtr);
+ }
+}
+
+/* WidgetInstanceObjCmd --
+ * Widget instance command implementation.
+ */
+static int
+WidgetInstanceObjCmd(
+ ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[])
+{
+ WidgetCore *corePtr = clientData;
+ const Ttk_Ensemble *commands = corePtr->widgetSpec->commands;
+ int status;
+
+ Tcl_Preserve(clientData);
+ status = Ttk_InvokeEnsemble(commands,1, clientData,interp,objc,objv);
+ Tcl_Release(clientData);
+
+ return status;
+}
+
+/*------------------------------------------------------------------------
+ * +++ Widget destruction.
+ *
+ * A widget can be destroyed when the application explicitly
+ * destroys the window or one of its ancestors via [destroy]
+ * or Tk_DestroyWindow(); when the application deletes the widget
+ * instance command; when there is an error in the widget constructor;
+ * or when another application calls XDestroyWindow on the window ID.
+ *
+ * The window receives a <DestroyNotify> event in all cases,
+ * so we do the bulk of the cleanup there. See [#2207435] for
+ * further notes (esp. re: Tk_FreeConfigOptions).
+ *
+ * Widget code that reenters the interp should only do so
+ * when the widtget is Tcl_Preserve()d, and should check
+ * the WIDGET_DESTROYED flag bit upon return.
+ */
+
+/* WidgetInstanceObjCmdDeleted --
+ * Widget instance command deletion callback.
+ */
+static void
+WidgetInstanceObjCmdDeleted(ClientData clientData)
+{
+ WidgetCore *corePtr = clientData;
+ corePtr->widgetCmd = NULL;
+ if (corePtr->tkwin != NULL)
+ Tk_DestroyWindow(corePtr->tkwin);
+}
+
+/* FreeWidget --
+ * Final cleanup for widget; called via Tcl_EventuallyFree().
+ */
+static void
+FreeWidget(void *memPtr)
+{
+ ckfree(memPtr);
+}
+
+/* DestroyWidget --
+ * Main widget destructor; called from <DestroyNotify> event handler.
+ */
+static void
+DestroyWidget(WidgetCore *corePtr)
+{
+ corePtr->flags |= WIDGET_DESTROYED;
+
+ corePtr->widgetSpec->cleanupProc(corePtr);
+
+ Tk_FreeConfigOptions(
+ (ClientData)corePtr, corePtr->optionTable, corePtr->tkwin);
+
+ if (corePtr->layout) {
+ Ttk_FreeLayout(corePtr->layout);
+ }
+
+ if (corePtr->flags & REDISPLAY_PENDING) {
+ Tcl_CancelIdleCall(DrawWidget, corePtr);
+ }
+
+ corePtr->tkwin = NULL;
+ if (corePtr->widgetCmd) {
+ Tcl_Command cmd = corePtr->widgetCmd;
+ corePtr->widgetCmd = 0;
+ /* NB: this can reenter the interpreter via a command traces */
+ Tcl_DeleteCommandFromToken(corePtr->interp, cmd);
+ }
+ Tcl_EventuallyFree(corePtr, (Tcl_FreeProc *) FreeWidget);
+}
+
+/*
+ * CoreEventProc --
+ * Event handler for basic events.
+ * Processes Expose, Configure, FocusIn/Out, and Destroy events.
+ * Also handles <<ThemeChanged>> virtual events.
+ *
+ * For Expose and Configure, simply schedule the widget for redisplay.
+ * For Destroy events, handle the cleanup process.
+ *
+ * For Focus events, set/clear the focus bit in the state field.
+ * It turns out this is impossible to do correctly in a binding script,
+ * because Tk filters out focus events with detail == NotifyInferior.
+ *
+ * For Deactivate/Activate pseudo-events, set/clear the background state
+ * flag.
+ */
+
+static const unsigned CoreEventMask
+ = ExposureMask
+ | StructureNotifyMask
+ | FocusChangeMask
+ | VirtualEventMask
+ | ActivateMask
+ | EnterWindowMask
+ | LeaveWindowMask
+ ;
+
+static void CoreEventProc(ClientData clientData, XEvent *eventPtr)
+{
+ WidgetCore *corePtr = clientData;
+
+ switch (eventPtr->type)
+ {
+ case ConfigureNotify :
+ TtkRedisplayWidget(corePtr);
+ break;
+ case Expose :
+ if (eventPtr->xexpose.count == 0) {
+ TtkRedisplayWidget(corePtr);
+ }
+ break;
+ case DestroyNotify :
+ Tk_DeleteEventHandler(
+ corePtr->tkwin, CoreEventMask,CoreEventProc,clientData);
+ DestroyWidget(corePtr);
+ break;
+ case FocusIn:
+ case FocusOut:
+ /* Don't process "virtual crossing" events */
+ if ( eventPtr->xfocus.detail == NotifyInferior
+ || eventPtr->xfocus.detail == NotifyAncestor
+ || eventPtr->xfocus.detail == NotifyNonlinear)
+ {
+ if (eventPtr->type == FocusIn)
+ corePtr->state |= TTK_STATE_FOCUS;
+ else
+ corePtr->state &= ~TTK_STATE_FOCUS;
+ TtkRedisplayWidget(corePtr);
+ }
+ break;
+ case ActivateNotify:
+ corePtr->state &= ~TTK_STATE_BACKGROUND;
+ TtkRedisplayWidget(corePtr);
+ break;
+ case DeactivateNotify:
+ corePtr->state |= TTK_STATE_BACKGROUND;
+ TtkRedisplayWidget(corePtr);
+ break;
+ case LeaveNotify:
+ corePtr->state &= ~TTK_STATE_HOVER;
+ TtkRedisplayWidget(corePtr);
+ break;
+ case EnterNotify:
+ corePtr->state |= TTK_STATE_HOVER;
+ TtkRedisplayWidget(corePtr);
+ break;
+ case VirtualEvent:
+ if (!strcmp("ThemeChanged", ((XVirtualEvent *)(eventPtr))->name)) {
+ (void)UpdateLayout(corePtr->interp, corePtr);
+ SizeChanged(corePtr);
+ TtkRedisplayWidget(corePtr);
+ }
+ default:
+ /* can't happen... */
+ break;
+ }
+}
+
+/*
+ * WidgetWorldChanged --
+ * Default Tk_ClassWorldChangedProc() for widgets.
+ * Invoked whenever fonts or other system resources are changed;
+ * recomputes geometry.
+ */
+static void WidgetWorldChanged(ClientData clientData)
+{
+ WidgetCore *corePtr = clientData;
+ SizeChanged(corePtr);
+ TtkRedisplayWidget(corePtr);
+}
+
+static Tk_ClassProcs widgetClassProcs = {
+ sizeof(Tk_ClassProcs), /* size */
+ WidgetWorldChanged, /* worldChangedProc */
+ NULL, /* createProc */
+ NULL /* modalProc */
+};
+
+/*
+ * TtkWidgetConstructorObjCmd --
+ * General-purpose widget constructor command implementation.
+ * ClientData is a WidgetSpec *.
+ */
+int TtkWidgetConstructorObjCmd(
+ ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[])
+{
+ WidgetSpec *widgetSpec = clientData;
+ const char *className = widgetSpec->className;
+ Tk_OptionTable optionTable =
+ Tk_CreateOptionTable(interp, widgetSpec->optionSpecs);
+ Tk_Window tkwin;
+ void *recordPtr;
+ WidgetCore *corePtr;
+ Tk_SavedOptions savedOptions;
+ int i;
+
+ if (objc < 2 || objc % 2 == 1) {
+ Tcl_WrongNumArgs(interp, 1, objv, "pathName ?-option value ...?");
+ return TCL_ERROR;
+ }
+
+ /* Check if a -class option has been specified.
+ * We have to do this before the InitOptions() call,
+ * since InitOptions() is affected by the widget class.
+ */
+ for (i = 2; i < objc; i += 2) {
+ if (!strcmp(Tcl_GetString(objv[i]), "-class")) {
+ className = Tcl_GetString(objv[i+1]);
+ break;
+ }
+ }
+
+ tkwin = Tk_CreateWindowFromPath(
+ interp, Tk_MainWindow(interp), Tcl_GetString(objv[1]), NULL);
+ if (tkwin == NULL)
+ return TCL_ERROR;
+
+ /*
+ * Allocate and initialize the widget record.
+ */
+ recordPtr = ckalloc(widgetSpec->recordSize);
+ memset(recordPtr, 0, widgetSpec->recordSize);
+ corePtr = recordPtr;
+
+ corePtr->tkwin = tkwin;
+ corePtr->interp = interp;
+ corePtr->widgetSpec = widgetSpec;
+ corePtr->widgetCmd = Tcl_CreateObjCommand(interp, Tk_PathName(tkwin),
+ WidgetInstanceObjCmd, recordPtr, WidgetInstanceObjCmdDeleted);
+ corePtr->optionTable = optionTable;
+ corePtr->layout = NULL;
+ corePtr->flags = 0;
+ corePtr->state = 0;
+
+ Tk_SetClass(tkwin, className);
+ Tk_SetClassProcs(tkwin, &widgetClassProcs, recordPtr);
+ Tk_SetWindowBackgroundPixmap(tkwin, ParentRelative);
+
+ widgetSpec->initializeProc(interp, recordPtr);
+
+ Tk_CreateEventHandler(tkwin, CoreEventMask, CoreEventProc, recordPtr);
+
+ /*
+ * Initial configuration.
+ */
+
+ Tcl_Preserve(corePtr);
+ if (Tk_InitOptions(interp, recordPtr, optionTable, tkwin) != TCL_OK) {
+ goto error;
+ }
+
+ if (Tk_SetOptions(interp, recordPtr, optionTable,
+ objc - 2, objv + 2, tkwin, &savedOptions, NULL) != TCL_OK) {
+ Tk_RestoreSavedOptions(&savedOptions);
+ goto error;
+ } else {
+ Tk_FreeSavedOptions(&savedOptions);
+ }
+ if (widgetSpec->configureProc(interp, recordPtr, ~0) != TCL_OK)
+ goto error;
+ if (widgetSpec->postConfigureProc(interp, recordPtr, ~0) != TCL_OK)
+ goto error;
+
+ if (WidgetDestroyed(corePtr))
+ goto error;
+
+ Tcl_Release(corePtr);
+
+ SizeChanged(corePtr);
+ Tk_MakeWindowExist(tkwin);
+
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(Tk_PathName(tkwin), -1));
+ return TCL_OK;
+
+error:
+ if (WidgetDestroyed(corePtr)) {
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "widget has been destroyed", -1));
+ } else {
+ Tk_DestroyWindow(tkwin);
+ }
+ Tcl_Release(corePtr);
+ return TCL_ERROR;
+}
+
+/*------------------------------------------------------------------------
+ * +++ Default implementations for widget hook procedures.
+ */
+
+/* TtkWidgetGetLayout --
+ * Default getLayoutProc.
+ * Looks up the layout based on the -style resource (if specified),
+ * otherwise use the widget class.
+ */
+Ttk_Layout TtkWidgetGetLayout(
+ Tcl_Interp *interp, Ttk_Theme themePtr, void *recordPtr)
+{
+ WidgetCore *corePtr = recordPtr;
+ const char *styleName = 0;
+
+ if (corePtr->styleObj)
+ styleName = Tcl_GetString(corePtr->styleObj);
+
+ if (!styleName || *styleName == '\0')
+ styleName = corePtr->widgetSpec->className;
+
+ return Ttk_CreateLayout(interp, themePtr, styleName,
+ recordPtr, corePtr->optionTable, corePtr->tkwin);
+}
+
+/*
+ * TtkWidgetGetOrientedLayout --
+ * Helper routine. Same as TtkWidgetGetLayout, but prefixes
+ * "Horizontal." or "Vertical." to the style name, depending
+ * on the value of the 'orient' option.
+ */
+Ttk_Layout TtkWidgetGetOrientedLayout(
+ Tcl_Interp *interp, Ttk_Theme themePtr, void *recordPtr, Tcl_Obj *orientObj)
+{
+ WidgetCore *corePtr = recordPtr;
+ const char *baseStyleName = 0;
+ Tcl_DString styleName;
+ int orient = TTK_ORIENT_HORIZONTAL;
+ Ttk_Layout layout;
+
+ Tcl_DStringInit(&styleName);
+
+ /* Prefix:
+ */
+ Ttk_GetOrientFromObj(NULL, orientObj, &orient);
+ if (orient == TTK_ORIENT_HORIZONTAL)
+ Tcl_DStringAppend(&styleName, "Horizontal.", -1);
+ else
+ Tcl_DStringAppend(&styleName, "Vertical.", -1);
+
+ /* Add base style name:
+ */
+ if (corePtr->styleObj)
+ baseStyleName = Tcl_GetString(corePtr->styleObj);
+ if (!baseStyleName || *baseStyleName == '\0')
+ baseStyleName = corePtr->widgetSpec->className;
+
+ Tcl_DStringAppend(&styleName, baseStyleName, -1);
+
+ /* Create layout:
+ */
+ layout= Ttk_CreateLayout(interp, themePtr, Tcl_DStringValue(&styleName),
+ recordPtr, corePtr->optionTable, corePtr->tkwin);
+
+ Tcl_DStringFree(&styleName);
+
+ return layout;
+}
+
+/* TtkNullInitialize --
+ * Default widget initializeProc (no-op)
+ */
+void TtkNullInitialize(Tcl_Interp *interp, void *recordPtr)
+{
+}
+
+/* TtkNullPostConfigure --
+ * Default widget postConfigureProc (no-op)
+ */
+int TtkNullPostConfigure(Tcl_Interp *interp, void *clientData, int mask)
+{
+ return TCL_OK;
+}
+
+/* TtkCoreConfigure --
+ * Default widget configureProc.
+ * Handles -style option.
+ */
+int TtkCoreConfigure(Tcl_Interp *interp, void *clientData, int mask)
+{
+ WidgetCore *corePtr = clientData;
+ int status = TCL_OK;
+
+ if (mask & STYLE_CHANGED) {
+ status = UpdateLayout(interp, corePtr);
+ }
+
+ return status;
+}
+
+/* TtkNullCleanup --
+ * Default widget cleanupProc (no-op)
+ */
+void TtkNullCleanup(void *recordPtr)
+{
+ return;
+}
+
+/* TtkWidgetDoLayout --
+ * Default widget layoutProc.
+ */
+void TtkWidgetDoLayout(void *clientData)
+{
+ WidgetCore *corePtr = clientData;
+ Ttk_PlaceLayout(corePtr->layout,corePtr->state,Ttk_WinBox(corePtr->tkwin));
+}
+
+/* TtkWidgetDisplay --
+ * Default widget displayProc.
+ */
+void TtkWidgetDisplay(void *recordPtr, Drawable d)
+{
+ WidgetCore *corePtr = recordPtr;
+ Ttk_DrawLayout(corePtr->layout, corePtr->state, d);
+}
+
+/* TtkWidgetSize --
+ * Default widget sizeProc()
+ */
+int TtkWidgetSize(void *recordPtr, int *widthPtr, int *heightPtr)
+{
+ WidgetCore *corePtr = recordPtr;
+ Ttk_LayoutSize(corePtr->layout, corePtr->state, widthPtr, heightPtr);
+ return 1;
+}
+
+/*------------------------------------------------------------------------
+ * +++ Default implementations for widget subcommands.
+ */
+
+/* $w cget -option
+ */
+int TtkWidgetCgetCommand(
+ void *recordPtr, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[])
+{
+ WidgetCore *corePtr = recordPtr;
+ Tcl_Obj *result;
+
+ if (objc != 3) {
+ Tcl_WrongNumArgs(interp, 2, objv, "option");
+ return TCL_ERROR;
+ }
+ result = Tk_GetOptionValue(interp, recordPtr,
+ corePtr->optionTable, objv[2], corePtr->tkwin);
+ if (result == NULL)
+ return TCL_ERROR;
+ Tcl_SetObjResult(interp, result);
+ return TCL_OK;
+}
+
+/* $w configure ?-option ?value ....??
+ */
+int TtkWidgetConfigureCommand(
+ void *recordPtr, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[])
+{
+ WidgetCore *corePtr = recordPtr;
+ Tcl_Obj *result;
+
+ if (objc == 2) {
+ result = Tk_GetOptionInfo(interp, recordPtr,
+ corePtr->optionTable, NULL, corePtr->tkwin);
+ } else if (objc == 3) {
+ result = Tk_GetOptionInfo(interp, recordPtr,
+ corePtr->optionTable, objv[2], corePtr->tkwin);
+ } else {
+ Tk_SavedOptions savedOptions;
+ int status;
+ int mask = 0;
+
+ status = Tk_SetOptions(interp, recordPtr,
+ corePtr->optionTable, objc - 2, objv + 2,
+ corePtr->tkwin, &savedOptions, &mask);
+ if (status != TCL_OK)
+ return status;
+
+ if (mask & READONLY_OPTION) {
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "attempt to change read-only option", -1));
+ Tk_RestoreSavedOptions(&savedOptions);
+ return TCL_ERROR;
+ }
+
+ status = corePtr->widgetSpec->configureProc(interp, recordPtr, mask);
+ if (status != TCL_OK) {
+ Tk_RestoreSavedOptions(&savedOptions);
+ return status;
+ }
+ Tk_FreeSavedOptions(&savedOptions);
+
+ status = corePtr->widgetSpec->postConfigureProc(interp,recordPtr,mask);
+ if (WidgetDestroyed(corePtr)) {
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "widget has been destroyed", -1));
+ status = TCL_ERROR;
+ }
+ if (status != TCL_OK) {
+ return status;
+ }
+
+ if (mask & (STYLE_CHANGED | GEOMETRY_CHANGED)) {
+ SizeChanged(corePtr);
+ }
+
+ TtkRedisplayWidget(corePtr);
+ result = Tcl_NewObj();
+ }
+
+ if (result == 0) {
+ return TCL_ERROR;
+ }
+ Tcl_SetObjResult(interp, result);
+ return TCL_OK;
+}
+
+/* $w state ? $stateSpec ?
+ *
+ * If $stateSpec is specified, modify the widget state accordingly,
+ * return a new stateSpec representing the changed bits.
+ *
+ * Otherwise, return a statespec matching all the currently-set bits.
+ */
+
+int TtkWidgetStateCommand(
+ void *recordPtr, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[])
+{
+ WidgetCore *corePtr = recordPtr;
+ Ttk_StateSpec spec;
+ int status;
+ Ttk_State oldState, changed;
+
+ if (objc == 2) {
+ Tcl_SetObjResult(interp,
+ Ttk_NewStateSpecObj(corePtr->state, 0ul));
+ return TCL_OK;
+ }
+
+ if (objc != 3) {
+ Tcl_WrongNumArgs(interp, 2, objv, "state-spec");
+ return TCL_ERROR;
+ }
+ status = Ttk_GetStateSpecFromObj(interp, objv[2], &spec);
+ if (status != TCL_OK)
+ return status;
+
+ oldState = corePtr->state;
+ corePtr->state = Ttk_ModifyState(corePtr->state, &spec);
+ changed = corePtr->state ^ oldState;
+
+ TtkRedisplayWidget(corePtr);
+
+ Tcl_SetObjResult(interp,
+ Ttk_NewStateSpecObj(oldState & changed, ~oldState & changed));
+ return status;
+}
+
+/* $w instate $stateSpec ?$script?
+ *
+ * Tests if widget state matches $stateSpec.
+ * If $script is specified, execute script if state matches.
+ * Otherwise, return true/false
+ */
+
+int TtkWidgetInstateCommand(
+ void *recordPtr, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[])
+{
+ WidgetCore *corePtr = recordPtr;
+ Ttk_State state = corePtr->state;
+ Ttk_StateSpec spec;
+ int status = TCL_OK;
+
+ if (objc < 3 || objc > 4) {
+ Tcl_WrongNumArgs(interp, 2, objv, "state-spec ?script?");
+ return TCL_ERROR;
+ }
+ status = Ttk_GetStateSpecFromObj(interp, objv[2], &spec);
+ if (status != TCL_OK)
+ return status;
+
+ if (objc == 3) {
+ Tcl_SetObjResult(interp,
+ Tcl_NewBooleanObj(Ttk_StateMatches(state,&spec)));
+ } else if (objc == 4) {
+ if (Ttk_StateMatches(state,&spec)) {
+ status = Tcl_EvalObjEx(interp, objv[3], 0);
+ }
+ }
+ return status;
+}
+
+/* $w identify $x $y
+ * $w identify element $x $y
+ * Returns: name of element at $x, $y
+ */
+int TtkWidgetIdentifyCommand(
+ void *recordPtr, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[])
+{
+ WidgetCore *corePtr = recordPtr;
+ Ttk_Element element;
+ static const char *whatTable[] = { "element", NULL };
+ int x, y, what;
+
+ if (objc < 4 || objc > 5) {
+ Tcl_WrongNumArgs(interp, 2, objv, "?what? x y");
+ return TCL_ERROR;
+ }
+ if (objc == 5) {
+ /* $w identify element $x $y */
+ if (Tcl_GetIndexFromObjStruct(interp, objv[2], whatTable,
+ sizeof(char *), "option", 0, &what) != TCL_OK)
+ {
+ return TCL_ERROR;
+ }
+ }
+
+ if ( Tcl_GetIntFromObj(interp, objv[objc-2], &x) != TCL_OK
+ || Tcl_GetIntFromObj(interp, objv[objc-1], &y) != TCL_OK
+ ) {
+ return TCL_ERROR;
+ }
+
+ element = Ttk_IdentifyElement(corePtr->layout, x, y);
+ if (element) {
+ const char *elementName = Ttk_ElementName(element);
+ Tcl_SetObjResult(interp,Tcl_NewStringObj(elementName,-1));
+ }
+
+ return TCL_OK;
+}
+
+/*EOF*/
diff --git a/tk8.6/generic/ttk/ttkWidget.h b/tk8.6/generic/ttk/ttkWidget.h
new file mode 100644
index 0000000..e4dd712
--- /dev/null
+++ b/tk8.6/generic/ttk/ttkWidget.h
@@ -0,0 +1,273 @@
+/*
+ * Copyright (c) 2003, Joe English
+ * Helper routines for widget implementations.
+ */
+
+#ifndef _TTKWIDGET
+#define _TTKWIDGET
+
+/*
+ * State flags for 'flags' field.
+ */
+#define WIDGET_DESTROYED 0x0001
+#define REDISPLAY_PENDING 0x0002 /* scheduled call to RedisplayWidget */
+#define CURSOR_ON 0x0020 /* See TtkBlinkCursor() */
+#define WIDGET_USER_FLAG 0x0100 /* 0x0100 - 0x8000 for user flags */
+
+/*
+ * Bit fields for OptionSpec 'mask' field:
+ */
+#define READONLY_OPTION 0x1
+#define STYLE_CHANGED 0x2
+#define GEOMETRY_CHANGED 0x4
+
+/*
+ * Core widget elements
+ */
+typedef struct WidgetSpec_ WidgetSpec; /* Forward */
+
+typedef struct
+{
+ Tk_Window tkwin; /* Window associated with widget */
+ Tcl_Interp *interp; /* Interpreter associated with widget. */
+ WidgetSpec *widgetSpec; /* Widget class hooks */
+ Tcl_Command widgetCmd; /* Token for widget command. */
+ Tk_OptionTable optionTable; /* Option table */
+ Ttk_Layout layout; /* Widget layout */
+
+ /*
+ * Storage for resources:
+ */
+ Tcl_Obj *takeFocusPtr; /* Storage for -takefocus option */
+ Tcl_Obj *cursorObj; /* Storage for -cursor option */
+ Tcl_Obj *styleObj; /* Name of currently-applied style */
+ Tcl_Obj *classObj; /* Class name (readonly option) */
+
+ Ttk_State state; /* Current widget state */
+ unsigned int flags; /* internal flags, see above */
+
+} WidgetCore;
+
+/*
+ * Widget specifications:
+ */
+struct WidgetSpec_
+{
+ const char *className; /* Widget class name */
+ size_t recordSize; /* #bytes in widget record */
+ const Tk_OptionSpec *optionSpecs; /* Option specifications */
+ const Ttk_Ensemble *commands; /* Widget instance subcommands */
+
+ /*
+ * Hooks:
+ */
+ void (*initializeProc)(Tcl_Interp *, void *recordPtr);
+ void (*cleanupProc)(void *recordPtr);
+ int (*configureProc)(Tcl_Interp *, void *recordPtr, int flags);
+ int (*postConfigureProc)(Tcl_Interp *, void *recordPtr, int flags);
+ Ttk_Layout (*getLayoutProc)(Tcl_Interp *,Ttk_Theme, void *recordPtr);
+ int (*sizeProc)(void *recordPtr, int *widthPtr, int *heightPtr);
+ void (*layoutProc)(void *recordPtr);
+ void (*displayProc)(void *recordPtr, Drawable d);
+};
+
+/*
+ * Common factors for widget implementations:
+ */
+MODULE_SCOPE void TtkNullInitialize(Tcl_Interp *, void *);
+MODULE_SCOPE int TtkNullPostConfigure(Tcl_Interp *, void *, int);
+MODULE_SCOPE void TtkNullCleanup(void *recordPtr);
+MODULE_SCOPE Ttk_Layout TtkWidgetGetLayout(
+ Tcl_Interp *, Ttk_Theme, void *recordPtr);
+MODULE_SCOPE Ttk_Layout TtkWidgetGetOrientedLayout(
+ Tcl_Interp *, Ttk_Theme, void *recordPtr, Tcl_Obj *orientObj);
+MODULE_SCOPE int TtkWidgetSize(void *recordPtr, int *w, int *h);
+MODULE_SCOPE void TtkWidgetDoLayout(void *recordPtr);
+MODULE_SCOPE void TtkWidgetDisplay(void *recordPtr, Drawable);
+
+MODULE_SCOPE int TtkCoreConfigure(Tcl_Interp*, void *, int mask);
+
+/* Common widget commands:
+ */
+MODULE_SCOPE int TtkWidgetConfigureCommand(
+ void *,Tcl_Interp *, int, Tcl_Obj*const[]);
+MODULE_SCOPE int TtkWidgetCgetCommand(
+ void *,Tcl_Interp *, int, Tcl_Obj*const[]);
+MODULE_SCOPE int TtkWidgetInstateCommand(
+ void *,Tcl_Interp *, int, Tcl_Obj*const[]);
+MODULE_SCOPE int TtkWidgetStateCommand(
+ void *,Tcl_Interp *, int, Tcl_Obj*const[]);
+MODULE_SCOPE int TtkWidgetIdentifyCommand(
+ void *,Tcl_Interp *, int, Tcl_Obj*const[]);
+
+/* Widget constructor:
+ */
+MODULE_SCOPE int TtkWidgetConstructorObjCmd(
+ ClientData, Tcl_Interp*, int, Tcl_Obj*const[]);
+
+#define RegisterWidget(interp, name, specPtr) \
+ Tcl_CreateObjCommand(interp, name, \
+ TtkWidgetConstructorObjCmd, (ClientData)specPtr,NULL)
+
+/* WIDGET_TAKEFOCUS_TRUE --
+ * WIDGET_TAKEFOCUS_FALSE --
+ * Add one or the other of these to each OptionSpecs table
+ * to indicate whether the widget should take focus
+ * during keyboard traversal.
+ */
+#define WIDGET_TAKEFOCUS_TRUE \
+ {TK_OPTION_STRING, "-takefocus", "takeFocus", "TakeFocus", \
+ "ttk::takefocus", Tk_Offset(WidgetCore, takeFocusPtr), -1, 0,0,0 }
+#define WIDGET_TAKEFOCUS_FALSE \
+ {TK_OPTION_STRING, "-takefocus", "takeFocus", "TakeFocus", \
+ "", Tk_Offset(WidgetCore, takeFocusPtr), -1, 0,0,0 }
+
+/* WIDGET_INHERIT_OPTIONS(baseOptionSpecs) --
+ * Add this at the end of an OptionSpecs table to inherit
+ * the options from 'baseOptionSpecs'.
+ */
+#define WIDGET_INHERIT_OPTIONS(baseOptionSpecs) \
+ {TK_OPTION_END, 0,0,0, NULL, -1,-1, 0, (ClientData)baseOptionSpecs, 0}
+
+/* All widgets should inherit from ttkCoreOptionSpecs[].
+ */
+MODULE_SCOPE Tk_OptionSpec ttkCoreOptionSpecs[];
+
+/*
+ * Useful routines for use inside widget implementations:
+ */
+/* extern int WidgetDestroyed(WidgetCore *); */
+#define WidgetDestroyed(corePtr) ((corePtr)->flags & WIDGET_DESTROYED)
+
+MODULE_SCOPE void TtkWidgetChangeState(WidgetCore *,
+ unsigned int setBits, unsigned int clearBits);
+
+MODULE_SCOPE void TtkRedisplayWidget(WidgetCore *);
+MODULE_SCOPE void TtkResizeWidget(WidgetCore *);
+
+MODULE_SCOPE void TtkTrackElementState(WidgetCore *);
+MODULE_SCOPE void TtkBlinkCursor(WidgetCore *);
+
+/*
+ * -state option values (compatibility)
+ */
+MODULE_SCOPE void TtkCheckStateOption(WidgetCore *, Tcl_Obj *);
+
+/*
+ * Variable traces:
+ */
+typedef void (*Ttk_TraceProc)(void *recordPtr, const char *value);
+typedef struct TtkTraceHandle_ Ttk_TraceHandle;
+
+MODULE_SCOPE Ttk_TraceHandle *Ttk_TraceVariable(
+ Tcl_Interp*, Tcl_Obj *varnameObj, Ttk_TraceProc callback, void *clientData);
+MODULE_SCOPE void Ttk_UntraceVariable(Ttk_TraceHandle *);
+MODULE_SCOPE int Ttk_FireTrace(Ttk_TraceHandle *);
+
+/*
+ * Virtual events:
+ */
+MODULE_SCOPE void TtkSendVirtualEvent(Tk_Window tgtWin, const char *eventName);
+
+/*
+ * Helper routines for data accessor commands:
+ */
+MODULE_SCOPE int TtkEnumerateOptions(
+ Tcl_Interp *, void *, const Tk_OptionSpec *, Tk_OptionTable, Tk_Window);
+MODULE_SCOPE int TtkGetOptionValue(
+ Tcl_Interp *, void *, Tcl_Obj *optName, Tk_OptionTable, Tk_Window);
+
+/*
+ * Helper routines for scrolling widgets (see scroll.c).
+ */
+typedef struct {
+ int first; /* First visible item */
+ int last; /* Last visible item */
+ int total; /* Total #items */
+ char *scrollCmd; /* Widget option */
+} Scrollable;
+
+typedef struct ScrollHandleRec *ScrollHandle;
+
+MODULE_SCOPE ScrollHandle TtkCreateScrollHandle(WidgetCore *, Scrollable *);
+MODULE_SCOPE void TtkFreeScrollHandle(ScrollHandle);
+
+MODULE_SCOPE int TtkScrollviewCommand(
+ Tcl_Interp *interp, int objc, Tcl_Obj *const objv[], ScrollHandle);
+
+MODULE_SCOPE void TtkScrollTo(ScrollHandle, int newFirst);
+MODULE_SCOPE void TtkScrolled(ScrollHandle, int first, int last, int total);
+MODULE_SCOPE void TtkScrollbarUpdateRequired(ScrollHandle);
+
+/*
+ * Tag sets (work in progress, half-baked)
+ */
+
+typedef struct TtkTag *Ttk_Tag;
+typedef struct TtkTagTable *Ttk_TagTable;
+typedef struct TtkTagSet { /* TODO: make opaque */
+ Ttk_Tag *tags;
+ int nTags;
+} *Ttk_TagSet;
+
+MODULE_SCOPE Ttk_TagTable Ttk_CreateTagTable(
+ Tcl_Interp *, Tk_Window tkwin, Tk_OptionSpec[], int recordSize);
+MODULE_SCOPE void Ttk_DeleteTagTable(Ttk_TagTable);
+
+MODULE_SCOPE Ttk_Tag Ttk_GetTag(Ttk_TagTable, const char *tagName);
+MODULE_SCOPE Ttk_Tag Ttk_GetTagFromObj(Ttk_TagTable, Tcl_Obj *);
+
+MODULE_SCOPE Tcl_Obj *Ttk_TagOptionValue(
+ Tcl_Interp *, Ttk_TagTable, Ttk_Tag, Tcl_Obj *optionName);
+
+MODULE_SCOPE int Ttk_EnumerateTagOptions(
+ Tcl_Interp *, Ttk_TagTable, Ttk_Tag);
+
+MODULE_SCOPE int Ttk_EnumerateTags(Tcl_Interp *, Ttk_TagTable);
+
+MODULE_SCOPE int Ttk_ConfigureTag(
+ Tcl_Interp *interp, Ttk_TagTable tagTable, Ttk_Tag tag,
+ int objc, Tcl_Obj *const objv[]);
+
+MODULE_SCOPE Ttk_TagSet Ttk_GetTagSetFromObj(
+ Tcl_Interp *interp, Ttk_TagTable, Tcl_Obj *objPtr);
+MODULE_SCOPE Tcl_Obj *Ttk_NewTagSetObj(Ttk_TagSet);
+
+MODULE_SCOPE void Ttk_FreeTagSet(Ttk_TagSet);
+
+MODULE_SCOPE int Ttk_TagSetContains(Ttk_TagSet, Ttk_Tag tag);
+MODULE_SCOPE int Ttk_TagSetAdd(Ttk_TagSet, Ttk_Tag tag);
+MODULE_SCOPE int Ttk_TagSetRemove(Ttk_TagSet, Ttk_Tag tag);
+
+MODULE_SCOPE void Ttk_TagSetValues(Ttk_TagTable, Ttk_TagSet, void *record);
+MODULE_SCOPE void Ttk_TagSetApplyStyle(Ttk_TagTable,Ttk_Style,Ttk_State,void*);
+
+/*
+ * String tables for widget resource specifications:
+ */
+
+MODULE_SCOPE const char *ttkOrientStrings[];
+MODULE_SCOPE const char *ttkCompoundStrings[];
+MODULE_SCOPE const char *ttkDefaultStrings[];
+
+/*
+ * ... other option types...
+ */
+MODULE_SCOPE int TtkGetLabelAnchorFromObj(
+ Tcl_Interp*, Tcl_Obj*, Ttk_PositionSpec *);
+
+/*
+ * Platform-specific initialization.
+ */
+
+#ifdef _WIN32
+#define Ttk_PlatformInit Ttk_WinPlatformInit
+MODULE_SCOPE int Ttk_PlatformInit(Tcl_Interp *);
+#elif defined(MAC_OSX_TK)
+#define Ttk_PlatformInit Ttk_MacOSXPlatformInit
+MODULE_SCOPE int Ttk_PlatformInit(Tcl_Interp *);
+#else
+#define Ttk_PlatformInit(interp) /* TTK_X11PlatformInit() */
+#endif
+
+#endif /* _TTKWIDGET */